Merge branch 'sail2' into union_barrier

36 files changed, 16102 insertions, 222 deletions

diff --git a/doc/manual.tex b/doc/manual.tex
index 1cab3afa..38b14322 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -24,7 +24,7 @@
 }
 
 \lstdefinelanguage{sail}
-  { morekeywords={val,function,cast,type,forall,overload,operator,enum,union,undefined,exit,and,assert,sizeof,
+  { morekeywords={val,function,mapping,cast,type,forall,overload,operator,enum,union,undefined,exit,and,assert,sizeof,
       scattered,register,inc,dec,if,then,else,effect,let,as,@,in,end,Type,Int,Order,match,clause,struct,
       foreach,from,to,by,infix,infixl,infixr,bitfield,default,try,catch,throw,constraint},
     keywordstyle={\bf\ttfamily\color{blue}},
diff --git a/doc/tutorial.tex b/doc/tutorial.tex
index 9bf47f5b..b9901fc9 100644
--- a/doc/tutorial.tex
+++ b/doc/tutorial.tex
@@ -85,6 +85,78 @@ can drop it and simply write: \mrbfn{my_replicate_bits_three}
 %included. If we use the wildcard key, then we cannot omit specific
 %backends to force them to use a definition in Sail.
 
+\subsection{Mappings}
+\label{sec:mappings}
+
+Mappings are a feature of Sail that allow concise expression of
+bidirectional relationships between values that are common in ISA
+specifications: for example, bit-representations of an enum type or
+assembly-language string representations of an instruction AST.
+
+They are defined similarly to functions, with a \verb|val|-spec and a
+definition. Currently, they only work for monomorphic types.
+
+\begin{center}
+  \ll{val} \textit{name} \ll{:}  \textit{type$_1$} \ll{<->} \textit{type$_2$}
+\end{center}
+
+\begin{center}
+  \ll{mapping} \textit{name} \ll{=} \verb|{|
+     \textit{pattern} \ll{<->} \textit{pattern} \ll{,}
+     \textit{pattern} \ll{<->} \textit{pattern} \ll{,}
+     $\ldots$
+  \verb|}|
+\end{center}
+
+All the functionality of pattern matching, described below, is
+available, including guarded patterns: but note that guards apply only
+to one side. This sometimes leads to unavoidable duplicated code.
+
+As a shorthand, you can also specify a mapping and its type
+simultaneously.
+
+\begin{center}
+   \ll{mapping} \textit{name} \ll{:} \textit{type$_1$} \ll{<->} \textit{type$_2$} \ll{=} \verb|{|
+     \textit{pattern} \ll{<->} \textit{pattern} \ll{,}
+     \textit{pattern} \ll{<->} \textit{pattern} \ll{,}
+     $\ldots$
+  \verb|}|
+\end{center}
+
+A simple example from our RISC-V model:
+
+\begin{lstlisting}
+mapping size_bits : word_width <-> bits(2) = {
+  BYTE   <-> 0b00,
+  HALF   <-> 0b01,
+  WORD   <-> 0b10,
+  DOUBLE <-> 0b11
+}
+\end{lstlisting}
+
+Mappings are used simply by calling them as if they were functions:
+type inference will determine in which direction the mapping
+runs. (This gives rise to the restriction that the types on either
+side of a mapping must be different.)
+
+\begin{lstlisting}
+  let width : word_width = size_bits(0b00);
+  let width : bits(2) = size_bits(BYTE);
+\end{lstlisting}
+
+Mappings are implemented by transforming them at compile time into a
+forwards and a backwards function, along with some auxiliary
+functions. Once a mapping is declared with a \verb|val|-spec, it can
+be implemented by defining these functions manually instead of
+defining the mapping as above. These functions and their types are:
+
+\begin{lstlisting}
+  val name_forwards : type_1 -> type_2
+  val name_backwards : type_2 -> type_1
+  val name_forwards_matches : type_1 -> bool
+  val name_backwards_matches : type_2 -> bool
+\end{lstlisting}
+
 \subsection{Numeric Types}
 \label{sec:numeric}
 
@@ -415,6 +487,44 @@ match ys {
 }
 \end{lstlisting}
 
+\paragraph{Matching on strings}
+
+Unusually, Sail allows strings and concatenations of strings to be
+used in pattern-matching. The match operates in a simple left-to-right
+fashion.
+
+\begin{lstlisting}
+  match s {
+    "hello" ^ " " ^ "world" => print("matched hello world"),
+    _ => print("wildcard")
+  }
+\end{lstlisting}
+
+Note that a string match is always greedy, so
+
+\begin{lstlisting}
+  match s {
+    "hello" ^ s ^ "world" => print("matched hello" ^ s ^ "world"),
+    "hello" ^ s => print("matched hello" ^ s),
+    _ => print("wildcard")
+  }
+\end{lstlisting}
+
+while syntactically valid, will never match the first case.
+
+String matching is most often used with \emph{mappings}, covered
+above, to allow parsing of strings containing, for example, integers:
+
+\begin{lstlisting}
+  match s {
+    "int=" ^ int(x) ^ ";" => x
+    _ => -1
+  }
+\end{lstlisting}
+
+This is intended to be used to parse assembly languages.
+
+
 \paragraph{As patterns}
 
 Like OCaml, Sail also supports naming parts of patterns using the
diff --git a/lib/coq/Hoare.v b/lib/coq/Hoare.v
new file mode 100644
index 00000000..aff3a210
--- /dev/null
+++ b/lib/coq/Hoare.v
@@ -0,0 +1,742 @@
+Require Import String.
+Require Import Sail2_state_monad Sail2_state Sail2_state_monad_lemmas.
+Require Import Sail2_state_lemmas.
+
+(*adhoc_overloading
+  Monad_Syntax.bind State_monad.bindS*)
+
+(*section \<open>Hoare logic for the state, exception and nondeterminism monad\<close>
+
+subsection \<open>Hoare triples\<close>
+*)
+Definition predS regs := sequential_state regs -> Prop.
+
+Definition PrePost {Regs A E} (P : predS Regs) (f : monadS Regs A E) (Q : result A E -> predS Regs) : Prop :=
+ (*"\<lbrace>_\<rbrace> _ \<lbrace>_\<rbrace>"*)
+  forall s, P s -> (forall r s', List.In (r, s') (f s) -> Q r s').
+(*
+lemma PrePostI:
+  assumes "\<And>s r s'. P s \<Longrightarrow> (r, s') \<in> f s \<Longrightarrow> Q r s'"
+  shows "PrePost P f Q"
+  using assms unfolding PrePost_def by auto
+
+lemma PrePost_elim:
+  assumes "PrePost P f Q" and "P s" and "(r, s') \<in> f s"
+  obtains "Q r s'"
+  using assms by (fastforce simp: PrePost_def)
+*)
+Lemma PrePost_consequence Regs X E (A P : predS Regs) (f : monadS Regs X E) (B Q : result X E -> predS Regs) :
+  PrePost A f B ->
+  (forall s, P s -> A s) ->
+  (forall v s, B v s -> Q v s) ->
+  PrePost P f Q.
+intros Triple PA BQ.
+intros s Pre r s' IN.
+specialize (Triple s).
+auto.
+Qed.
+
+Lemma PrePost_strengthen_pre Regs X E (A B : predS Regs) (f : monadS Regs X E) (C : result X E -> predS Regs) :
+  PrePost A f C ->
+  (forall s, B s -> A s) ->
+  PrePost B f C.
+eauto using PrePost_consequence.
+Qed.
+
+Lemma PrePost_weaken_post Regs X E (A : predS Regs) (f : monadS Regs X E) (B C : result X E -> predS Regs) :
+  PrePost A f B ->
+  (forall v s, B v s -> C v s) ->
+  PrePost A f C.
+eauto using PrePost_consequence.
+Qed.
+
+Lemma PrePost_True_post (*[PrePost_atomI, intro, simp]:*) Regs A E (P : predS Regs) (m : monadS Regs A E) :
+  PrePost P m (fun _ _ => True).
+unfold PrePost. auto.
+Qed.
+
+Lemma PrePost_any Regs A E (m : monadS Regs A E) (Q : result A E -> predS Regs) :
+  PrePost (fun s => forall r s', List.In (r, s') (m s) -> Q r s') m Q.
+unfold PrePost. auto.
+Qed.
+
+Lemma PrePost_returnS (*[intro, PrePost_atomI]:*) Regs A E  (P : result A E -> predS Regs) (x : A) :
+  PrePost (P (Value x)) (returnS x) P.
+unfold PrePost, returnS.
+intros s p r s' IN.
+simpl in IN.
+destruct IN as [[=] | []].
+subst; auto.
+Qed.
+
+Lemma PrePost_bindS (*[intro, PrePost_compositeI]:*) Regs A B E (m : monadS Regs A E) (f : A -> monadS Regs B E) (P : predS Regs) (Q : result B E -> predS Regs) (R : A -> predS Regs) :
+  (forall s a s', List.In (Value a, s') (m s) -> PrePost (R a) (f a) Q) ->
+  (PrePost P m (fun r => match r with Value a => R a | Ex e => Q (Ex e) end)) ->
+  PrePost P (bindS m f) Q.
+intros F M s Pre r s' IN.
+destruct (bindS_cases IN) as [(a & a' & s'' & [= ->] & IN' & IN'') | [(e & [= ->] & IN') | (e & a & s'' & [= ->] & IN' & IN'')]].
+* eapply F. apply IN'. specialize (M s Pre (Value a') s'' IN'). apply M. assumption.
+* specialize (M _ Pre _ _ IN'). apply M.
+* specialize (M _ Pre _ _ IN'). simpl in M. eapply F; eauto.
+Qed.
+
+Lemma PrePost_bindS_ignore Regs A B E (m : monadS Regs A E) (f : monadS Regs B E) (P : predS Regs) (Q : result B E -> predS Regs) (R : predS Regs) :
+  PrePost R f Q ->
+  PrePost P m (fun r => match r with Value a => R | Ex e => Q (Ex e) end) ->
+  PrePost P (bindS m (fun _ => f)) Q.
+intros F M.
+eapply PrePost_bindS; eauto.
+* intros. apply F.
+* apply M.
+Qed.
+
+Lemma PrePost_bindS_unit Regs B E (m : monadS Regs unit E) (f : unit -> monadS Regs B E) P Q R :
+  PrePost R (f tt) Q ->
+  PrePost P m (fun r => match r with Value a => R | Ex e => Q (Ex e) end) ->
+  PrePost P (bindS m f) Q.
+intros F M.
+eapply PrePost_bindS with (R := fun _ => R).
+* intros. destruct a. apply F.
+* apply M.
+Qed.
+
+Lemma PrePost_readS (*[intro, PrePost_atomI]:*) Regs A E (P : result A E -> predS Regs) f :
+  PrePost (fun s => P (Value (f s)) s) (readS f) P.
+unfold PrePost, readS, returnS.
+intros s Pre r s' [H | []].
+inversion H; subst.
+assumption.
+Qed.
+
+Lemma PrePost_updateS (*[intro, PrePost_atomI]:*) Regs E (P : result unit E -> predS Regs) f :
+  PrePost (fun s => P (Value tt) (f s)) (updateS f) P.
+unfold PrePost, readS, returnS.
+intros s Pre r s' [H | []].
+inversion H; subst.
+assumption.
+Qed.
+
+Lemma PrePost_if Regs A E b (f g : monadS Regs A E) P Q :
+  (b = true  -> PrePost P f Q) ->
+  (b = false -> PrePost P g Q) ->
+  PrePost P (if b then f else g) Q.
+intros T F.
+destruct b; auto.
+Qed.
+
+Lemma PrePost_if_branch (*[PrePost_compositeI]:*) Regs A E b (f g : monadS Regs A E) Pf Pg Q :
+  (b = true  -> PrePost Pf f Q) ->
+  (b = false -> PrePost Pg g Q) ->
+  PrePost (if b then Pf else Pg) (if b then f else g) Q.
+destruct b; auto.
+Qed.
+
+Lemma PrePost_if_then Regs A E b (f g : monadS Regs A E) P Q :
+  b = true ->
+  PrePost P f Q ->
+  PrePost P (if b then f else g) Q.
+intros; subst; auto.
+Qed.
+
+Lemma PrePost_if_else Regs A E b (f g : monadS Regs A E) P Q :
+  b = false ->
+  PrePost P g Q ->
+  PrePost P (if b then f else g) Q.
+intros; subst; auto.
+Qed.
+
+Lemma PrePost_prod_cases (*[PrePost_compositeI]:*) Regs A B E (f : A -> B -> monadS Regs A E) P Q x :
+  PrePost P (f (fst x) (snd x)) Q ->
+  PrePost P (match x with (a, b) => f a b end) Q.
+destruct x; auto.
+Qed.
+
+Lemma PrePost_option_cases (*[PrePost_compositeI]:*) Regs A B E x (s : A -> monadS Regs B E) n PS PN Q :
+  (forall a, PrePost (PS a) (s a) Q) ->
+  PrePost PN n Q ->
+  PrePost (match x with Some a => PS a | None => PN end) (match x with Some a => s a | None => n end) Q.
+destruct x; auto.
+Qed.
+
+Lemma PrePost_let (*[intro, PrePost_compositeI]:*) Regs A B E y (m : A -> monadS Regs B E) P Q :
+  PrePost P (m y) Q ->
+  PrePost P (let x := y in m x) Q.
+auto.
+Qed.
+
+Lemma PrePost_and_boolS (*[PrePost_compositeI]:*) Regs E (l r : monadS Regs bool E) P Q R :
+  PrePost R r Q ->
+  PrePost P l (fun r => match r with Value true => R | _ => Q r end) ->
+  PrePost P (and_boolS l r) Q.
+intros Hr Hl.
+unfold and_boolS.
+eapply PrePost_bindS.
+2: { instantiate (1 := fun a => if a then R else Q (Value false)).
+     eapply PrePost_weaken_post.
+     apply Hl.
+     intros [[|] | ] s H; auto. }
+* intros. destruct a; eauto.
+  apply PrePost_returnS.
+Qed.
+
+Lemma PrePost_or_boolS (*[PrePost_compositeI]:*) Regs E (l r : monadS Regs bool E) P Q R :
+  PrePost R r Q ->
+  PrePost P l (fun r => match r with Value false => R | _ => Q r end) ->
+  PrePost P (or_boolS l r) Q.
+intros Hr Hl.
+unfold or_boolS.
+eapply PrePost_bindS.
+* intros.
+  instantiate (1 := fun a => if a then Q (Value true) else R).
+  destruct a; eauto.
+  apply PrePost_returnS.
+* eapply PrePost_weaken_post.
+  apply Hl.
+  intros [[|] | ] s H; auto.
+Qed.
+
+Lemma PrePost_failS (*[intro, PrePost_atomI]:*) Regs A E msg (Q : result A E -> predS Regs) :
+  PrePost (Q (Ex (Failure msg))) (failS msg) Q.
+intros s Pre r s' [[= <- <-] | []].
+assumption.
+Qed.
+
+Lemma PrePost_assert_expS (*[intro, PrePost_atomI]:*) Regs E (c : bool) m (P : result unit E -> predS Regs) :
+  PrePost (if c then P (Value tt) else P (Ex (Failure m))) (assert_expS c m) P.
+destruct c; simpl.
+* apply PrePost_returnS.
+* apply PrePost_failS. 
+Qed.
+
+Lemma PrePost_chooseS (*[intro, PrePost_atomI]:*) Regs A E xs (Q : result A E -> predS Regs) :
+  PrePost (fun s => forall x, List.In x xs -> Q (Value x) s) (chooseS xs) Q.
+unfold PrePost, chooseS.
+intros s IN r s' IN'.
+apply List.in_map_iff in IN'.
+destruct IN' as (x & [= <- <-] & IN').
+auto.
+Qed.
+
+Lemma case_result_combine (*[simp]:*) A E X r (Q : result A E -> X) :
+  (match r with Value a => Q (Value a) | Ex e => Q (Ex e) end) = Q r.
+destruct r; auto.
+Qed.
+
+Lemma PrePost_foreachS_Nil (*[intro, simp, PrePost_atomI]:*) Regs A Vars E vars body (Q : result Vars E -> predS Regs) :
+  PrePost (Q (Value vars)) (foreachS (A := A) nil vars body) Q.
+simpl. apply PrePost_returnS.
+Qed.
+
+Lemma PrePost_foreachS_Cons Regs A Vars E (x : A) xs vars body (Q : result Vars E -> predS Regs) :
+  (forall s vars' s', List.In (Value vars', s') (body x vars s) -> PrePost (Q (Value vars')) (foreachS xs vars' body) Q) ->
+  PrePost (Q (Value vars)) (body x vars) Q ->
+  PrePost (Q (Value vars)) (foreachS (x :: xs) vars body) Q.
+intros XS X.
+simpl.
+eapply PrePost_bindS.
+* apply XS.
+* apply PrePost_weaken_post with (B := Q).
+  assumption.
+  intros; rewrite case_result_combine.
+  assumption.
+Qed.
+
+Lemma PrePost_foreachS_invariant Regs A Vars E (xs : list A) vars body (Q : result Vars E -> predS Regs) :
+  (forall x vars, List.In x xs -> PrePost (Q (Value vars)) (body x vars) Q) ->
+  PrePost (Q (Value vars)) (foreachS xs vars body) Q.
+revert vars.
+induction xs.
+* intros. apply PrePost_foreachS_Nil.
+* intros. apply PrePost_foreachS_Cons.
+  + auto with datatypes.
+  + apply H. auto with datatypes.
+Qed.
+
+(*subsection \<open>Hoare quadruples\<close>
+
+text \<open>It is often convenient to treat the exception case separately.  For this purpose, we use
+a Hoare logic similar to the one used in [1]. It features not only Hoare triples, but also quadruples
+with two postconditions: one for the case where the computation succeeds, and one for the case where
+there is an exception.
+
+[1] D. Cock, G. Klein, and T. Sewell, ‘Secure Microkernels, State Monads and Scalable Refinement’,
+in Theorem Proving in Higher Order Logics, 2008, pp. 167–182.\<close>
+*)
+Definition PrePostE {Regs A Ety} (P : predS Regs) (f : monadS Regs A Ety) (Q : A -> predS Regs) (E : ex Ety -> predS Regs) : Prop :=
+(* ("\<lbrace>_\<rbrace> _ \<lbrace>_ \<bar> _\<rbrace>")*)
+  PrePost P f (fun v => match v with Value a => Q a | Ex e => E e end).
+
+(*lemmas PrePost_defs = PrePost_def PrePostE_def*)
+
+Lemma PrePostE_I (*[case_names Val Err]:*) Regs A Ety (P : predS Regs) f (Q : A -> predS Regs) (E : ex Ety -> predS Regs) :
+  (forall s a s', P s -> List.In (Value a, s') (f s) -> Q a s') ->
+  (forall s e s', P s -> List.In (Ex e, s') (f s) -> E e s') ->
+  PrePostE P f Q E.
+intros. unfold PrePostE.
+unfold PrePost.
+intros s Pre [a | e] s' IN; eauto.
+Qed.
+
+Lemma PrePostE_PrePost Regs A Ety P m (Q : A -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePost P m (fun v => match v with Value a => Q a | Ex e => E e end) ->
+  PrePostE P m Q E.
+auto.
+Qed.
+
+Lemma PrePostE_elim Regs A Ety P f r s s' (Q : A -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE P f Q E ->
+  P s ->
+  List.In (r, s') (f s) ->
+  (exists v, r = Value v /\ Q v s') \/
+  (exists e, r = Ex e /\ E e s').
+intros PP Pre IN.
+specialize (PP _ Pre _ _ IN).
+destruct r; eauto.
+Qed.
+
+Lemma PrePostE_consequence Regs Aty Ety (P : predS Regs) f A B C (Q : Aty -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE A f B C ->
+  (forall s, P s -> A s) ->
+  (forall v s, B v s -> Q v s) ->
+  (forall e s, C e s -> E e s) ->
+  PrePostE P f Q E.
+intros PP PA BQ CE.
+intros s Pre [a | e] s' IN.
+* apply BQ. specialize (PP _ (PA _ Pre) _ _ IN).
+  apply PP.
+* apply CE. specialize (PP _ (PA _ Pre) _ _ IN).
+  apply PP.
+Qed.
+
+Lemma PrePostE_strengthen_pre Regs Aty Ety (P : predS Regs) f R (Q : Aty -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE R f Q E ->
+  (forall s, P s -> R s) ->
+  PrePostE P f Q E.
+intros PP PR.
+eapply PrePostE_consequence; eauto.
+Qed.
+
+Lemma PrePostE_weaken_post Regs Aty Ety (A : predS Regs) f (B C : Aty -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE A f B E ->
+  (forall v s, B v s -> C v s) ->
+  PrePostE A f C E.
+intros PP BC.
+eauto using PrePostE_consequence.
+Qed.
+
+(*named_theorems PrePostE_compositeI
+named_theorems PrePostE_atomI*)
+
+Lemma PrePostE_conj_conds Regs Aty Ety (P1 P2 : predS Regs) m (Q1 Q2 : Aty -> predS Regs) (E1 E2 : ex Ety -> predS Regs) :
+  PrePostE P1 m Q1 E1 ->
+  PrePostE P2 m Q2 E2 ->
+  PrePostE (fun s => P1 s /\ P2 s) m (fun r s => Q1 r s /\ Q2 r s) (fun e s => E1 e s /\ E2 e s).
+intros H1 H2.
+apply PrePostE_I.
+* intros s a s' [p1 p2] IN.
+  specialize (H1 _ p1 _ _ IN).
+  specialize (H2 _ p2 _ _ IN).
+  simpl in *.
+  auto.
+* intros s a s' [p1 p2] IN.
+  specialize (H1 _ p1 _ _ IN).
+  specialize (H2 _ p2 _ _ IN).
+  simpl in *.
+  auto.
+Qed.
+
+(*lemmas PrePostE_conj_conds_consequence = PrePostE_conj_conds[THEN PrePostE_consequence]*)
+
+Lemma PrePostE_post_mp Regs Aty Ety (P : predS Regs) m (Q Q' : Aty -> predS Regs) (E: ex Ety -> predS Regs) :
+  PrePostE P m Q' E ->
+  PrePostE P m (fun r s => Q' r s -> Q r s) E ->
+  PrePostE P m Q E.
+intros H1 H2.
+eapply PrePostE_conj_conds in H1. 2: apply H2.
+eapply PrePostE_consequence. apply H1. all: simpl; intuition.
+Qed.
+
+Lemma PrePostE_cong Regs Aty Ety (P1 P2 : predS Regs) m1 m2 (Q1 Q2 : Aty -> predS Regs) (E1 E2 : ex Ety -> predS Regs) :
+  (forall s, P1 s <-> P2 s) ->
+  (forall s, P1 s -> m1 s = m2 s) ->
+  (forall r s, Q1 r s <-> Q2 r s) ->
+  (forall e s, E1 e s <-> E2 e s) ->
+  PrePostE P1 m1 Q1 E1 <-> PrePostE P2 m2 Q2 E2.
+intros P12 m12 Q12 E12.
+unfold PrePostE, PrePost.
+split.
+* intros. apply P12 in H0. rewrite <- m12 in H1; auto. specialize (H _ H0 _ _ H1).
+  destruct r; [ apply Q12 | apply E12]; auto.
+* intros. rewrite m12 in H1; auto. apply P12 in H0. specialize (H _ H0 _ _ H1).
+  destruct r; [ apply Q12 | apply E12]; auto.
+Qed.
+
+Lemma PrePostE_True_post (*[PrePostE_atomI, intro, simp]:*) Regs A E P (m : monadS Regs A E) :
+  PrePostE P m (fun _ _ => True) (fun _ _ => True).
+intros s Pre [a | e]; auto.
+Qed.
+
+Lemma PrePostE_any Regs A Ety m (Q : result A Ety -> predS Regs) E :
+  PrePostE (Ety := Ety) (fun s => forall r s', List.In (r, s') (m s) -> match r with Value a => Q a s' | Ex e => E e s' end) m Q E.
+apply PrePostE_I.
+intros. apply (H (Value a)); auto.
+intros. apply (H (Ex e)); auto.
+Qed.
+
+Lemma PrePostE_returnS (*[PrePostE_atomI, intro, simp]:*) Regs A E P (x : A) (Q : ex E -> predS Regs) :
+  PrePostE (P x) (returnS x) P Q.
+unfold PrePostE, PrePost.
+intros s Pre r s' [[= <- <-] | []].
+assumption.
+Qed.
+
+Lemma PrePostE_bindS (*[intro, PrePostE_compositeI]:*) Regs A B Ety P m (f : A -> monadS Regs B Ety) Q R E :
+  (forall s a s', List.In (Value a, s') (m s) -> PrePostE (R a) (f a) Q E) ->
+  PrePostE P m R E ->
+  PrePostE P (bindS m f) Q E.
+intros.
+unfold PrePostE in *.
+eauto using PrePost_bindS.
+Qed.
+
+Lemma PrePostE_bindS_ignore Regs A B Ety (P : predS Regs) (m : monadS Regs A Ety) (f : monadS Regs B Ety) R Q E :
+  PrePostE R f Q E ->
+  PrePostE P m (fun _ => R) E ->
+  PrePostE P (bindS m (fun _ => f)) Q E.
+apply PrePost_bindS_ignore.
+Qed.
+
+Lemma PrePostE_bindS_unit Regs A Ety (P : predS Regs) (m : monadS Regs unit Ety) (f : unit -> monadS Regs A Ety) Q R E :
+  PrePostE R (f tt) Q E ->
+  PrePostE P m (fun _ => R) E ->
+  PrePostE P (bindS m f) Q E.
+apply PrePost_bindS_unit.
+Qed.
+
+Lemma PrePostE_readS (*[PrePostE_atomI, intro]:*) Regs A Ety (P : predS Regs) f (Q : result A Ety -> predS Regs) E :
+  PrePostE (Ety := Ety) (fun s => Q (f s) s) (readS f) Q E.
+unfold PrePostE, PrePost, readS.
+intros s Pre [a | e] s' [[= <- <-] | []].
+assumption.
+Qed.
+
+Lemma PrePostE_updateS (*[PrePostE_atomI, intro]:*) Regs Ety f (Q : unit -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE (fun s => Q tt (f s)) (updateS f) Q E.
+intros s Pre [a | e] s' [[= <- <-] | []].
+assumption.
+Qed.
+
+Lemma PrePostE_if_branch (*[PrePostE_compositeI]:*) Regs A Ety (b : bool) (f g : monadS Regs A Ety) Pf Pg Q E :
+  (b = true  -> PrePostE Pf f Q E) ->
+  (b = false -> PrePostE Pg g Q E) ->
+  PrePostE (if b then Pf else Pg) (if b then f else g) Q E.
+destruct b; auto.
+Qed.
+
+Lemma PrePostE_if Regs A Ety (b : bool) (f g : monadS Regs A Ety) P Q E :
+  (b = true  -> PrePostE P f Q E) ->
+  (b = false -> PrePostE P g Q E) ->
+  PrePostE P (if b then f else g) Q E.
+destruct b; auto.
+Qed.
+
+Lemma PrePostE_if_then Regs A Ety (b : bool) (f g : monadS Regs A Ety) P Q E :
+  b = true ->
+  PrePostE P f Q E ->
+  PrePostE P (if b then f else g) Q E.
+intros; subst; auto.
+Qed.
+
+Lemma PrePostE_if_else Regs A Ety (b : bool) (f g : monadS Regs A Ety) P Q E :
+  b = false ->
+  PrePostE P g Q E ->
+  PrePostE P (if b then f else g) Q E.
+intros; subst; auto.
+Qed.
+
+Lemma PrePostE_prod_cases (*[PrePostE_compositeI]:*) Regs A B C Ety x (f : A -> B -> monadS Regs C Ety) P Q E :
+  PrePostE P (f (fst x) (snd x)) Q E ->
+  PrePostE P (match x with (a, b) => f a b end) Q E.
+destruct x; auto.
+Qed.
+
+Lemma PrePostE_option_cases (*[PrePostE_compositeI]:*) Regs A B Ety x (s : option A -> monadS Regs B Ety) n PS PN Q E :
+  (forall a, PrePostE (PS a) (s a) Q E) ->
+  PrePostE PN n Q E ->
+  PrePostE (match x with Some a => PS a | None => PN end) (match x with Some a => s a | None => n end) Q E.
+apply PrePost_option_cases.
+Qed.
+
+Lemma PrePostE_sum_cases (*[PrePostE_compositeI]:*) Regs A B C Ety x (l : A -> monadS Regs C Ety) (r : B -> monadS Regs C Ety) Pl Pr Q E :
+  (forall a, PrePostE (Pl a) (l a) Q E) ->
+  (forall b, PrePostE (Pr b) (r b) Q E) ->
+  PrePostE (match x with inl a => Pl a | inr b => Pr b end) (match x with inl a => l a | inr b => r b end) Q E.
+intros; destruct x; auto.
+Qed.
+
+Lemma PrePostE_let (*[PrePostE_compositeI]:*) Regs A B Ety y (m : A -> monadS Regs B Ety) P Q E :
+  PrePostE P (m y) Q E ->
+  PrePostE P (let x := y in m x) Q E.
+auto.
+Qed.
+
+Lemma PrePostE_and_boolS (*[PrePostE_compositeI]:*) Regs Ety (l r : monadS Regs bool Ety) P Q R E :
+  PrePostE R r Q E ->
+  PrePostE P l (fun r => if r then R else Q false) E ->
+  PrePostE P (and_boolS l r) Q E.
+intros Hr Hl.
+unfold and_boolS.
+eapply PrePostE_bindS.
+* intros.
+  instantiate (1 := fun a => if a then R else Q false).
+  destruct a; eauto.
+  apply PrePostE_returnS.
+* assumption.
+Qed.
+
+Lemma PrePostE_or_boolS (*[PrePostE_compositeI]:*) Regs Ety (l r : monadS Regs bool Ety) P Q R E :
+  PrePostE R r Q E ->
+  PrePostE P l (fun r => if r then Q true else R) E ->
+  PrePostE P (or_boolS l r) Q E.
+intros Hr Hl.
+unfold or_boolS.
+eapply PrePostE_bindS.
+* intros.
+  instantiate (1 := fun a => if a then Q true else R).
+  destruct a; eauto.
+  apply PrePostE_returnS.
+* assumption.
+Qed.
+
+Lemma PrePostE_failS (*[PrePostE_atomI, intro]:*) Regs A Ety msg (Q : A -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE (E (Failure msg)) (failS msg) Q E.
+unfold PrePostE, PrePost, failS.
+intros s Pre r s' [[= <- <-] | []].
+assumption.
+Qed.
+
+Lemma PrePostE_assert_expS (*[PrePostE_atomI, intro]:*) Regs Ety (c : bool) m P (Q : ex Ety -> predS Regs) :
+  PrePostE (if c then P tt else Q (Failure m)) (assert_expS c m) P Q.
+unfold assert_expS.
+destruct c; auto using PrePostE_returnS, PrePostE_failS.
+Qed.
+
+Lemma PrePostE_maybe_failS (*[PrePostE_atomI]:*) Regs A Ety msg v (Q : A -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE (fun s => match v with Some v => Q v s | None => E (Failure msg) s end) (maybe_failS msg v) Q E.
+unfold maybe_failS.
+destruct v; auto using PrePostE_returnS, PrePostE_failS.
+Qed.
+
+Lemma PrePostE_exitS (*[PrePostE_atomI, intro]:*) Regs A Ety msg (Q : A -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE (E (Failure "exit")) (exitS msg) Q E.
+unfold exitS.
+apply PrePostE_failS.
+Qed.
+
+Lemma PrePostE_chooseS (*[intro, PrePostE_atomI]:*) Regs A Ety (xs : list A) (Q : A -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE (fun s => forall x, List.In x xs -> Q x s) (chooseS xs) Q E.
+unfold chooseS.
+intros s IN r s' IN'.
+apply List.in_map_iff in IN'.
+destruct IN' as (x & [= <- <-] & IN').
+auto.
+Qed.
+
+Lemma PrePostE_throwS (*[PrePostE_atomI]:*) Regs A Ety e (Q : A -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE (E (Throw e)) (throwS e) Q E.
+unfold throwS.
+intros s Pre r s' [[= <- <-] | []].
+assumption.
+Qed.
+
+Lemma PrePostE_try_catchS (*[PrePostE_compositeI]:*) Regs A E1 E2 m h P (Ph : E1 -> predS Regs) (Q : A -> predS Regs) (E : ex E2 -> predS Regs) :
+  (forall s e s', List.In (Ex (Throw e), s') (m s) -> PrePostE (Ph e) (h e) Q E) ->
+  PrePostE P m Q (fun ex => match ex with Throw e => Ph e | Failure msg => E (Failure msg) end) ->
+  PrePostE P (try_catchS m h) Q E.
+intros.
+intros s Pre r s' IN.
+destruct (try_catchS_cases IN) as [(a' & [= ->] & IN') | [(msg & [= ->] & IN') | (e & s'' & IN1 & IN2)]].
+* specialize (H0 _ Pre _ _ IN'). apply H0.
+* specialize (H0 _ Pre _ _ IN'). apply H0.
+* specialize (H _ _ _ IN1). specialize (H0 _ Pre _ _ IN1). simpl in *.
+    specialize (H _ H0 _ _ IN2). apply H.
+Qed.
+
+Lemma PrePostE_catch_early_returnS (*[PrePostE_compositeI]:*) Regs A Ety m P (Q : A -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE P m Q (fun ex => match ex with Throw (inl a) => Q a | Throw (inr e) => E (Throw e) | Failure msg => E (Failure msg) end) ->
+  PrePostE P (catch_early_returnS m) Q E.
+unfold catch_early_returnS.
+intro H.
+apply PrePostE_try_catchS with (Ph := fun e => match e with inl a => Q a | inr e => E (Throw e) end).
+* intros. destruct e.
+  + apply PrePostE_returnS.
+  + apply PrePostE_throwS.
+* apply H.
+Qed.
+
+Lemma PrePostE_early_returnS (*[PrePostE_atomI]:*) Regs A E1 E2 r (Q : A -> predS Regs) (E : ex (E1 + E2) -> predS Regs) :
+  PrePostE (E (Throw (inl r))) (early_returnS r) Q E.
+unfold early_returnS.
+apply PrePostE_throwS.
+Qed.
+
+Lemma PrePostE_liftRS (*[PrePostE_compositeI]:*) Regs A E1 E2 m P (Q : A -> predS Regs) (E : ex (E1 + E2) -> predS Regs) :
+  PrePostE P m Q (fun ex => match ex with Throw e => E (Throw (inr e)) | Failure msg => E (Failure msg) end) ->
+  PrePostE P (liftRS m) Q E.
+unfold liftRS.
+apply PrePostE_try_catchS.
+auto using PrePostE_throwS.
+Qed.
+
+Lemma PrePostE_foreachS_Cons Regs A Vars Ety (x : A) xs vars body (Q : Vars -> predS Regs) (E : ex Ety -> predS Regs) :
+  (forall s vars' s', List.In (Value vars', s') (body x vars s) -> PrePostE (Q vars') (foreachS xs vars' body) Q E) ->
+  PrePostE (Q vars) (body x vars) Q E ->
+  PrePostE (Q vars) (foreachS (x :: xs) vars body) Q E.
+intros.
+simpl.
+apply PrePostE_bindS with (R := Q); auto.
+Qed.
+
+Lemma PrePostE_foreachS_invariant Regs A Vars Ety (xs : list A) vars body (Q : Vars -> predS Regs) (E : ex Ety -> predS Regs) :
+  (forall x vars, List.In x xs -> PrePostE (Q vars) (body x vars) Q E) ->
+  PrePostE (Q vars) (foreachS xs vars body) Q E.
+unfold PrePostE.
+intros H.
+apply PrePost_foreachS_invariant with (Q := fun v => match v with Value a => Q a | Ex e => E e end).
+auto.
+Qed.
+(*
+Lemma PrePostE_untilS:
+  assumes dom: (forall s, Inv Q vars s -> untilS_dom (vars, cond, body, s)"
+    and cond: (forall vars, PrePostE (Inv' Q vars) (cond vars) (fun c s' => Inv Q vars s' /\ (c \<longrightarrow> Q vars s')) E"
+    and body: (forall vars, PrePostE (Inv Q vars) (body vars) (Inv' Q) E"
+  shows "PrePostE (Inv Q vars) (untilS vars cond body) Q E"
+proof (unfold PrePostE_def, rule PrePostI)
+  fix s r s'
+  assume Inv_s: "Inv Q vars s" and r: "(r, s') \<in> untilS vars cond body s"
+  with dom[OF Inv_s] cond body
+  show "(case r of Value a => Q a | result.Ex e => E e) s'"
+  proof (induction vars cond body s rule: untilS.pinduct[case_names Step])
+    case (Step vars cond body s)
+    consider
+        (Value) vars' c sb sc where "(Value vars', sb) \<in> body vars s" and "(Value c, sc) \<in> cond vars' sb"
+                                and "if c then r = Value vars' /\ s' = sc else (r, s') \<in> untilS vars' cond body sc"
+      | (Ex) e where "(Ex e, s') \<in> bindS (body vars) cond s" and "r = Ex e"
+      using Step(1,6)
+      by (auto simp: untilS.psimps returnS_def Ex_bindS_iff elim!: bindS_cases split: if_splits; fastforce)
+    then show ?case
+    proof cases
+      case Value
+      then show ?thesis using Step.IH[OF Value(1,2) _ Step(3,4)] Step(3,4,5)
+        by (auto split: if_splits elim: PrePostE_elim)
+    next
+      case Ex
+      then show ?thesis using Step(3,4,5) by (auto elim!: bindS_cases PrePostE_elim)
+    qed
+  qed
+qed
+
+lemma PrePostE_untilS_pure_cond:
+  assumes dom: (forall s, Inv Q vars s -> untilS_dom (vars, returnS \<circ> cond, body, s)"
+    and body: (forall vars, PrePostE (Inv Q vars) (body vars) (fun vars' s' => Inv Q vars' s' /\ (cond vars' \<longrightarrow> Q vars' s')) E"
+  shows "PrePostE (Inv Q vars) (untilS vars (returnS \<circ> cond) body) Q E"
+  using assms by (intro PrePostE_untilS) (auto simp: comp_def)
+
+lemma PrePostE_liftState_untilM:
+  assumes dom: (forall s, Inv Q vars s -> untilM_dom (vars, cond, body)"
+    and cond: (forall vars, PrePostE (Inv' Q vars) (liftState r (cond vars)) (fun c s' => Inv Q vars s' /\ (c \<longrightarrow> Q vars s')) E"
+    and body: (forall vars, PrePostE (Inv Q vars) (liftState r (body vars)) (Inv' Q) E"
+  shows "PrePostE (Inv Q vars) (liftState r (untilM vars cond body)) Q E"
+proof -
+  have domS: "untilS_dom (vars, liftState r \<circ> cond, liftState r \<circ> body, s)" if "Inv Q vars s" for s
+    using dom that by (intro untilM_dom_untilS_dom)
+  then have "PrePostE (Inv Q vars) (untilS vars (liftState r \<circ> cond) (liftState r \<circ> body)) Q E"
+    using cond body by (auto intro: PrePostE_untilS simp: comp_def)
+  moreover have "liftState r (untilM vars cond body) s = untilS vars (liftState r \<circ> cond) (liftState r \<circ> body) s"
+    if "Inv Q vars s" for s
+    unfolding liftState_untilM[OF domS[OF that] dom[OF that]] ..
+  ultimately show ?thesis by (auto cong: PrePostE_cong)
+qed
+
+lemma PrePostE_liftState_untilM_pure_cond:
+  assumes dom: (forall s, Inv Q vars s -> untilM_dom (vars, return \<circ> cond, body)"
+    and body: (forall vars, PrePostE (Inv Q vars) (liftState r (body vars)) (fun vars' s' => Inv Q vars' s' /\ (cond vars' \<longrightarrow> Q vars' s')) E"
+  shows "PrePostE (Inv Q vars) (liftState r (untilM vars (return \<circ> cond) body)) Q E"
+  using assms by (intro PrePostE_liftState_untilM) (auto simp: comp_def liftState_simp)
+*)
+Lemma PrePostE_choose_boolS_any (*[PrePostE_atomI]:*) Regs Ety unit_val (Q : bool -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE (fun s => forall b, Q b s) (choose_boolS unit_val) Q E.
+unfold choose_boolS, seqS.
+eapply PrePostE_strengthen_pre.
+apply PrePostE_chooseS.
+simpl. intros. destruct x; auto.
+Qed.
+
+Lemma PrePostE_bool_of_bitU_nondetS_any Regs Ety b (Q : bool -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE (fun s => forall b, Q b s) (bool_of_bitU_nondetS b) Q E.
+unfold bool_of_bitU_nondetS, undefined_boolS.
+destruct b.
+* intros s Pre r s' [[= <- <-] | []]. auto.
+* intros s Pre r s' [[= <- <-] | []]. auto.
+* apply PrePostE_choose_boolS_any.
+Qed.
+(*
+Lemma PrePostE_bools_of_bits_nondetS_any:
+  PrePostE (fun s => forall bs, Q bs s) (bools_of_bits_nondetS bs) Q E.
+  unfolding bools_of_bits_nondetS_def
+  by (rule PrePostE_weaken_post[where B = "fun _ s => forall bs, Q bs s"], rule PrePostE_strengthen_pre,
+      (rule PrePostE_foreachS_invariant[OF PrePostE_strengthen_pre] PrePostE_bindS PrePostE_returnS
+            PrePostE_bool_of_bitU_nondetS_any)+)
+     auto
+*)
+Lemma PrePostE_choose_boolsS_any Regs Ety n (Q : list bool -> predS Regs) (E : ex Ety -> predS Regs) :
+  PrePostE (fun s => forall bs, Q bs s) (choose_boolsS n) Q E.
+unfold choose_boolsS, genlistS.
+apply PrePostE_weaken_post with (B := fun _ s => forall bs, Q bs s).
+* apply PrePostE_foreachS_invariant with (Q := fun _ s => forall bs, Q bs s).
+  intros. apply PrePostE_bindS with (R := fun _ s => forall bs, Q bs s).
+  + intros. apply PrePostE_returnS with (P := fun _ s => forall bs, Q bs s).
+  + eapply PrePostE_strengthen_pre.
+    apply PrePostE_choose_boolS_any.
+    intuition.
+* intuition.
+Qed.
+
+Lemma nth_error_exists {A} {l : list A} {n} :
+  n < Datatypes.length l -> exists x, List.In x l /\ List.nth_error l n = Some x.
+revert n. induction l.
+* simpl. intros. apply PeanoNat.Nat.nlt_0_r in H. destruct H.
+* intros. destruct n.
+  + exists a. auto with datatypes.
+  + simpl in H. apply Lt.lt_S_n in H.
+    destruct (IHl n H) as [x H1].
+    intuition eauto with datatypes.
+Qed.
+
+Lemma nth_error_modulo {A} {xs : list A} n :
+  xs <> nil ->
+  exists x, List.In x xs /\ List.nth_error xs (PeanoNat.Nat.modulo n (Datatypes.length xs)) = Some x.
+intro notnil.
+assert (Datatypes.length xs <> 0) by (rewrite List.length_zero_iff_nil; auto).
+assert (PeanoNat.Nat.modulo n (Datatypes.length xs) < Datatypes.length xs) by auto using PeanoNat.Nat.mod_upper_bound.
+destruct (nth_error_exists H0) as [x [H1 H2]].
+exists x.
+auto.
+Qed.
+
+Lemma PrePostE_internal_pick Regs A Ety (xs : list A) (Q : A -> predS Regs) (E : ex Ety -> predS Regs) :
+  xs <> nil ->
+  PrePostE (fun s => forall x, List.In x xs -> Q x s) (internal_pickS xs) Q E.
+unfold internal_pickS.
+intro notnil.
+eapply PrePostE_bindS with (R := fun _ s => forall x, List.In x xs -> Q x s).
+* intros.
+  destruct (nth_error_modulo (Sail2_values.nat_of_bools a) notnil) as (x & IN & nth).
+  rewrite nth.
+  eapply PrePostE_strengthen_pre.
+  apply PrePostE_returnS.
+  intuition.
+* eapply PrePostE_strengthen_pre.
+  apply PrePostE_choose_boolsS_any.
+  intuition.
+Qed.
diff --git a/lib/coq/Makefile b/lib/coq/Makefile
index f763db6f..fa453d90 100644
--- a/lib/coq/Makefile
+++ b/lib/coq/Makefile
@@ -1,6 +1,8 @@
 BBV_DIR?=../../../bbv
 
-SRC=Sail2_prompt_monad.v  Sail2_prompt.v  Sail2_impl_base.v  Sail2_instr_kinds.v  Sail2_operators_bitlists.v  Sail2_operators_mwords.v  Sail2_operators.v  Sail2_values.v  Sail2_state_monad.v  Sail2_state.v  Sail2_state_lifting.v  Sail2_string.v  Sail2_real.v
+CORESRC=Sail2_prompt_monad.v  Sail2_prompt.v  Sail2_impl_base.v  Sail2_instr_kinds.v  Sail2_operators_bitlists.v  Sail2_operators_mwords.v  Sail2_operators.v  Sail2_values.v  Sail2_state_monad.v  Sail2_state.v  Sail2_state_lifting.v  Sail2_string.v  Sail2_real.v
+PROOFSRC=Sail2_state_monad_lemmas.v Sail2_state_lemmas.v Hoare.v
+SRC=$(CORESRC) $(PROOFSRC)
 
 COQ_LIBS = -R . Sail -R "$(BBV_DIR)/theories" bbv
 
diff --git a/lib/coq/Sail2_instr_kinds.v b/lib/coq/Sail2_instr_kinds.v
index 338bf10b..85d78226 100644
--- a/lib/coq/Sail2_instr_kinds.v
+++ b/lib/coq/Sail2_instr_kinds.v
@@ -139,12 +139,25 @@ instance (Show write_kind)
   end
 end
 *)
+
+Inductive a64_barrier_domain :=
+  A64_FullShare
+  | A64_InnerShare
+  | A64_OuterShare
+  | A64_NonShare.
+
+Inductive a64_barrier_type :=
+  A64_barrier_all
+  | A64_barrier_LD
+  | A64_barrier_ST.
+
 Inductive barrier_kind :=
   (* Power barriers *)
   Barrier_Sync | Barrier_LwSync | Barrier_Eieio | Barrier_Isync
   (* AArch64 barriers *)
-  | Barrier_DMB | Barrier_DMB_ST | Barrier_DMB_LD | Barrier_DSB
-  | Barrier_DSB_ST | Barrier_DSB_LD | Barrier_ISB
+  | Barrier_DMB (*: a64_barrier_domain -> a64_barrier_type -> barrier_kind*)
+  | Barrier_DSB (*: a64_barrier_domain -> a64_barrier_type -> barrier_kind*)
+  | Barrier_ISB
  (* | Barrier_TM_COMMIT*)
   (* MIPS barriers *)
   | Barrier_MIPS_SYNC
diff --git a/lib/coq/Sail2_prompt.v b/lib/coq/Sail2_prompt.v
index 68d097fb..b5e94e46 100644
--- a/lib/coq/Sail2_prompt.v
+++ b/lib/coq/Sail2_prompt.v
@@ -53,6 +53,10 @@ Definition foreach_ZM_down {rv e Vars} from to step vars body `{ArithFact (0 < s
 
 (*declare {isabelle} termination_argument foreachM = automatic*)
 
+Definition genlistM {A RV E} (f : nat -> monad RV A E) (n : nat) : monad RV (list A) E :=
+  let indices := List.seq 0 n in
+  foreachM indices [] (fun n xs => (f n >>= (fun x => returnm (xs ++ [x])))).
+
 (*val and_boolM : forall 'rv 'e. monad 'rv bool 'e -> monad 'rv bool 'e -> monad 'rv bool 'e*)
 Definition and_boolM {rv E} (l : monad rv bool E) (r : monad rv bool E) : monad rv bool E :=
  l >>= (fun l => if l then r else returnm false).
@@ -181,23 +185,21 @@ Definition untilMT {RV Vars E} limit (vars : Vars) (cond : Vars -> monad RV bool
     else slice vec (start_vec - size_r1) (start_vec - size_vec) in
   write_reg r1 r1_v >> write_reg r2 r2_v*)
 
-Fixpoint pick_bit_list {rv e} (n:nat) : monad rv (list bool) e :=
-  match n with
-  | O => returnm []
-  | S m => choose_bool "pick_bit_list" >>= fun b =>
-           pick_bit_list m >>= fun t =>
-           returnm (b::t)
-  end%list.
+Definition choose_bools {RV E} (descr : string) (n : nat) : monad RV (list bool) E :=
+  genlistM (fun _ => choose_bool descr) n.
+
+Definition choose {RV A E} (descr : string) (xs : list A) : monad RV A E :=
+  (* Use sufficiently many nondeterministically chosen bits and convert into an
+     index into the list *)
+  choose_bools descr (List.length xs) >>= fun bs =>
+  let idx := ((nat_of_bools bs) mod List.length xs)%nat in
+  match List.nth_error xs idx with
+    | Some x => returnm x
+    | None => Fail ("choose " ++ descr)
+  end.
 
 Definition internal_pick {rv a e} (xs : list a) : monad rv a e :=
-  let n := length xs in
-  match xs with
-  | h::_ =>
-    pick_bit_list (2 + n) >>= fun bs =>
-    let i := (Word.wordToNat (wordFromBitlist bs) mod n)%nat in
-    returnm (List.nth i xs h)
-  | [] => Fail "internal_pick called on empty list"
-  end.
+  choose "internal_pick" xs.
 
 Fixpoint undefined_word_nat {rv e} n : monad rv (Word.word n) e :=
   match n with
diff --git a/lib/coq/Sail2_state.v b/lib/coq/Sail2_state.v
index b73d5013..bd18783f 100644
--- a/lib/coq/Sail2_state.v
+++ b/lib/coq/Sail2_state.v
@@ -32,7 +32,7 @@ end.
 
 (*val genlistS : forall 'a 'rv 'e. (nat -> monadS 'rv 'a 'e) -> nat -> monadS 'rv (list 'a) 'e*)
 Definition genlistS {A RV E} (f : nat -> monadS RV A E) n : monadS RV (list A) E :=
-  let indices := genlist (fun n => n) n in
+  let indices := List.seq 0 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*)
@@ -43,6 +43,31 @@ Definition and_boolS {RV E} (l r : monadS RV bool E) : monadS RV bool E :=
 Definition or_boolS {RV E} (l r : monadS RV bool E) : monadS RV bool E :=
  l >>$= (fun l => if l then returnS true else r).
 
+Definition and_boolSP {rv E} {P Q R:bool->Prop} (x : monadS rv {b:bool & ArithFact (P b)} E) (y : monadS rv {b:bool & ArithFact (Q b)} E)
+  `{H:ArithFact (forall l r, P l -> (l = true -> Q r) -> R (andb l r))}
+  : monadS rv {b:bool & ArithFact (R b)} E.
+refine (
+  x >>$= fun '(existT _ x (Build_ArithFact _ p)) => (if x return P x -> _ then
+    fun p => y >>$= fun '(existT _ y _) => returnS (existT _ y _)
+  else fun p => returnS (existT _ false _)) p
+).
+* constructor. destruct H. destruct a0. change y with (andb true y). auto.
+* constructor. destruct H. change false with (andb false false). apply fact.
+  assumption.
+  congruence.
+Defined.
+Definition or_boolSP {rv E} {P Q R:bool -> Prop} (l : monadS rv {b : bool & ArithFact (P b)} E) (r : monadS rv {b : bool & ArithFact (Q b)} E)
+ `{ArithFact (forall l r, P l -> (l = false -> Q r) -> R (orb l r))}
+ : monadS rv {b : bool & ArithFact (R b)} E.
+refine (
+ l >>$= fun '(existT _ l (Build_ArithFact _ p)) =>
+  (if l return P l -> _ then fun p => returnS (existT _ true _)
+   else fun p => r >>$= fun '(existT _ r _) => returnS (existT _ r _)) p
+).
+* constructor. destruct H. change true with (orb true true). apply fact. assumption. congruence.
+* constructor. destruct H. destruct a0. change r with (orb false r). auto.
+Defined.
+
 (*val bool_of_bitU_fail : forall 'rv 'e. bitU -> monadS 'rv bool 'e*)
 Definition bool_of_bitU_fail {RV E} (b : bitU) : monadS RV bool E :=
 match b with
@@ -96,21 +121,45 @@ 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
 *)
+
+Fixpoint whileST' {RV Vars E} limit (vars : Vars) (cond : Vars -> monadS RV bool E) (body : Vars -> monadS RV Vars E) (acc : Acc (Zwf 0) limit) : monadS RV Vars E :=
+  if Z_ge_dec limit 0 then
+    cond vars >>$= fun cond_val =>
+    if cond_val then
+      body vars >>$= fun vars => whileST' (limit - 1) vars cond body (_limit_reduces acc)
+    else returnS vars
+  else failS "Termination limit reached".
+
+Definition whileST {RV Vars E} limit (vars : Vars) (cond : Vars -> monadS RV bool E) (body : Vars -> monadS RV Vars E) : monadS RV Vars E :=
+  whileST' limit vars cond body (Zwf_guarded limit).
+
+(*val untilM : forall 'rv 'vars 'e. 'vars -> ('vars -> monad 'rv bool 'e) ->
+                ('vars -> monad 'rv 'vars 'e) -> monad 'rv 'vars 'e*)
+Fixpoint untilST' {RV Vars E} limit (vars : Vars) (cond : Vars -> monadS RV bool E) (body : Vars -> monadS RV Vars E) (acc : Acc (Zwf 0) limit) : monadS RV Vars E :=
+  if Z_ge_dec limit 0 then
+    body vars >>$= fun vars =>
+    cond vars >>$= fun cond_val =>
+    if cond_val then returnS vars else untilST' (limit - 1) vars cond body (_limit_reduces acc)
+  else failS "Termination limit reached".
+
+Definition untilST {RV Vars E} limit (vars : Vars) (cond : Vars -> monadS RV bool E) (body : Vars -> monadS RV Vars E) : monadS RV Vars E :=
+  untilST' limit vars cond body (Zwf_guarded limit).
+
+
 (*val choose_boolsS : forall 'rv 'e. nat -> monadS 'rv (list bool) 'e*)
 Definition choose_boolsS {RV E} n : monadS RV (list bool) E :=
  genlistS (fun _ => choose_boolS tt) 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 =
+(*val internal_pickS : forall 'rv 'a 'e. list 'a -> monadS 'rv 'a 'e*)
+Definition internal_pickS {RV A E} (xs : list A) : monadS RV A E :=
   (* 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 "choose internal_pick"
-  end
+  choose_boolsS (List.length xs) >>$= fun bs =>
+  let idx := ((nat_of_bools bs) mod List.length xs)%nat in
+  match List.nth_error xs idx with
+    | Some x => returnS x
+    | None => failS "choose internal_pick"
+  end.
 
 
-*)
diff --git a/lib/coq/Sail2_state_lemmas.v b/lib/coq/Sail2_state_lemmas.v
new file mode 100644
index 00000000..563a17a6
--- /dev/null
+++ b/lib/coq/Sail2_state_lemmas.v
@@ -0,0 +1,796 @@
+Require Import Sail2_values Sail2_prompt_monad Sail2_prompt Sail2_state_monad Sail2_state Sail2_state Sail2_state_lifting.
+Require Import Sail2_state_monad_lemmas.
+
+(* Monad lifting *)
+
+Lemma liftState_bind Regval Regs A B E {r : Sail2_values.register_accessors Regs Regval} {m : monad Regval A E} {f : A -> monad Regval B E} {s} :
+  liftState r (bind m f) s = bindS (liftState r m) (fun x => liftState r (f x)) s.
+revert s. induction m; simpl.
+all: try (intros; unfold seqS; rewrite bindS_assoc; auto using bindS_ext_cong).
+all: try auto.
+* intro s.
+  rewrite bindS_returnS_left.
+  reflexivity.
+Qed.
+Hint Rewrite liftState_bind : liftState.
+
+Lemma liftState_return Regval Regs A E {r : Sail2_values.register_accessors Regs Regval} {a :A} :
+  liftState (E:=E) r (returnm a) = returnS a.
+reflexivity.
+Qed.
+Hint Rewrite liftState_return : liftState.
+
+(*
+Lemma Value_liftState_Run:
+  List.In (Value a, s') (liftState r m s)
+  exists t, Run m t a.
+  by (use assms in \<open>induction r m arbitrary: s s' rule: liftState.induct\<close>;
+      simp add: failS_def throwS_def returnS_def del: read_regvalS.simps;
+      blast elim: Value_bindS_elim)
+
+lemmas liftState_if_distrib[liftState_simp] = if_distrib[where f = "liftState ra" for ra]
+*)
+Lemma liftState_if_distrib {Regs Regval A E r x y} {c : bool} :
+  @liftState Regs Regval A E r (if c then x else y) = if c then liftState r x else liftState r y.
+destruct c; reflexivity.
+Qed.
+Lemma liftState_if_distrib_sumbool {Regs Regval A E P Q r x y} {c : sumbool P Q} :
+  @liftState Regs Regval A E r (if c then x else y) = if c then liftState r x else liftState r y.
+destruct c; reflexivity.
+Qed.
+
+Lemma Value_bindS_iff {Regs A B E} {f : A -> monadS Regs B E} {b m s s''} :
+  List.In (Value b, s'') (bindS m f s) <-> (exists a s', List.In (Value a, s') (m s) /\ List.In (Value b, s'') (f a s')).
+split.
+* intro H.
+  apply bindS_cases in H.
+  destruct H as [(? & ? & ? & [= <-] & ? & ?) | [(? & [= <-] & ?) | (? & ? & ? & [= <-] & ? & ?)]];
+  eauto.
+* intros (? & ? & ? & ?).
+  eauto with bindS_intros.
+Qed.
+
+Lemma Ex_bindS_iff {Regs A B E} {f : A -> monadS Regs B E} {m e s s''} :
+  List.In (Ex e, s'') (bindS m f s) <-> List.In (Ex e, s'') (m s) \/ (exists a s', List.In (Value a, s') (m s) /\ List.In (Ex e, s'') (f a s')).
+split.
+* intro H.
+  apply bindS_cases in H.
+  destruct H as [(? & ? & ? & [= <-] & ? & ?) | [(? & [= <-] & ?) | (? & ? & ? & [= <-] & ? & ?)]];
+  eauto.
+* intros [H | (? & ? & H1 & H2)];
+  eauto with bindS_intros.
+Qed.
+
+Lemma liftState_throw Regs Regval A E {r} {e : E} :
+  @liftState Regval Regs A E r (throw e) = throwS e.
+reflexivity.
+Qed.
+Lemma liftState_assert Regs Regval E {r c msg} :
+  @liftState Regval Regs _ E r (assert_exp c msg) = assert_expS c msg.
+destruct c; reflexivity.
+Qed.
+Lemma liftState_exit Regs Regval A E r :
+  @liftState Regval Regs A E r (exit tt) = exitS tt.
+reflexivity.
+Qed.
+Lemma liftState_exclResult Regs Regval E r :
+  @liftState Regs Regval _ E r (excl_result tt) = excl_resultS tt.
+reflexivity.
+Qed.
+Lemma liftState_barrier Regs Regval E r bk :
+  @liftState Regs Regval _ E r (barrier bk) = returnS tt.
+reflexivity.
+Qed.
+Lemma liftState_footprint Regs Regval E r :
+  @liftState Regs Regval _ E r (footprint tt) = returnS tt.
+reflexivity.
+Qed.
+Lemma liftState_choose_bool Regs Regval E r descr :
+  @liftState Regs Regval _ E r (choose_bool descr) = choose_boolS tt.
+reflexivity.
+Qed.
+(*declare undefined_boolS_def[simp]*)
+Lemma liftState_undefined Regs Regval E r :
+  @liftState Regs Regval _ E r (undefined_bool tt) = undefined_boolS tt.
+reflexivity.
+Qed.
+Lemma liftState_maybe_fail Regs Regval A E r msg x :
+  @liftState Regs Regval A E r (maybe_fail msg x) = maybe_failS msg x.
+destruct x; reflexivity.
+Qed.
+Lemma liftState_and_boolM Regs Regval E r x y s :
+  @liftState Regs Regval _ E r (and_boolM x y) s = and_boolS (liftState r x) (liftState r y) s.
+unfold and_boolM, and_boolS.
+rewrite liftState_bind.
+apply bindS_ext_cong; auto.
+intros. rewrite liftState_if_distrib.
+reflexivity.
+Qed.
+Lemma liftState_and_boolMP Regs Regval E P Q R r x y s H :
+  @liftState Regs Regval _ E r (@and_boolMP _ _ P Q R x y H) s = and_boolSP (liftState r x) (liftState r y) s.
+unfold and_boolMP, and_boolSP.
+rewrite liftState_bind.
+simpl.
+apply bindS_ext_cong; auto.
+intros [[|] [A]] s' ?.
+* rewrite liftState_bind;
+  simpl;
+  apply bindS_ext_cong; auto;
+  intros [a' A'] s'' ?;
+  rewrite liftState_return;
+  reflexivity.
+* rewrite liftState_return.
+  reflexivity.
+Qed.
+
+Lemma liftState_or_boolM Regs Regval E r x y s :
+  @liftState Regs Regval _ E r (or_boolM x y) s = or_boolS (liftState r x) (liftState r y) s.
+unfold or_boolM, or_boolS.
+rewrite liftState_bind.
+apply bindS_ext_cong; auto.
+intros. rewrite liftState_if_distrib.
+reflexivity.
+Qed.
+Lemma liftState_or_boolMP Regs Regval E P Q R r x y s H :
+  @liftState Regs Regval _ E r (@or_boolMP _ _ P Q R x y H) s = or_boolSP (liftState r x) (liftState r y) s.
+unfold or_boolMP, or_boolSP.
+rewrite liftState_bind.
+simpl.
+apply bindS_ext_cong; auto.
+intros [[|] [A]] s' ?.
+* rewrite liftState_return.
+  reflexivity.
+* rewrite liftState_bind;
+  simpl;
+  apply bindS_ext_cong; auto;
+  intros [a' A'] s'' ?;
+  rewrite liftState_return;
+  reflexivity.
+Qed.
+Hint Rewrite liftState_throw liftState_assert liftState_exit liftState_exclResult
+             liftState_barrier liftState_footprint liftState_choose_bool
+             liftState_undefined liftState_maybe_fail
+             liftState_and_boolM liftState_and_boolMP
+             liftState_or_boolM liftState_or_boolMP
+           : liftState.
+
+Lemma liftState_try_catch Regs Regval A E1 E2 r m h s :
+  @liftState Regs Regval A E2 r (try_catch (E1 := E1) m h) s = try_catchS (liftState r m) (fun e => liftState r (h e)) s.
+revert s.
+induction m; intros; simpl;
+try solve
+[ auto
+| unfold seqS;
+  erewrite try_catchS_bindS_no_throw; intros;
+  only 2,3: (autorewrite with ignore_throw; reflexivity);
+  apply bindS_ext_cong; auto
+].
+rewrite try_catchS_throwS. reflexivity.
+Qed.
+Hint Rewrite liftState_try_catch : liftState.
+
+Lemma liftState_early_return Regs Regval A R E r x :
+  liftState (Regs := Regs) r (@early_return Regval A R E x) = early_returnS x.
+reflexivity.
+Qed.
+Hint Rewrite liftState_early_return : liftState.
+
+Lemma liftState_catch_early_return (*[liftState_simp]:*) Regs Regval A E r m s :
+  liftState (Regs := Regs) r (@catch_early_return Regval A E m) s = catch_early_returnS (liftState r m) s.
+unfold catch_early_return, catch_early_returnS.
+autorewrite with liftState.
+apply try_catchS_cong; auto.
+intros [a | e] s'; auto.
+Qed.
+Hint Rewrite liftState_catch_early_return : liftState.
+
+Lemma liftState_liftR Regs Regval A R E r m s :
+  liftState (Regs := Regs) r (@liftR Regval A R E m) s = liftRS (liftState r m) s.
+unfold liftR, liftRS. autorewrite with liftState.
+apply try_catchS_cong; auto.
+Qed.
+Hint Rewrite liftState_liftR : liftState.
+
+Lemma liftState_try_catchR Regs Regval A R E1 E2 r m h s :
+  liftState (Regs := Regs) r (@try_catchR Regval A R E1 E2 m h) s = try_catchRS (liftState r m) (fun x => liftState r (h x)) s.
+unfold try_catchR, try_catchRS. autorewrite with liftState.
+apply try_catchS_cong; auto.
+intros [r' | e] s'; auto.
+Qed.
+Hint Rewrite liftState_try_catchR : liftState.
+(*
+Lemma liftState_bool_of_bitU_nondet Regs Regval :
+  "liftState r (bool_of_bitU_nondet b) = bool_of_bitU_nondetS b"
+  by (cases b; auto simp: bool_of_bitU_nondet_def bool_of_bitU_nondetS_def liftState_simp)
+Hint Rewrite liftState_bool_of_bitU_nondet : liftState.
+*)
+Lemma liftState_read_memt Regs Regval A B E H rk a sz r s :
+  liftState (Regs := Regs) r (@read_memt Regval A B E H rk a sz) s = read_memtS rk a sz s.
+unfold read_memt, read_memt_bytes, read_memtS, maybe_failS. simpl.
+apply bindS_ext_cong; auto.
+intros [byte bit] s' valIn.
+destruct (option_map _); auto.
+Qed.
+Hint Rewrite liftState_read_memt : liftState.
+
+Lemma liftState_read_mem Regs Regval A B E H rk asz a sz r s :
+  liftState (Regs := Regs) r (@read_mem Regval A B E H rk asz a sz) s = read_memS rk a sz s.
+unfold read_mem, read_memS, read_memtS. simpl.
+unfold read_mem_bytesS, read_memt_bytesS.
+repeat rewrite bindS_assoc.
+apply bindS_ext_cong; auto.
+intros [ bytes | ] s' valIn; auto. simpl.
+apply bindS_ext_cong; auto.
+intros [byte bit] s'' valIn'.
+rewrite bindS_returnS_left. autorewrite with liftState.
+destruct (option_map _); auto.
+Qed.
+Hint Rewrite liftState_read_mem : liftState.
+
+Lemma liftState_write_mem_ea Regs Regval A E rk asz a sz r :
+  liftState (Regs := Regs) r (@write_mem_ea Regval A E rk asz a sz) = returnS tt.
+reflexivity.
+Qed.
+Hint Rewrite liftState_write_mem_ea : liftState.
+
+Lemma liftState_write_memt Regs Regval A B E wk addr sz v t r :
+  liftState (Regs := Regs) r (@write_memt Regval A B E wk addr sz v t) = write_memtS wk addr sz v t.
+unfold write_memt, write_memtS.
+destruct (Sail2_values.mem_bytes_of_bits v); auto.
+Qed.
+Hint Rewrite liftState_write_memt : liftState.
+
+Lemma liftState_write_mem Regs Regval A B E wk addrsize addr sz v r :
+  liftState (Regs := Regs) r (@write_mem Regval A B E wk addrsize addr sz v) = write_memS wk addr sz v.
+unfold write_mem, write_memS, write_memtS.
+destruct (Sail2_values.mem_bytes_of_bits v); simpl; auto.
+Qed.
+Hint Rewrite liftState_write_mem : liftState.
+
+Lemma bindS_rw_left Regs A B E m1 m2 (f : A -> monadS Regs B E) s :
+  m1 s = m2 s ->
+  bindS m1 f s = bindS m2 f s.
+intro H. unfold bindS. rewrite H. reflexivity.
+Qed. 
+
+Lemma liftState_read_reg_readS Regs Regval A E reg get_regval' set_regval' s :
+  (forall s, map_bind reg.(of_regval) (get_regval' reg.(name) s) = Some (reg.(read_from) s)) ->
+  liftState (Regs := Regs) (get_regval', set_regval') (@read_reg _ Regval A E reg) s = readS (fun x => reg.(read_from) (regstate x)) s.
+intros.
+unfold read_reg. simpl. unfold readS.
+erewrite bindS_rw_left. 2: {
+  apply bindS_returnS_left.
+}
+specialize (H (regstate s)).
+destruct (get_regval' _ _) as [v | ]; only 2: discriminate H.
+rewrite bindS_returnS_left.
+simpl in *.
+rewrite H.
+reflexivity.
+Qed.
+
+Lemma liftState_write_reg_updateS Regs Regval A E get_regval' set_regval' reg (v : A) s :
+  (forall s, set_regval' (name reg) (regval_of reg v) s = Some (write_to reg v s)) ->
+  liftState (Regs := Regs) (Regval := Regval) (E := E) (get_regval', set_regval') (write_reg reg v) s = updateS (fun s => {| regstate := (write_to reg v s.(regstate)); memstate := s.(memstate); tagstate := s.(tagstate) |}) s.
+intros.
+unfold write_reg. simpl. unfold readS, seqS.
+erewrite bindS_rw_left. 2: {
+  apply bindS_returnS_left.
+}
+specialize (H (regstate s)).
+destruct (set_regval' _ _) as [v' | ]; only 2: discriminate H.
+injection H as H1.
+unfold updateS.
+rewrite <- H1.
+reflexivity.
+Qed.
+(*
+Lemma liftState_iter_aux Regs Regval A E :
+  liftState r (iter_aux i f xs) = iterS_aux i (fun i x => liftState r (f i x)) xs.
+  by (induction i "\<lambda>i x. liftState r (f i x)" xs rule: iterS_aux.induct)
+     (auto simp: liftState_simp cong: bindS_cong)
+Hint Rewrite liftState_iter_aux : liftState.
+
+lemma liftState_iteri[liftState_simp]:
+  "liftState r (iteri f xs) = iteriS (\<lambda>i x. liftState r (f i x)) xs"
+  by (auto simp: iteri_def iteriS_def liftState_simp)
+
+lemma liftState_iter[liftState_simp]:
+  "liftState r (iter f xs) = iterS (liftState r \<circ> f) xs"
+  by (auto simp: iter_def iterS_def liftState_simp)
+*)
+Lemma liftState_foreachM Regs Regval A Vars E (xs : list A) (vars : Vars) (body : A -> Vars -> monad Regval Vars E) r s :
+  liftState (Regs := Regs) r (foreachM xs vars body) s = foreachS xs vars (fun x vars => liftState r (body x vars)) s.
+revert vars s.
+induction xs as [ | h t].
+* reflexivity.
+* intros vars s. simpl.
+  autorewrite with liftState.
+  apply bindS_ext_cong; auto.
+Qed.
+Hint Rewrite liftState_foreachM : liftState.
+
+Lemma foreachS_cong {A RV Vars E} xs vars f f' s :
+  (forall a vars s, f a vars s = f' a vars s) ->
+  @foreachS A RV Vars E xs vars f s = foreachS xs vars f' s.
+intro H.
+revert s vars.
+induction xs.
+* reflexivity.
+* intros. simpl.
+  apply bindS_ext_cong; auto.
+Qed.
+
+Lemma liftState_genlistM Regs Regval A E r f n s :
+  liftState (Regs := Regs) r (@genlistM A Regval E f n) s = genlistS (fun x => liftState r (f x)) n s.
+unfold genlistM, genlistS.
+autorewrite with liftState.
+apply foreachS_cong.
+intros; autorewrite with liftState.
+apply bindS_ext_cong; auto.
+Qed.
+Hint Rewrite liftState_genlistM : liftState.
+
+Lemma liftState_choose_bools Regs Regval E descr n r s :
+  liftState (Regs := Regs) r (@choose_bools Regval E descr n) s = choose_boolsS n s.
+unfold choose_bools, choose_boolsS.
+autorewrite with liftState.
+reflexivity.
+Qed.
+Hint Rewrite liftState_choose_bools : liftState.
+
+(*
+Lemma liftState_bools_of_bits_nondet[liftState_simp]:
+  "liftState r (bools_of_bits_nondet bs) = bools_of_bits_nondetS bs"
+  unfolding bools_of_bits_nondet_def bools_of_bits_nondetS_def
+  by (auto simp: liftState_simp comp_def)
+Hint Rewrite liftState_choose_bools : liftState.
+*)
+
+Lemma liftState_internal_pick Regs Regval A E r (xs : list A) s :
+  liftState (Regs := Regs) (Regval := Regval) (E := E) r (internal_pick xs) s = internal_pickS xs s.
+unfold internal_pick, internal_pickS.
+unfold choose.
+autorewrite with liftState.
+apply bindS_ext_cong.
+* autorewrite with liftState.
+  reflexivity.
+* intros.
+  destruct (nth_error _ _); auto.
+Qed.
+Hint Rewrite liftState_internal_pick : liftState.
+
+Lemma liftRS_returnS (*[simp]:*) A R Regs E x :
+  @liftRS A R Regs E (returnS x) = returnS x.
+reflexivity.
+Qed.
+
+Lemma concat_singleton A (xs : list A) :
+  concat (xs::nil) = xs.
+simpl.
+rewrite app_nil_r.
+reflexivity.
+Qed.
+
+Lemma liftRS_bindS Regs A B R E (m : monadS Regs A E) (f : A -> monadS Regs B E) s :
+  @liftRS B R Regs E (bindS m f) s = bindS (liftRS m) (fun x => liftRS (f x)) s.
+unfold liftRS, try_catchS, bindS, throwS, returnS.
+induction (m s) as [ | [[a | [msg | e]] t]].
+* reflexivity.
+* simpl. rewrite flat_map_app. rewrite IHl. reflexivity.
+* simpl. rewrite IHl. reflexivity.
+* simpl. rewrite IHl. reflexivity.
+Qed.
+
+Lemma liftRS_assert_expS_True (*[simp]:*) Regs R E msg :
+  @liftRS _ R Regs E (assert_expS true msg) = returnS tt.
+reflexivity.
+Qed.
+
+(*
+lemma untilM_domI:
+  fixes V :: "'vars \<Rightarrow> nat"
+  assumes "Inv vars"
+    and "\<And>vars t vars' t'. \<lbrakk>Inv vars; Run (body vars) t vars'; Run (cond vars') t' False\<rbrakk> \<Longrightarrow> V vars' < V vars \<and> Inv vars'"
+  shows "untilM_dom (vars, cond, body)"
+  using assms
+  by (induction vars rule: measure_induct_rule[where f = V])
+     (auto intro: untilM.domintros)
+
+lemma untilM_dom_untilS_dom:
+  assumes "untilM_dom (vars, cond, body)"
+  shows "untilS_dom (vars, liftState r \<circ> cond, liftState r \<circ> body, s)"
+  using assms
+  by (induction vars cond body arbitrary: s rule: untilM.pinduct)
+     (rule untilS.domintros, auto elim!: Value_liftState_Run)
+
+lemma measure2_induct:
+  fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> nat"
+  assumes "\<And>x1 y1. (\<And>x2 y2. f x2 y2 < f x1 y1 \<Longrightarrow> P x2 y2) \<Longrightarrow> P x1 y1"
+  shows "P x y"
+proof -
+  have "P (fst x) (snd x)" for x
+    by (induction x rule: measure_induct_rule[where f = "\<lambda>x. f (fst x) (snd x)"]) (auto intro: assms)
+  then show ?thesis by auto
+qed
+
+lemma untilS_domI:
+  fixes V :: "'vars \<Rightarrow> 'regs sequential_state \<Rightarrow> nat"
+  assumes "Inv vars s"
+    and "\<And>vars s vars' s' s''.
+           \<lbrakk>Inv vars s; (Value vars', s') \<in> body vars s; (Value False, s'') \<in> cond vars' s'\<rbrakk>
+            \<Longrightarrow> V vars' s'' < V vars s \<and> Inv vars' s''"
+  shows "untilS_dom (vars, cond, body, s)"
+  using assms
+  by (induction vars s rule: measure2_induct[where f = V])
+     (auto intro: untilS.domintros)
+
+lemma whileS_dom_step:
+  assumes "whileS_dom (vars, cond, body, s)"
+    and "(Value True, s') \<in> cond vars s"
+    and "(Value vars', s'') \<in> body vars s'"
+  shows "whileS_dom (vars', cond, body, s'')"
+  by (use assms in \<open>induction vars cond body s arbitrary: vars' s' s'' rule: whileS.pinduct\<close>)
+     (auto intro: whileS.domintros)
+
+lemma whileM_dom_step:
+  assumes "whileM_dom (vars, cond, body)"
+    and "Run (cond vars) t True"
+    and "Run (body vars) t' vars'"
+  shows "whileM_dom (vars', cond, body)"
+  by (use assms in \<open>induction vars cond body arbitrary: vars' t t' rule: whileM.pinduct\<close>)
+     (auto intro: whileM.domintros)
+
+lemma whileM_dom_ex_step:
+  assumes "whileM_dom (vars, cond, body)"
+    and "\<exists>t. Run (cond vars) t True"
+    and "\<exists>t'. Run (body vars) t' vars'"
+  shows "whileM_dom (vars', cond, body)"
+  using assms by (blast intro: whileM_dom_step)
+
+lemmas whileS_pinduct = whileS.pinduct[case_names Step]
+
+lemma liftState_whileM:
+  assumes "whileS_dom (vars, liftState r \<circ> cond, liftState r \<circ> body, s)"
+    and "whileM_dom (vars, cond, body)"
+  shows "liftState r (whileM vars cond body) s = whileS vars (liftState r \<circ> cond) (liftState r \<circ> body) s"
+proof (use assms in \<open>induction vars "liftState r \<circ> cond" "liftState r \<circ> body" s rule: whileS.pinduct\<close>)
+  case Step: (1 vars s)
+  note domS = Step(1) and IH = Step(2) and domM = Step(3)
+  show ?case unfolding whileS.psimps[OF domS] whileM.psimps[OF domM] liftState_bind
+  proof (intro bindS_ext_cong, goal_cases cond while)
+    case (while a s')
+    have "bindS (liftState r (body vars)) (liftState r \<circ> (\<lambda>vars. whileM vars cond body)) s' =
+          bindS (liftState r (body vars)) (\<lambda>vars. whileS vars (liftState r \<circ> cond) (liftState r \<circ> body)) s'"
+      if "a"
+    proof (intro bindS_ext_cong, goal_cases body while')
+      case (while' vars' s'')
+      have "whileM_dom (vars', cond, body)" proof (rule whileM_dom_ex_step[OF domM])
+        show "\<exists>t. Run (cond vars) t True" using while that by (auto elim: Value_liftState_Run)
+        show "\<exists>t'. Run (body vars) t' vars'" using while' that by (auto elim: Value_liftState_Run)
+      qed
+      then show ?case using while while' that IH by auto
+    qed auto
+    then show ?case by (auto simp: liftState_simp)
+  qed auto
+qed
+*)
+
+Local Opaque _limit_reduces.
+Ltac gen_reduces :=
+  match goal with |- context[@_limit_reduces ?a ?b ?c] => generalize (@_limit_reduces a b c) end.
+
+Lemma liftState_whileM RV Vars E r limit vars cond (body : Vars -> monad RV Vars E) s :
+  liftState (Regs := RV) r (whileMT limit vars cond body) s = whileST limit vars (fun vars => liftState r (cond vars)) (fun vars => liftState r (body vars)) s.
+unfold whileMT, whileST.
+revert vars s.
+destruct (Z.le_decidable 0 limit).
+* generalize (Zwf_guarded limit) as acc.
+  apply Wf_Z.natlike_ind with (x := limit).
+  + intros [acc] *; simpl.
+    autorewrite with liftState.
+    apply bindS_ext_cong; auto.
+    intros. rewrite liftState_if_distrib.
+    destruct a; autorewrite with liftState; auto.
+    apply bindS_ext_cong; auto.
+    intros. destruct (_limit_reduces _). simpl.
+    reflexivity.
+  + clear limit H.
+    intros limit H IH [acc] vars s. simpl.
+    destruct (Z_ge_dec _ _); try omega.
+    autorewrite with liftState.
+    apply bindS_ext_cong; auto.
+    intros. rewrite liftState_if_distrib.
+    destruct a; autorewrite with liftState; auto.
+    apply bindS_ext_cong; auto.
+    intros.
+    gen_reduces.
+    replace (Z.succ limit - 1) with limit; try omega. intro acc'.
+    apply IH.
+  + assumption.
+* intros. simpl.
+  destruct (Z_ge_dec _ _); try omega.
+  reflexivity.
+Qed.
+
+(*
+lemma untilM_dom_step:
+  assumes "untilM_dom (vars, cond, body)"
+    and "Run (body vars) t vars'"
+    and "Run (cond vars') t' False"
+  shows "untilM_dom (vars', cond, body)"
+  by (use assms in \<open>induction vars cond body arbitrary: vars' t t' rule: untilM.pinduct\<close>)
+     (auto intro: untilM.domintros)
+
+lemma untilM_dom_ex_step:
+  assumes "untilM_dom (vars, cond, body)"
+    and "\<exists>t. Run (body vars) t vars'"
+    and "\<exists>t'. Run (cond vars') t' False"
+  shows "untilM_dom (vars', cond, body)"
+  using assms by (blast intro: untilM_dom_step)
+
+lemma liftState_untilM:
+  assumes "untilS_dom (vars, liftState r \<circ> cond, liftState r \<circ> body, s)"
+    and "untilM_dom (vars, cond, body)"
+  shows "liftState r (untilM vars cond body) s = untilS vars (liftState r \<circ> cond) (liftState r \<circ> body) s"
+proof (use assms in \<open>induction vars "liftState r \<circ> cond" "liftState r \<circ> body" s rule: untilS.pinduct\<close>)
+  case Step: (1 vars s)
+  note domS = Step(1) and IH = Step(2) and domM = Step(3)
+  show ?case unfolding untilS.psimps[OF domS] untilM.psimps[OF domM] liftState_bind
+  proof (intro bindS_ext_cong, goal_cases body k)
+    case (k vars' s')
+    show ?case unfolding comp_def liftState_bind
+    proof (intro bindS_ext_cong, goal_cases cond until)
+      case (until a s'')
+      have "untilM_dom (vars', cond, body)" if "\<not>a"
+      proof (rule untilM_dom_ex_step[OF domM])
+        show "\<exists>t. Run (body vars) t vars'" using k by (auto elim: Value_liftState_Run)
+        show "\<exists>t'. Run (cond vars') t' False" using until that by (auto elim: Value_liftState_Run)
+      qed
+      then show ?case using k until IH by (auto simp: comp_def liftState_simp)
+    qed auto
+  qed auto
+qed*)
+
+Lemma liftState_untilM RV Vars E r limit vars cond (body : Vars -> monad RV Vars E) s :
+  liftState (Regs := RV) r (untilMT limit vars cond body) s = untilST limit vars (fun vars => liftState r (cond vars)) (fun vars => liftState r (body vars)) s.
+unfold untilMT, untilST.
+revert vars s.
+destruct (Z.le_decidable 0 limit).
+* generalize (Zwf_guarded limit) as acc.
+  apply Wf_Z.natlike_ind with (x := limit).
+  + intros [acc] *; simpl.
+    autorewrite with liftState.
+    apply bindS_ext_cong; auto.
+    intros. autorewrite with liftState.
+    apply bindS_ext_cong; auto.
+    intros. rewrite liftState_if_distrib.
+    destruct a0; auto.
+    destruct (_limit_reduces _). simpl.
+    reflexivity.
+  + clear limit H.
+    intros limit H IH [acc] vars s. simpl.
+    destruct (Z_ge_dec _ _); try omega.
+    autorewrite with liftState.
+    apply bindS_ext_cong; auto.
+    intros. autorewrite with liftState; auto.
+    apply bindS_ext_cong; auto.
+    intros. rewrite liftState_if_distrib.
+    destruct a0; autorewrite with liftState; auto.
+    gen_reduces.
+    replace (Z.succ limit - 1) with limit; try omega. intro acc'.
+    apply IH.
+  + assumption.
+* intros. simpl.
+  destruct (Z_ge_dec _ _); try omega.
+  reflexivity.
+Qed.
+
+(*
+
+text \<open>Simplification rules for monadic Boolean connectives\<close>
+
+lemma if_return_return[simp]: "(if a then return True else return False) = return a" by auto
+
+lemma and_boolM_simps[simp]:
+  "and_boolM (return b) (return c) = return (b \<and> c)"
+  "and_boolM x (return True) = x"
+  "and_boolM x (return False) = x \<bind> (\<lambda>_. return False)"
+  "\<And>x y z. and_boolM (x \<bind> y) z = (x \<bind> (\<lambda>r. and_boolM (y r) z))"
+  by (auto simp: and_boolM_def)
+
+lemma and_boolM_return_if:
+  "and_boolM (return b) y = (if b then y else return False)"
+  by (auto simp: and_boolM_def)
+
+lemma and_boolM_return_return_and[simp]: "and_boolM (return l) (return r) = return (l \<and> r)"
+  by (auto simp: and_boolM_def)
+
+lemmas and_boolM_if_distrib[simp] = if_distrib[where f = "\<lambda>x. and_boolM x y" for y]
+
+lemma or_boolM_simps[simp]:
+  "or_boolM (return b) (return c) = return (b \<or> c)"
+  "or_boolM x (return True) = x \<bind> (\<lambda>_. return True)"
+  "or_boolM x (return False) = x"
+  "\<And>x y z. or_boolM (x \<bind> y) z = (x \<bind> (\<lambda>r. or_boolM (y r) z))"
+  by (auto simp: or_boolM_def)
+
+lemma or_boolM_return_if:
+  "or_boolM (return b) y = (if b then return True else y)"
+  by (auto simp: or_boolM_def)
+
+lemma or_boolM_return_return_or[simp]: "or_boolM (return l) (return r) = return (l \<or> r)"
+  by (auto simp: or_boolM_def)
+
+lemmas or_boolM_if_distrib[simp] = if_distrib[where f = "\<lambda>x. or_boolM x y" for y]
+
+lemma if_returnS_returnS[simp]: "(if a then returnS True else returnS False) = returnS a" by auto
+
+lemma and_boolS_simps[simp]:
+  "and_boolS (returnS b) (returnS c) = returnS (b \<and> c)"
+  "and_boolS x (returnS True) = x"
+  "and_boolS x (returnS False) = bindS x (\<lambda>_. returnS False)"
+  "\<And>x y z. and_boolS (bindS x y) z = (bindS x (\<lambda>r. and_boolS (y r) z))"
+  by (auto simp: and_boolS_def)
+
+lemma and_boolS_returnS_if:
+  "and_boolS (returnS b) y = (if b then y else returnS False)"
+  by (auto simp: and_boolS_def)
+
+lemmas and_boolS_if_distrib[simp] = if_distrib[where f = "\<lambda>x. and_boolS x y" for y]
+
+lemma and_boolS_returnS_True[simp]: "and_boolS (returnS True) c = c"
+  by (auto simp: and_boolS_def)
+
+lemma or_boolS_simps[simp]:
+  "or_boolS (returnS b) (returnS c) = returnS (b \<or> c)"
+  "or_boolS (returnS False) m = m"
+  "or_boolS x (returnS True) = bindS x (\<lambda>_. returnS True)"
+  "or_boolS x (returnS False) = x"
+  "\<And>x y z. or_boolS (bindS x y) z = (bindS x (\<lambda>r. or_boolS (y r) z))"
+  by (auto simp: or_boolS_def)
+
+lemma or_boolS_returnS_if:
+  "or_boolS (returnS b) y = (if b then returnS True else y)"
+  by (auto simp: or_boolS_def)
+
+lemmas or_boolS_if_distrib[simp] = if_distrib[where f = "\<lambda>x. or_boolS x y" for y]
+
+lemma Run_or_boolM_E:
+  assumes "Run (or_boolM l r) t a"
+  obtains "Run l t True" and "a"
+  | tl tr where "Run l tl False" and "Run r tr a" and "t = tl @ tr"
+  using assms by (auto simp: or_boolM_def elim!: Run_bindE Run_ifE Run_returnE)
+
+lemma Run_and_boolM_E:
+  assumes "Run (and_boolM l r) t a"
+  obtains "Run l t False" and "\<not>a"
+  | tl tr where "Run l tl True" and "Run r tr a" and "t = tl @ tr"
+  using assms by (auto simp: and_boolM_def elim!: Run_bindE Run_ifE Run_returnE)
+
+lemma maybe_failS_Some[simp]: "maybe_failS msg (Some v) = returnS v"
+  by (auto simp: maybe_failS_def)
+
+text \<open>Event traces\<close>
+
+lemma Some_eq_bind_conv: "Some x = Option.bind f g \<longleftrightarrow> (\<exists>y. f = Some y \<and> g y = Some x)"
+  unfolding bind_eq_Some_conv[symmetric] by auto
+
+lemma if_then_Some_eq_Some_iff: "((if b then Some x else None) = Some y) \<longleftrightarrow> (b \<and> y = x)"
+  by auto
+
+lemma Some_eq_if_then_Some_iff: "(Some y = (if b then Some x else None)) \<longleftrightarrow> (b \<and> y = x)"
+  by auto
+
+lemma emitEventS_update_cases:
+  assumes "emitEventS ra e s = Some s'"
+  obtains
+    (Write_mem) wk addr sz v tag r
+      where "e = E_write_memt wk addr sz v tag r \<or> (e = E_write_mem wk addr sz v r \<and> tag = B0)"
+        and "s' = put_mem_bytes addr sz v tag s"
+  | (Write_reg) r v rs'
+      where "e = E_write_reg r v" and "(snd ra) r v (regstate s) = Some rs'"
+        and "s' = s\<lparr>regstate := rs'\<rparr>"
+  | (Read) "s' = s"
+  using assms
+  by (elim emitEventS.elims)
+     (auto simp: Some_eq_bind_conv bind_eq_Some_conv if_then_Some_eq_Some_iff Some_eq_if_then_Some_iff)
+
+lemma runTraceS_singleton[simp]: "runTraceS ra [e] s = emitEventS ra e s"
+  by (cases "emitEventS ra e s"; auto)
+
+lemma runTraceS_ConsE:
+  assumes "runTraceS ra (e # t) s = Some s'"
+  obtains s'' where "emitEventS ra e s = Some s''" and "runTraceS ra t s'' = Some s'"
+  using assms by (auto simp: bind_eq_Some_conv)
+
+lemma runTraceS_ConsI:
+  assumes "emitEventS ra e s = Some s'" and "runTraceS ra t s' = Some s''"
+  shows "runTraceS ra (e # t) s = Some s''"
+  using assms by auto
+
+lemma runTraceS_Cons_tl:
+  assumes "emitEventS ra e s = Some s'"
+  shows "runTraceS ra (e # t) s = runTraceS ra t s'"
+  using assms by (elim emitEventS.elims) (auto simp: Some_eq_bind_conv bind_eq_Some_conv)
+
+lemma runTraceS_appendE:
+  assumes "runTraceS ra (t @ t') s = Some s'"
+  obtains s'' where "runTraceS ra t s = Some s''" and "runTraceS ra t' s'' = Some s'"
+proof -
+  have "\<exists>s''. runTraceS ra t s = Some s'' \<and> runTraceS ra t' s'' = Some s'"
+  proof (use assms in \<open>induction t arbitrary: s\<close>)
+    case (Cons e t)
+    from Cons.prems
+    obtain s_e where "emitEventS ra e s = Some s_e" and "runTraceS ra (t @ t') s_e = Some s'"
+      by (auto elim: runTraceS_ConsE simp: bind_eq_Some_conv)
+    with Cons.IH[of s_e] show ?case by (auto intro: runTraceS_ConsI)
+  qed auto
+  then show ?thesis using that by blast
+qed
+
+lemma runTraceS_nth_split:
+  assumes "runTraceS ra t s = Some s'" and n: "n < length t"
+  obtains s1 s2 where "runTraceS ra (take n t) s = Some s1"
+    and "emitEventS ra (t ! n) s1 = Some s2"
+    and "runTraceS ra (drop (Suc n) t) s2 = Some s'"
+proof -
+  have "runTraceS ra (take n t @ t ! n # drop (Suc n) t) s = Some s'"
+    using assms
+    by (auto simp: id_take_nth_drop[OF n, symmetric])
+  then show thesis by (blast elim: runTraceS_appendE runTraceS_ConsE intro: that)
+qed
+
+text \<open>Memory accesses\<close>
+
+lemma get_mem_bytes_put_mem_bytes_same_addr:
+  assumes "length v = sz"
+  shows "get_mem_bytes addr sz (put_mem_bytes addr sz v tag s) = Some (v, if sz > 0 then tag else B1)"
+proof (unfold assms[symmetric], induction v rule: rev_induct)
+  case Nil
+  then show ?case by (auto simp: get_mem_bytes_def)
+next
+  case (snoc x xs)
+  then show ?case
+    by (cases tag)
+       (auto simp: get_mem_bytes_def put_mem_bytes_def Let_def and_bit_eq_iff foldl_and_bit_eq_iff
+             cong: option.case_cong split: if_splits option.splits)
+qed
+
+lemma memstate_put_mem_bytes:
+  assumes "length v = sz"
+  shows "memstate (put_mem_bytes addr sz v tag s) addr' =
+         (if addr' \<in> {addr..<addr+sz} then Some (v ! (addr' - addr)) else memstate s addr')"
+  unfolding assms[symmetric]
+  by (induction v rule: rev_induct) (auto simp: put_mem_bytes_def nth_Cons nth_append Let_def)
+
+lemma tagstate_put_mem_bytes:
+  assumes "length v = sz"
+  shows "tagstate (put_mem_bytes addr sz v tag s) addr' =
+         (if addr' \<in> {addr..<addr+sz} then Some tag else tagstate s addr')"
+  unfolding assms[symmetric]
+  by (induction v rule: rev_induct) (auto simp: put_mem_bytes_def nth_Cons nth_append Let_def)
+
+lemma get_mem_bytes_cong:
+  assumes "\<forall>addr'. addr \<le> addr' \<and> addr' < addr + sz \<longrightarrow>
+                   (memstate s' addr' = memstate s addr' \<and> tagstate s' addr' = tagstate s addr')"
+  shows "get_mem_bytes addr sz s' = get_mem_bytes addr sz s"
+proof (use assms in \<open>induction sz\<close>)
+  case 0
+  then show ?case by (auto simp: get_mem_bytes_def)
+next
+  case (Suc sz)
+  then show ?case
+    by (auto simp: get_mem_bytes_def Let_def
+             intro!: map_option_cong map_cong foldl_cong
+                     arg_cong[where f = just_list] arg_cong2[where f = and_bit])
+qed
+
+lemma get_mem_bytes_tagged_tagstate:
+  assumes "get_mem_bytes addr sz s = Some (v, B1)"
+  shows "\<forall>addr' \<in> {addr..<addr + sz}. tagstate s addr' = Some B1"
+  using assms
+  by (auto simp: get_mem_bytes_def foldl_and_bit_eq_iff Let_def split: option.splits)
+
+end
+*)
\ No newline at end of file
diff --git a/lib/coq/Sail2_state_monad.v b/lib/coq/Sail2_state_monad.v
index 235e4b9e..faee9569 100644
--- a/lib/coq/Sail2_state_monad.v
+++ b/lib/coq/Sail2_state_monad.v
@@ -50,10 +50,10 @@ Definition returnS {Regs A E} (a:A) : monadS Regs A E := fun s => [(Value a,s)].
 (*val bindS : forall 'regs 'a 'b 'e. monadS 'regs 'a 'e -> ('a -> monadS 'regs 'b 'e) -> monadS 'regs 'b 'e*)
 Definition bindS {Regs A B E} (m : monadS Regs A E) (f : A -> monadS Regs B E) : monadS Regs B E :=
  fun (s : sequential_state Regs) =>
-  List.concat (List.map (fun v => match v with
-                | (Value a, s') => f a s'
-                | (Ex e, s') => [(Ex e, s')]
-                end) (m s)).
+  List.flat_map (fun v => match v with
+             | (Value a, s') => f a s'
+             | (Ex e, s') => [(Ex e, s')]
+             end) (m s).
 
 (*val seqS: forall 'regs 'b 'e. monadS 'regs unit 'e -> monadS 'regs 'b 'e -> monadS 'regs 'b 'e*)
 Definition seqS {Regs B E} (m : monadS Regs unit E) (n : monadS Regs B E) : monadS Regs B E :=
@@ -96,11 +96,11 @@ Definition throwS {Regs A E} (e : E) :monadS Regs A E :=
 (*val try_catchS : forall 'regs 'a 'e1 'e2. monadS 'regs 'a 'e1 -> ('e1 -> monadS 'regs 'a 'e2) ->  monadS 'regs 'a 'e2*)
 Definition try_catchS {Regs A E1 E2} (m : monadS Regs A E1) (h : E1 -> monadS Regs A E2) : monadS Regs A E2 :=
 fun s =>
-  List.concat (List.map (fun v => match v with
+  List.flat_map (fun v => match v with
                 | (Value a, s') => returnS a s'
                 | (Ex (Throw e), s') => h e s'
                 | (Ex (Failure msg), s') => [(Ex (Failure msg), s')]
-                end) (m s)).
+                end) (m s).
 
 (*val assert_expS : forall 'regs 'e. bool -> string -> monadS 'regs unit 'e*)
 Definition assert_expS {Regs E} (exp : bool) (msg : string) : monadS Regs unit E :=
diff --git a/lib/coq/Sail2_state_monad_lemmas.v b/lib/coq/Sail2_state_monad_lemmas.v
new file mode 100644
index 00000000..e2b98d79
--- /dev/null
+++ b/lib/coq/Sail2_state_monad_lemmas.v
@@ -0,0 +1,479 @@
+Require Import Sail2_state_monad.
+(*Require Import Sail2_values_lemmas.*)
+
+Lemma bindS_ext_cong (*[fundef_cong]:*) {Regs A B E}
+  {m1 m2 : monadS Regs A E} {f1 f2 : A -> monadS Regs B E} s :
+  m1 s = m2 s ->
+  (forall a s', List.In (Value a, s') (m2 s) -> f1 a s' = f2 a s') ->
+  bindS m1 f1 s = bindS m2 f2 s.
+intros.
+unfold bindS.
+rewrite H.
+rewrite !List.flat_map_concat_map.
+f_equal.
+apply List.map_ext_in.
+intros [[a|a] s'] H_in; auto.
+Qed.
+
+(*
+lemma bindS_cong[fundef_cong]:
+  assumes m: "m1 = m2"
+    and f: "\<And>s a s'. (Value a, s') \<in> (m2 s) \<Longrightarrow> f1 a s' = f2 a s'"
+  shows "bindS m1 f1 = bindS m2 f2"
+  using assms by (intro ext bindS_ext_cong; blast)
+*)
+
+Lemma bindS_returnS_left (*[simp]:*) {Regs A B E} {x : A} {f : A -> monadS Regs B E} {s} :
+ bindS (returnS x) f s = f x s.
+unfold returnS, bindS.
+simpl.
+auto using List.app_nil_r.
+Qed.
+
+Lemma bindS_returnS_right (*[simp]:*) {Regs A E} {m : monadS Regs A E} {s} :
+ bindS m returnS s = m s.
+unfold returnS, bindS.
+induction (m s) as [|[[a|a] s'] t]; auto;
+simpl;
+rewrite IHt;
+reflexivity.
+Qed.
+
+Lemma bindS_readS {Regs A E} {f} {m : A -> monadS Regs A E} {s} :
+  bindS (readS f) m s = m (f s) s.
+unfold readS, bindS.
+simpl.
+rewrite List.app_nil_r.
+reflexivity.
+Qed.
+
+Lemma bindS_updateS {Regs A E} {f : sequential_state Regs -> sequential_state Regs} {m : unit -> monadS Regs A E} {s} :
+  bindS (updateS f) m s = m tt (f s).
+unfold updateS, bindS.
+simpl.
+auto using List.app_nil_r.
+Qed.
+
+Lemma bindS_assertS_True (*[simp]:*) {Regs A E msg} {f : unit -> monadS Regs A E} {s} :
+  bindS (assert_expS true msg) f s = f tt s.
+unfold assert_expS, bindS.
+simpl.
+auto using List.app_nil_r.
+Qed.
+
+Lemma bindS_chooseS_returnS (*[simp]:*) {Regs A B E} {xs : list A} {f : A -> B} {s} :
+  bindS (Regs := Regs) (E := E) (chooseS xs) (fun x => returnS (f x)) s = chooseS (List.map f xs) s.
+unfold chooseS, bindS, returnS.
+induction xs; auto.
+simpl. rewrite IHxs.
+reflexivity.
+Qed.
+
+Lemma result_cases : forall (A E : Type) (P : result A E -> Prop),
+  (forall a, P (Value a)) ->
+  (forall e, P (Ex (Throw e))) ->
+  (forall msg, P (Ex (Failure msg))) ->
+  forall r, P r.
+intros.
+destruct r; auto.
+destruct e; auto.
+Qed.
+
+Lemma result_state_cases {A E S} {P : result A E * S -> Prop} :
+  (forall a s, P (Value a, s)) ->
+  (forall e s, P (Ex (Throw e), s)) ->
+  (forall msg s, P (Ex (Failure msg), s)) ->
+  forall rs, P rs.
+intros.
+destruct rs as [[a|[e|msg]] s]; auto.
+Qed.
+
+(* TODO: needs sets, not lists
+Lemma monadS_ext_eqI {Regs A E} {m m' : monadS Regs A E} s :
+  (forall a s', List.In (Value a, s') (m s) <-> List.In (Value a, s') (m' s)) ->
+  (forall e s', List.In (Ex (Throw e), s') (m s) <-> List.In (Ex (Throw e), s') (m' s)) ->
+  (forall msg s', List.In (Ex (Failure msg), s') (m s) <-> List.In (Ex (Failure msg), s') (m' s)) ->
+  m s = m' s.
+proof (intro set_eqI)
+  fix x
+  show "x \<in> m s \<longleftrightarrow> x \<in> m' s" using assms by (cases x rule: result_state_cases) auto
+qed
+
+lemma monadS_eqI:
+  fixes m m' :: "('regs, 'a, 'e) monadS"
+  assumes "\<And>s a s'. (Value a, s') \<in> m s \<longleftrightarrow> (Value a, s') \<in> m' s"
+    and "\<And>s e s'. (Ex (Throw e), s') \<in> m s \<longleftrightarrow> (Ex (Throw e), s') \<in> m' s"
+    and "\<And>s msg s'. (Ex (Failure msg), s') \<in> m s \<longleftrightarrow> (Ex (Failure msg), s') \<in> m' s"
+  shows "m = m'"
+  using assms by (intro ext monadS_ext_eqI)
+*)
+
+Lemma bindS_cases {Regs A B E} {m} {f : A -> monadS Regs B E} {r s s'} :
+  List.In (r, s') (bindS m f s) ->
+  (exists a a' s'', r = Value a /\ List.In (Value a', s'') (m s) /\ List.In (Value a, s') (f a' s'')) \/
+  (exists e, r = Ex e /\ List.In (Ex e, s') (m s)) \/
+  (exists e a s'', r = Ex e /\ List.In (Value a, s'') (m s) /\ List.In (Ex e, s') (f a s'')).
+unfold bindS.
+intro IN.
+apply List.in_flat_map in IN.
+destruct IN as [[r' s''] [INr' INr]].
+destruct r' as [a'|e'].
+* destruct r as [a|e].
+  + left. eauto 10.
+  + right; right. eauto 10.
+* right; left. simpl in INr. destruct INr as [|[]]. inversion H. subst. eauto 10.
+Qed.
+
+Lemma bindS_intro_Value {Regs A B E} {m} {f : A -> monadS Regs B E} {s a s' a' s''} :
+ List.In (Value a', s'') (m s) -> List.In (Value a, s') (f a' s'') -> List.In (Value a, s') (bindS m f s).
+intros; unfold bindS.
+apply List.in_flat_map.
+eauto.
+Qed.
+Lemma bindS_intro_Ex_left {Regs A B E} {m} {f : A -> monadS Regs B E} {s e s'} :
+  List.In (Ex e, s') (m s) -> List.In (Ex e, s') (bindS m f s).
+intros; unfold bindS.
+apply List.in_flat_map.
+exists (Ex e, s').
+auto with datatypes.
+Qed.
+Lemma bindS_intro_Ex_right {Regs A B E} {m} {f : A -> monadS Regs B E} {s e s' a s''} :
+  List.In (Ex e, s') (f a s'') -> List.In (Value a, s'') (m s) -> List.In (Ex e, s') (bindS m f s).
+intros; unfold bindS.
+apply List.in_flat_map.
+eauto.
+Qed.
+Hint Resolve bindS_intro_Value bindS_intro_Ex_left bindS_intro_Ex_right : bindS_intros.
+
+Lemma bindS_assoc (*[simp]:*) {Regs A B C E} {m} {f : A -> monadS Regs B E} {g : B -> monadS Regs C E} {s} :
+  bindS (bindS m f) g s = bindS m (fun x => bindS (f x) g) s.
+unfold bindS.
+induction (m s) as [ | [[a | e] t]].
+* reflexivity.
+* simpl. rewrite <- IHl.
+  rewrite !List.flat_map_concat_map.
+  rewrite List.map_app.
+  rewrite List.concat_app.
+  reflexivity.
+* simpl. rewrite IHl. reflexivity.
+Qed.
+
+Lemma bindS_failS (*[simp]:*) {Regs A B E} {msg} {f : A -> monadS Regs B E} :
+  bindS (failS msg) f = failS msg.
+reflexivity.
+Qed.
+Lemma bindS_throwS (*[simp]:*) {Regs A B E} {e} {f : A -> monadS Regs B E} :
+  bindS (throwS e) f = throwS e.
+reflexivity.
+Qed.
+(*declare seqS_def[simp]*)
+
+Lemma Value_bindS_elim {Regs A B E} {a m} {f : A -> monadS Regs B E} {s s'} :
+  List.In (Value a, s') (bindS m f s) ->
+  exists s'' a', List.In (Value a', s'') (m s) /\ List.In (Value a, s') (f a' s'').
+intro H.
+apply bindS_cases in H.
+destruct H as [(a0 & a' & s'' & [= <-] & [*]) | [(e & [= ] & _) | (_ & _ & _ & [= ] & _)]].
+eauto.
+Qed.
+
+Lemma Ex_bindS_elim {Regs A B E} {e m s s'} {f : A -> monadS Regs B E} :
+  List.In (Ex e, s') (bindS m f s) ->
+  List.In (Ex e, s') (m s) \/
+  exists s'' a', List.In (Value a', s'') (m s) /\ List.In (Ex e, s') (f a' s'').
+intro H.
+apply bindS_cases in H.
+destruct H as [(? & ? & ? & [= ] & _) | [(? & [= <-] & X) | (? & ? & ? & [= <-] & X)]];
+eauto.
+Qed.
+
+Lemma try_catchS_returnS (*[simp]:*) {Regs A E1 E2} {a} {h : E1 -> monadS Regs A E2}:
+  try_catchS (returnS a) h = returnS a.
+reflexivity.
+Qed.
+Lemma try_catchS_failS (*[simp]:*) {Regs A E1 E2} {msg} {h : E1 -> monadS Regs A E2}:
+  try_catchS (failS msg) h = failS msg.
+reflexivity.
+Qed.
+Lemma try_catchS_throwS (*[simp]:*) {Regs A E1 E2} {e} {h : E1 -> monadS Regs A E2} {s}:
+  try_catchS (throwS e) h s = h e s.
+unfold try_catchS, throwS.
+simpl.
+auto using List.app_nil_r.
+Qed.
+
+Lemma try_catchS_cong (*[cong]:*) {Regs A E1 E2 m1 m2} {h1 h2 : E1 -> monadS Regs A E2} {s} :
+  (forall s, m1 s = m2 s) ->
+  (forall e s, h1 e s = h2 e s) ->
+  try_catchS m1 h1 s = try_catchS m2 h2 s.
+intros H1 H2.
+unfold try_catchS.
+rewrite H1.
+rewrite !List.flat_map_concat_map.
+f_equal.
+apply List.map_ext_in.
+intros [[a|[e|msg]] s'] H_in; auto.
+Qed.
+
+Lemma try_catchS_cases {Regs A E1 E2 m} {h : E1 -> monadS Regs A E2} {r s s'} :
+  List.In (r, s') (try_catchS m h s) ->
+  (exists a, r = Value a /\ List.In (Value a, s') (m s)) \/
+  (exists msg, r = Ex (Failure msg) /\ List.In (Ex (Failure msg), s') (m s)) \/
+  (exists e s'', List.In (Ex (Throw e), s'') (m s) /\ List.In (r, s') (h e s'')).
+unfold try_catchS.
+intro IN.
+apply List.in_flat_map in IN.
+destruct IN as [[r' s''] [INr' INr]].
+destruct r' as [a'|[e'|msg]].
+* left. simpl in INr. destruct INr as [[= <- <-] | []]. eauto 10.
+* simpl in INr. destruct INr as [[= <- <-] | []]. eauto 10.
+* eauto 10.
+Qed.
+
+Lemma try_catchS_intros {Regs A E1 E2} {m} {h : E1 -> monadS Regs A E2} :
+  (forall s a s', List.In (Value a, s') (m s) -> List.In (Value a, s') (try_catchS m h s)) /\
+  (forall s msg s', List.In (Ex (Failure msg), s') (m s) -> List.In (Ex (Failure msg), s') (try_catchS m h s)) /\
+  (forall s e s'' r s', List.In (Ex (Throw e), s'') (m s) -> List.In (r, s') (h e s'') -> List.In (r, s') (try_catchS m h s)).
+repeat split; unfold try_catchS; intros;
+apply List.in_flat_map.
+* eexists; split; [ apply H | ]. simpl. auto.
+* eexists; split; [ apply H | ]. simpl. auto.
+* eexists; split; [ apply H | ]. simpl. auto.
+Qed.
+
+Lemma no_Ex_basic_builtins (*[simp]:*) {Regs E} {s s' : sequential_state Regs} {e : ex E} :
+  (forall A (a:A), ~ List.In (Ex e, s') (returnS a s)) /\
+  (forall A (f : _ -> A), ~ List.In (Ex e, s') (readS f s)) /\
+  (forall f, ~ List.In (Ex e, s') (updateS f s)) /\
+  (forall A (xs : list A), ~ List.In (Ex e, s') (chooseS xs s)).
+repeat split; intros;
+unfold returnS, readS, updateS, chooseS; simpl;
+try intuition congruence.
+* intro H.
+  apply List.in_map_iff in H.
+  destruct H as [x [X _]].
+  congruence.
+Qed.
+
+Import List.ListNotations.
+Definition ignore_throw_aux {A E1 E2 S} (rs : result A E1 * S) : list (result A E2 * S) :=
+match rs with
+| (Value a, s') => [(Value a, s')]
+| (Ex (Throw e), s') => []
+| (Ex (Failure msg), s') => [(Ex (Failure msg), s')]
+end.
+Definition ignore_throw {A E1 E2 S} (m : S -> list (result A E1 * S)) s : list (result A E2 * S) :=
+ List.flat_map ignore_throw_aux (m s).
+
+Lemma ignore_throw_cong {A E1 E2 S} {m1 m2 : S -> list (result A E1 * S)} s :
+  (forall s, m1 s = m2 s) ->
+  ignore_throw (E2 := E2) m1 s = ignore_throw m2 s.
+intro H.
+unfold ignore_throw.
+rewrite H.
+reflexivity.
+Qed.
+
+Lemma ignore_throw_aux_member_simps (*[simp]:*) {A E1 E2 S} {s' : S} {ms} :
+  (forall a:A, List.In (Value a, s') (ignore_throw_aux (E1 := E1) (E2 := E2) ms) <-> ms = (Value a, s')) /\
+  (forall e, ~ List.In (Ex (E := E2) (Throw e), s') (ignore_throw_aux ms)) /\
+  (forall msg, List.In (Ex (E := E2) (Failure msg), s') (ignore_throw_aux ms) <-> ms = (Ex (Failure msg), s')).
+destruct ms as [[a' | [e' | msg']] s]; simpl;
+intuition congruence.
+Qed.
+
+Lemma ignore_throw_member_simps (*[simp]:*) {A E1 E2 S} {s s' : S} {m} :
+  (forall {a:A}, List.In (Value (E := E2) a, s') (ignore_throw m s) <-> List.In (Value (E := E1) a, s') (m s)) /\
+  (forall {a:A}, List.In (Value (E := E2) a, s') (ignore_throw m s) <-> List.In (Value a, s') (m s)) /\
+  (forall e, ~ List.In (Ex (E := E2) (Throw e), s') (ignore_throw m s)) /\
+  (forall {msg}, List.In (Ex (E := E2) (Failure msg), s') (ignore_throw m s) <-> List.In (Ex (Failure msg), s') (m s)).
+unfold ignore_throw.
+repeat apply conj; intros; try apply conj;
+rewrite ?List.in_flat_map;
+solve
+[ intros [x [H1 H2]]; apply ignore_throw_aux_member_simps in H2; congruence
+| intro H; eexists; split; [ apply H | apply ignore_throw_aux_member_simps; reflexivity] ].
+Qed.
+
+Lemma ignore_throw_cases {A E S} {m : S -> list (result A E * S)} {r s s'} :
+  ignore_throw m s = m s ->
+  List.In (r, s') (m s) ->
+  (exists a, r = Value a) \/
+  (exists msg, r = Ex (Failure msg)).
+destruct r as [a | [e | msg]]; eauto.
+* intros H1 H2. rewrite <- H1 in H2.
+  apply ignore_throw_member_simps in H2.
+  destruct H2.
+Qed.
+
+(* *** *)
+Lemma flat_map_app {A B} {f : A -> list B} {l1 l2} :
+  List.flat_map f (l1 ++ l2) = (List.flat_map f l1 ++ List.flat_map f l2)%list.
+rewrite !List.flat_map_concat_map.
+rewrite List.map_app, List.concat_app.
+reflexivity.
+Qed.
+
+Lemma ignore_throw_bindS (*[simp]:*) Regs A B E E2 {m} {f : A -> monadS Regs B E} {s} :
+  ignore_throw (E2 := E2) (bindS m f) s = bindS (ignore_throw m) (fun s => ignore_throw (f s)) s.
+unfold bindS, ignore_throw.
+induction (m s) as [ | [[a | [e | msg]] t]].
+* reflexivity.
+* simpl. rewrite <- IHl. rewrite flat_map_app. reflexivity.
+* simpl. rewrite <- IHl. reflexivity.
+* simpl. apply IHl.
+Qed.
+Hint Rewrite ignore_throw_bindS : ignore_throw.
+
+Lemma try_catchS_bindS_no_throw {Regs A B E1 E2} {m1 : monadS Regs A E1} {m2 : monadS Regs A E2} {f : A -> monadS Regs B _} {s h} :
+  (forall s, ignore_throw m1 s = m1 s) ->
+  (forall s, ignore_throw m1 s = m2 s) ->
+  try_catchS (bindS m1 f) h s = bindS m2 (fun a => try_catchS (f a) h) s.
+intros Ignore1 Ignore2.
+transitivity ((ignore_throw m1 >>$= (fun a => try_catchS (f a) h)) s).
+* unfold bindS, try_catchS, ignore_throw.
+  specialize (Ignore1 s). revert Ignore1. unfold ignore_throw.
+  induction (m1 s) as [ | [[a | [e | msg]] t]]; auto.
+  + intro Ig. simpl. rewrite flat_map_app. rewrite IHl. auto. injection Ig. auto.
+  + intro Ig. simpl. rewrite IHl. reflexivity. injection Ig. auto.
+  + intro Ig. exfalso. clear -Ig.
+    assert (List.In (Ex (Throw msg), t) (List.flat_map ignore_throw_aux l)).
+    simpl in Ig. rewrite Ig. simpl. auto.
+    apply List.in_flat_map in H.
+    destruct H as [x [H1 H2]].
+    apply ignore_throw_aux_member_simps in H2.
+    assumption.
+* apply bindS_ext_cong; auto.
+Qed.
+
+Lemma concat_map_singleton {A B} {f : A -> B} {a : list A} :
+  List.concat (List.map (fun x => [f x]%list) a) = List.map f a.
+induction a; simpl; try rewrite IHa; auto with datatypes.
+Qed.
+
+(*lemma no_throw_basic_builtins[simp]:*)
+Lemma no_throw_basic_builtins_1 Regs A E E2 {a : A} :
+  ignore_throw (E1 := E2) (returnS a) = @returnS Regs A E a.
+reflexivity. Qed.
+Lemma no_throw_basic_builtins_2 Regs A E E2 {f : sequential_state Regs -> A} :
+  ignore_throw (E1 := E) (E2 := E2) (readS f) = readS f.
+reflexivity. Qed.
+Lemma no_throw_basic_builtins_3 Regs E E2 {f : sequential_state Regs -> sequential_state Regs} :
+  ignore_throw (E1 := E) (E2 := E2) (updateS f) = updateS f.
+reflexivity. Qed.
+Lemma no_throw_basic_builtins_4 Regs A E1 E2 {xs : list A} s :
+  ignore_throw (E1 := E1) (chooseS xs) s = @chooseS Regs A E2 xs s.
+unfold ignore_throw, chooseS.
+rewrite List.flat_map_concat_map, List.map_map. simpl.
+rewrite concat_map_singleton.
+reflexivity.
+Qed.
+Lemma no_throw_basic_builtins_5 Regs E1 E2 :
+  ignore_throw (E1 := E1) (choose_boolS tt) = @choose_boolS Regs E2 tt.
+reflexivity. Qed.
+Lemma no_throw_basic_builtins_6 Regs A E1 E2 msg :
+  ignore_throw (E1 := E1) (failS msg) = @failS Regs A E2 msg.
+reflexivity. Qed.
+Lemma no_throw_basic_builtins_7 Regs A E1 E2 msg x :
+  ignore_throw (E1 := E1) (maybe_failS msg x) = @maybe_failS Regs A E2 msg x. 
+destruct x; reflexivity. Qed.
+
+Hint Rewrite no_throw_basic_builtins_1 no_throw_basic_builtins_2
+             no_throw_basic_builtins_3 no_throw_basic_builtins_4
+             no_throw_basic_builtins_5 no_throw_basic_builtins_6
+             no_throw_basic_builtins_7 : ignore_throw.
+
+Lemma ignore_throw_option_case_distrib_1 Regs B C E1 E2 (c : sequential_state Regs -> option B) s (n : monadS Regs C E1) (f : B -> monadS Regs C E1) :
+  ignore_throw (E2 := E2) (match c s with None => n | Some b => f b end) s =
+    match c s with None => ignore_throw n s | Some b => ignore_throw (f b) s end.
+destruct (c s); auto.
+Qed.
+Lemma ignore_throw_option_case_distrib_2 Regs B C E1 E2 (c : option B) (n : monadS Regs C E1) (f : B -> monadS Regs C E1) :
+  ignore_throw (E2 := E2) (match c with None => n | Some b => f b end) =
+    match c with None => ignore_throw n | Some b => ignore_throw (f b) end.
+destruct c; auto.
+Qed.
+
+Lemma ignore_throw_let_distrib Regs A B E1 E2 (y : A) (f : A -> monadS Regs B E1) :
+  ignore_throw (E2 := E2) (let x := y in f x) = (let x := y in ignore_throw (f x)).
+reflexivity.
+Qed.
+
+Lemma no_throw_mem_builtins_1 Regs E1 E2 rk a sz s :
+  ignore_throw (E2 := E2) (@read_memt_bytesS Regs E1 rk a sz) s = read_memt_bytesS rk a sz s.
+unfold read_memt_bytesS. autorewrite with ignore_throw.
+apply bindS_ext_cong; auto. intros.  autorewrite with ignore_throw. reflexivity.
+Qed.
+Hint Rewrite no_throw_mem_builtins_1 : ignore_throw.
+Lemma no_throw_mem_builtins_2 Regs E1 E2 rk a sz s :
+  ignore_throw (E2 := E2) (@read_mem_bytesS Regs E1 rk a sz) s = read_mem_bytesS rk a sz s.
+unfold read_mem_bytesS. autorewrite with ignore_throw.
+apply bindS_ext_cong; intros; autorewrite with ignore_throw; auto.
+destruct a0; reflexivity.
+Qed.
+Hint Rewrite no_throw_mem_builtins_2 : ignore_throw.
+Lemma no_throw_mem_builtins_3 Regs A E1 E2 a s :
+  ignore_throw (E2 := E2) (@read_tagS Regs A E1 a) s = read_tagS a s.
+reflexivity. Qed.
+Hint Rewrite no_throw_mem_builtins_3 : ignore_throw.
+Lemma no_throw_mem_builtins_4 Regs A V E1 E2 rk a sz s H :
+  ignore_throw (E2 := E2) (@read_memtS Regs E1 A V rk a sz H) s = read_memtS rk a sz s.
+unfold read_memtS. autorewrite with ignore_throw.
+apply bindS_ext_cong; intros; autorewrite with ignore_throw.
+reflexivity. destruct a0; simpl. autorewrite with ignore_throw.
+reflexivity.
+Qed.
+Hint Rewrite no_throw_mem_builtins_4 : ignore_throw.
+Lemma no_throw_mem_builtins_5 Regs A V E1 E2 rk a sz s H :
+  ignore_throw (E2 := E2) (@read_memS Regs E1 A V rk a sz H) s = read_memS rk a sz s.
+unfold read_memS. autorewrite with ignore_throw.
+apply bindS_ext_cong; intros; autorewrite with ignore_throw; auto.
+destruct a0; auto.
+Qed.
+Hint Rewrite no_throw_mem_builtins_5 : ignore_throw.
+Lemma no_throw_mem_builtins_6 Regs E1 E2 wk addr sz v t s :
+  ignore_throw (E2 := E2) (@write_memt_bytesS Regs E1 wk addr sz v t) s = write_memt_bytesS wk addr sz v t s.
+unfold write_memt_bytesS. unfold seqS. autorewrite with ignore_throw.
+reflexivity.
+Qed.
+Hint Rewrite no_throw_mem_builtins_6 : ignore_throw.
+Lemma no_throw_mem_builtins_7 Regs E1 E2 wk addr sz v s :
+  ignore_throw (E2 := E2) (@write_mem_bytesS Regs E1 wk addr sz v) s = write_mem_bytesS wk addr sz v s.
+unfold write_mem_bytesS. autorewrite with ignore_throw. reflexivity.
+Qed.
+Hint Rewrite no_throw_mem_builtins_7 : ignore_throw.
+Lemma no_throw_mem_builtins_8 Regs E1 E2 A B wk addr sz v t s :
+  ignore_throw (E2 := E2) (@write_memtS Regs E1 A B wk addr sz v t) s = write_memtS wk addr sz v t s.
+unfold write_memtS. rewrite ignore_throw_option_case_distrib_2.
+destruct (Sail2_values.mem_bytes_of_bits v); autorewrite with ignore_throw; auto.
+Qed.
+Hint Rewrite no_throw_mem_builtins_8 : ignore_throw.
+Lemma no_throw_mem_builtins_9 Regs E1 E2 A B wk addr sz v s :
+  ignore_throw (E2 := E2) (@write_memS Regs E1 A B wk addr sz v) s = write_memS wk addr sz v s.
+unfold write_memS. autorewrite with ignore_throw; auto.
+Qed.
+Hint Rewrite no_throw_mem_builtins_9 : ignore_throw.
+Lemma no_throw_mem_builtins_10 Regs E1 E2 s :
+  ignore_throw (E2 := E2) (@excl_resultS Regs E1 tt) s = excl_resultS tt s.
+reflexivity. Qed.
+Hint Rewrite no_throw_mem_builtins_10 : ignore_throw.
+Lemma no_throw_mem_builtins_11 Regs E1 E2 s :
+  ignore_throw (E2 := E2) (@undefined_boolS Regs E1 tt) s = undefined_boolS tt s.
+reflexivity. Qed.
+Hint Rewrite no_throw_mem_builtins_11 : ignore_throw.
+
+Lemma no_throw_read_regvalS Regs RV E1 E2 r reg_name s :
+  ignore_throw (E2 := E2) (@read_regvalS Regs RV E1 r reg_name) s = read_regvalS r reg_name s.
+destruct r; simpl. autorewrite with ignore_throw.
+apply bindS_ext_cong; intros; auto. rewrite ignore_throw_option_case_distrib_2.
+autorewrite with ignore_throw. reflexivity.
+Qed.
+Hint Rewrite no_throw_read_regvalS : ignore_throw.
+
+Lemma no_throw_write_regvalS Regs RV E1 E2 r reg_name v s :
+  ignore_throw (E2 := E2) (@write_regvalS Regs RV E1 r reg_name v) s = write_regvalS r reg_name v s.
+destruct r; simpl. autorewrite with ignore_throw.
+apply bindS_ext_cong; intros; auto. rewrite ignore_throw_option_case_distrib_2.
+autorewrite with ignore_throw. reflexivity.
+Qed.
+Hint Rewrite no_throw_write_regvalS : ignore_throw.
diff --git a/src/gen_lib/0.11/sail2_deep_shallow_convert.lem b/src/gen_lib/0.11/sail2_deep_shallow_convert.lem
new file mode 100644
index 00000000..2e3543b4
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_deep_shallow_convert.lem
@@ -0,0 +1,623 @@
+open import Pervasives_extra
+open import Sail2_impl_base
+open import Sail2_interp
+open import Sail2_interp_ast
+open import Sail2_values
+
+
+class (ToFromInterpValue 'a)
+  val toInterpValue : 'a -> Interp_ast.value
+  val fromInterpValue : Interp_ast.value -> 'a
+end
+
+let toInterValueBool = function
+  | true -> Interp_ast.V_lit (L_aux (L_one) Unknown)
+  | false -> Interp_ast.V_lit (L_aux (L_zero) Unknown)
+end
+let rec fromInterpValueBool v = match v with
+  | Interp_ast.V_lit (L_aux (L_one) _)  -> true
+  | Interp_ast.V_lit (L_aux (L_true) _)  ->  true
+  | Interp_ast.V_lit (L_aux (L_zero) _) -> false
+  | Interp_ast.V_lit (L_aux (L_false) _) -> false
+  | Interp_ast.V_tuple [v] -> fromInterpValueBool v
+  | v -> failwith ("fromInterpValue bool: unexpected value. " ^
+                     Interp.debug_print_value v)
+end
+instance (ToFromInterpValue bool)
+  let toInterpValue = toInterValueBool
+  let fromInterpValue = fromInterpValueBool
+end
+
+
+let toInterpValueUnit () = Interp_ast.V_lit (L_aux (L_unit) Unknown)
+let rec fromInterpValueUnit v = match v with
+  | Interp_ast.V_lit (L_aux (L_unit) _) -> ()
+  | Interp_ast.V_tuple [v] -> fromInterpValueUnit v
+  | v -> failwith ("fromInterpValue unit: unexpected value. " ^
+                     Interp.debug_print_value v)
+end
+instance (ToFromInterpValue unit)
+  let toInterpValue = toInterpValueUnit
+  let fromInterpValue = fromInterpValueUnit
+end
+
+
+let toInterpValueInteger i = V_lit (L_aux (L_num i) Unknown)
+let rec fromInterpValueInteger v = match v with
+  | Interp_ast.V_lit (L_aux (L_num i) _) -> i
+  | Interp_ast.V_tuple [v] -> fromInterpValueInteger v
+  | v -> failwith ("fromInterpValue integer: unexpected value. " ^
+                     Interp.debug_print_value v)
+end
+instance (ToFromInterpValue integer)
+  let toInterpValue = toInterpValueInteger
+  let fromInterpValue = fromInterpValueInteger
+end
+
+
+let toInterpValueString s = V_lit (L_aux (L_string s) Unknown)
+let rec fromInterpValueString v = match v with
+  | Interp_ast.V_lit (L_aux (L_string s) _) -> s
+  | Interp_ast.V_tuple [v] -> fromInterpValueString v
+  | v -> failwith ("fromInterpValue integer: unexpected value. " ^
+                     Interp.debug_print_value v)
+end
+instance (ToFromInterpValue string)
+  let toInterpValue = toInterpValueString
+  let fromInterpValue = fromInterpValueString
+end
+
+
+let toInterpValueBitU = function
+  | B1 -> Interp_ast.V_lit (L_aux (L_one) Unknown)
+  | B0 -> Interp_ast.V_lit (L_aux (L_zero) Unknown)
+  | BU -> Interp_ast.V_lit (L_aux (L_undef) Unknown)
+end
+let rec fromInterpValueBitU v = match v with
+  | Interp_ast.V_lit (L_aux (L_one) _)   -> B1
+  | Interp_ast.V_lit (L_aux (L_zero) _)  -> B0
+  | Interp_ast.V_lit (L_aux (L_undef) _) -> BU
+  | Interp_ast.V_lit (L_aux (L_true) _)   -> B1
+  | Interp_ast.V_lit (L_aux (L_false) _)  -> B0 
+  | Interp_ast.V_tuple [v] -> fromInterpValueBitU v
+  | v -> failwith ("fromInterpValue bitU: unexpected value. " ^
+                     Interp.debug_print_value v)
+end
+instance (ToFromInterpValue bitU)
+  let toInterpValue = toInterpValueBitU
+  let fromInterpValue = fromInterpValueBitU
+end
+
+
+let tuple2ToInterpValue (a,b) =
+  V_tuple [toInterpValue a;toInterpValue b]
+let rec tuple2FromInterpValue v = match v with
+  | V_tuple [a;b] -> (fromInterpValue a,fromInterpValue b)
+  | V_tuple [v] -> tuple2FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b. ToFromInterpValue 'a, ToFromInterpValue 'b => (ToFromInterpValue ('a * 'b))
+  let toInterpValue = tuple2ToInterpValue
+  let fromInterpValue = tuple2FromInterpValue
+end
+
+
+let tuple3ToInterpValue (a,b,c) =
+  V_tuple [toInterpValue a;toInterpValue b;toInterpValue c]
+let rec tuple3FromInterpValue v = match v with
+  | V_tuple [a;b;c] -> (fromInterpValue a,fromInterpValue b,fromInterpValue c)
+  | V_tuple [v] -> tuple3FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b*c: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b 'c. ToFromInterpValue 'a, ToFromInterpValue 'b, ToFromInterpValue 'c =>
+    (ToFromInterpValue ('a * 'b * 'c))
+  let toInterpValue = tuple3ToInterpValue
+  let fromInterpValue = tuple3FromInterpValue
+end
+
+
+let tuple4ToInterpValue (a,b,c,d) =
+  V_tuple [toInterpValue a;toInterpValue b;toInterpValue c;toInterpValue d]
+let rec tuple4FromInterpValue v = match v with
+  | V_tuple [a;b;c;d] -> (fromInterpValue a,fromInterpValue b,
+                          fromInterpValue c,fromInterpValue d)
+  | V_tuple [v] -> tuple4FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b*c*d: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b 'c 'd. ToFromInterpValue 'a, ToFromInterpValue 'b,
+                             ToFromInterpValue 'c, ToFromInterpValue 'd =>
+    (ToFromInterpValue ('a * 'b * 'c * 'd))
+  let toInterpValue = tuple4ToInterpValue
+  let fromInterpValue = tuple4FromInterpValue
+end
+
+
+let tuple5ToInterpValue (a,b,c,d,e) =
+  V_tuple [toInterpValue a;toInterpValue b;toInterpValue c;toInterpValue d;toInterpValue e]
+let rec tuple5FromInterpValue v = match v with
+  | V_tuple [a;b;c;d;e] ->
+     (fromInterpValue a,fromInterpValue b,fromInterpValue c,
+      fromInterpValue d,fromInterpValue e)
+  | V_tuple [v] -> tuple5FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b*c*d*e: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b 'c 'd 'e.
+    ToFromInterpValue 'a, ToFromInterpValue 'b,
+    ToFromInterpValue 'c, ToFromInterpValue 'd,
+    ToFromInterpValue 'e =>
+    (ToFromInterpValue ('a * 'b * 'c * 'd * 'e))
+  let toInterpValue = tuple5ToInterpValue
+  let fromInterpValue = tuple5FromInterpValue
+end
+
+
+let tuple6ToInterpValue (a,b,c,d,e,f) =
+  V_tuple [toInterpValue a;toInterpValue b;toInterpValue c;toInterpValue d;
+           toInterpValue e;toInterpValue f]
+let rec tuple6FromInterpValue v = match v with
+  | V_tuple [a;b;c;d;e;f] ->
+     (fromInterpValue a,fromInterpValue b,fromInterpValue c,
+      fromInterpValue d,fromInterpValue e,fromInterpValue f)
+  | V_tuple [v] -> tuple6FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b*c*d*e*f: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b 'c 'd 'e 'f.
+    ToFromInterpValue 'a, ToFromInterpValue 'b,
+    ToFromInterpValue 'c, ToFromInterpValue 'd,
+    ToFromInterpValue 'e, ToFromInterpValue 'f =>
+    (ToFromInterpValue ('a * 'b * 'c * 'd * 'e * 'f))
+  let toInterpValue = tuple6ToInterpValue
+  let fromInterpValue = tuple6FromInterpValue
+end
+
+
+let tuple7ToInterpValue (a,b,c,d,e,f,g) =
+  V_tuple [toInterpValue a;toInterpValue b;toInterpValue c;toInterpValue d;
+           toInterpValue e;toInterpValue f;toInterpValue g]
+let rec tuple7FromInterpValue v = match v with
+  | V_tuple [a;b;c;d;e;f;g] ->
+     (fromInterpValue a,fromInterpValue b,fromInterpValue c,
+      fromInterpValue d,fromInterpValue e,fromInterpValue f,
+      fromInterpValue g)
+  | V_tuple [v] -> tuple7FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b*c*d*e*f*g: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b 'c 'd 'e 'f 'g.
+    ToFromInterpValue 'a, ToFromInterpValue 'b,
+    ToFromInterpValue 'c, ToFromInterpValue 'd,
+    ToFromInterpValue 'e, ToFromInterpValue 'f,
+    ToFromInterpValue 'g =>
+    (ToFromInterpValue ('a * 'b * 'c * 'd * 'e * 'f * 'g))
+  let toInterpValue = tuple7ToInterpValue
+  let fromInterpValue = tuple7FromInterpValue
+end
+
+
+let tuple8ToInterpValue (a,b,c,d,e,f,g,h) =
+  V_tuple [toInterpValue a;toInterpValue b;toInterpValue c;toInterpValue d;
+           toInterpValue e;toInterpValue f;toInterpValue g;toInterpValue h]
+let rec tuple8FromInterpValue v = match v with
+  | V_tuple [a;b;c;d;e;f;g;h] ->
+     (fromInterpValue a,fromInterpValue b,fromInterpValue c,
+      fromInterpValue d,fromInterpValue e,fromInterpValue f,
+      fromInterpValue g,fromInterpValue h)
+  | V_tuple [v] -> tuple8FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b*c*d*e*f*g*h: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b 'c 'd 'e 'f 'g 'h.
+    ToFromInterpValue 'a, ToFromInterpValue 'b,
+    ToFromInterpValue 'c, ToFromInterpValue 'd,
+    ToFromInterpValue 'e, ToFromInterpValue 'f,
+    ToFromInterpValue 'g, ToFromInterpValue 'h =>
+    (ToFromInterpValue ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h))
+  let toInterpValue = tuple8ToInterpValue
+  let fromInterpValue = tuple8FromInterpValue
+end
+
+
+let tuple9ToInterpValue (a,b,c,d,e,f,g,h,i) =
+  V_tuple [toInterpValue a;toInterpValue b;toInterpValue c;toInterpValue d;
+           toInterpValue e;toInterpValue f;toInterpValue g;toInterpValue h;
+           toInterpValue i]
+let rec tuple9FromInterpValue v = match v with
+  | V_tuple [a;b;c;d;e;f;g;h;i] ->
+     (fromInterpValue a,fromInterpValue b,fromInterpValue c,
+      fromInterpValue d,fromInterpValue e,fromInterpValue f,
+      fromInterpValue g,fromInterpValue h,fromInterpValue i)
+  | V_tuple [v] -> tuple9FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b*c*d*e*f*g*h*i: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b 'c 'd 'e 'f 'g 'h 'i.
+    ToFromInterpValue 'a, ToFromInterpValue 'b,
+    ToFromInterpValue 'c, ToFromInterpValue 'd,
+    ToFromInterpValue 'e, ToFromInterpValue 'f,
+    ToFromInterpValue 'g, ToFromInterpValue 'h,
+    ToFromInterpValue 'i =>
+    (ToFromInterpValue ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i))
+  let toInterpValue = tuple9ToInterpValue
+  let fromInterpValue = tuple9FromInterpValue
+end
+
+
+let tuple10ToInterpValue (a,b,c,d,e,f,g,h,i,j) =
+  V_tuple [toInterpValue a;toInterpValue b;toInterpValue c;toInterpValue d;
+           toInterpValue e;toInterpValue f;toInterpValue g;toInterpValue h;
+           toInterpValue i;toInterpValue j;]
+let rec tuple10FromInterpValue v = match v with
+  | V_tuple [a;b;c;d;e;f;g;h;i;j] ->
+     (fromInterpValue a,fromInterpValue b,fromInterpValue c,
+      fromInterpValue d,fromInterpValue e,fromInterpValue f,
+      fromInterpValue g,fromInterpValue h,fromInterpValue i,
+      fromInterpValue j)
+  | V_tuple [v] -> tuple10FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b*c*d*e*f*g*h*i*j: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j.
+    ToFromInterpValue 'a, ToFromInterpValue 'b,
+    ToFromInterpValue 'c, ToFromInterpValue 'd,
+    ToFromInterpValue 'e, ToFromInterpValue 'f,
+    ToFromInterpValue 'g, ToFromInterpValue 'h,
+    ToFromInterpValue 'i, ToFromInterpValue 'j =>
+    (ToFromInterpValue ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j))
+  let toInterpValue = tuple10ToInterpValue
+  let fromInterpValue = tuple10FromInterpValue
+end
+
+
+let tuple11ToInterpValue (a,b,c,d,e,f,g,h,i,j,k) =
+  V_tuple [toInterpValue a;toInterpValue b;toInterpValue c;toInterpValue d;
+           toInterpValue e;toInterpValue f;toInterpValue g;toInterpValue h;
+           toInterpValue i;toInterpValue j;toInterpValue k;]
+let rec tuple11FromInterpValue v = match v with
+  | V_tuple [a;b;c;d;e;f;g;h;i;j;k] ->
+     (fromInterpValue a,fromInterpValue b,fromInterpValue c,
+      fromInterpValue d,fromInterpValue e,fromInterpValue f,
+      fromInterpValue g,fromInterpValue h,fromInterpValue i,
+      fromInterpValue j,fromInterpValue k)
+  | V_tuple [v] -> tuple11FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b*c*d*e*f*g*h*i*j*k: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k.
+    ToFromInterpValue 'a, ToFromInterpValue 'b,
+    ToFromInterpValue 'c, ToFromInterpValue 'd,
+    ToFromInterpValue 'e, ToFromInterpValue 'f,
+    ToFromInterpValue 'g, ToFromInterpValue 'h,
+    ToFromInterpValue 'i, ToFromInterpValue 'j,
+    ToFromInterpValue 'k =>
+    (ToFromInterpValue ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k))
+  let toInterpValue = tuple11ToInterpValue
+  let fromInterpValue = tuple11FromInterpValue
+end
+
+
+let tuple12ToInterpValue (a,b,c,d,e,f,g,h,i,j,k,l) =
+  V_tuple [toInterpValue a;toInterpValue b;toInterpValue c;toInterpValue d;
+           toInterpValue e;toInterpValue f;toInterpValue g;toInterpValue h;
+           toInterpValue i;toInterpValue j;toInterpValue k;toInterpValue l;]
+let rec tuple12FromInterpValue v = match v with
+  | V_tuple [a;b;c;d;e;f;g;h;i;j;k;l] ->
+     (fromInterpValue a,fromInterpValue b,fromInterpValue c,
+      fromInterpValue d,fromInterpValue e,fromInterpValue f,
+      fromInterpValue g,fromInterpValue h,fromInterpValue i,
+      fromInterpValue j,fromInterpValue k,fromInterpValue l)
+  | V_tuple [v] -> tuple12FromInterpValue v
+  | v -> failwith ("fromInterpValue a*b*c*d*e*f*g*h*i*j*k*l: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k 'l.
+    ToFromInterpValue 'a, ToFromInterpValue 'b,
+    ToFromInterpValue 'c, ToFromInterpValue 'd,
+    ToFromInterpValue 'e, ToFromInterpValue 'f,
+    ToFromInterpValue 'g, ToFromInterpValue 'h,
+    ToFromInterpValue 'i, ToFromInterpValue 'j,
+    ToFromInterpValue 'k, ToFromInterpValue 'l =>
+    (ToFromInterpValue ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l))
+  let toInterpValue = tuple12ToInterpValue
+  let fromInterpValue = tuple12FromInterpValue
+end
+
+
+let listToInterpValue l = V_list (List.map toInterpValue l)
+let rec listFromInterpValue v = match v with
+  | V_list l -> List.map fromInterpValue l
+  | V_tuple [v] -> listFromInterpValue v
+  | v -> failwith ("fromInterpValue list 'a: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a. ToFromInterpValue 'a => (ToFromInterpValue (list 'a))
+  let toInterpValue = listToInterpValue
+  let fromInterpValue = listFromInterpValue
+end
+
+
+let vectorToInterpValue (Vector vs start direction) =
+  V_vector (natFromInteger start) (if direction then IInc else IDec) (List.map toInterpValue vs)
+let rec vectorFromInterpValue v = match v with
+  | V_vector start direction vs ->
+     Vector (List.map fromInterpValue vs) (integerFromNat start)
+            (match direction with | IInc -> true | IDec -> false end)
+  | V_vector_sparse start length direction valuemap defaultval ->
+     make_indexed_vector
+       (List.map (fun (i,v) -> (integerFromNat i,fromInterpValue v)) valuemap)
+       (fromInterpValue defaultval)
+       (integerFromNat start) (integerFromNat length)
+       (match direction with | IInc -> true | IDec -> false end)
+  | V_tuple [v] -> vectorFromInterpValue v
+  | v -> failwith ("fromInterpValue vector 'a: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance forall 'a. ToFromInterpValue 'a => (ToFromInterpValue (vector 'a))
+  let toInterpValue = vectorToInterpValue
+  let fromInterpValue = vectorFromInterpValue
+end
+
+(* Here the type information is not accurate: instead of T_id "option" it should
+   be T_app (T_id "option") (...), but temporarily we'll do it like this. The
+   same thing has to be fixed in pretty_print.ml when we're generating the
+   type-class instances. *)
+let maybeToInterpValue = function
+  | Nothing -> V_ctor (Id_aux (Id "None") Unknown) (T_id "option") C_Union (V_lit (L_aux L_unit Unknown))
+  | Just a  -> V_ctor (Id_aux (Id "Some") Unknown) (T_id "option") C_Union (toInterpValue a)
+  end
+let rec maybeFromInterpValue v = match v with
+  | V_ctor (Id_aux (Id "None") _) _ _ _ -> Nothing
+  | V_ctor (Id_aux (Id "Some") _) _ _ v -> Just (fromInterpValue v)
+  | V_tuple [v] -> maybeFromInterpValue v
+  | v -> failwith ("fromInterpValue maybe 'a: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+
+instance forall 'a. ToFromInterpValue 'a => (ToFromInterpValue (maybe 'a))
+  let toInterpValue = maybeToInterpValue
+  let fromInterpValue = maybeFromInterpValue
+end
+
+
+let read_kindToInterpValue = function
+  | Read_plain -> V_ctor (Id_aux (Id "Read_plain") Unknown) (T_id "read_kind") (C_Enum 0) (toInterpValue ())
+  | Read_reserve -> V_ctor (Id_aux (Id "Read_reserve") Unknown) (T_id "read_kind") (C_Enum 1) (toInterpValue ())
+  | Read_acquire -> V_ctor (Id_aux (Id "Read_acquire") Unknown) (T_id "read_kind") (C_Enum 2) (toInterpValue ())
+  | Read_exclusive -> V_ctor (Id_aux (Id "Read_exclusive") Unknown) (T_id "read_kind") (C_Enum 3) (toInterpValue ())
+  | Read_exclusive_acquire -> V_ctor (Id_aux (Id "Read_exclusive_acquire") Unknown) (T_id "read_kind") (C_Enum 4) (toInterpValue ())
+  | Read_stream -> V_ctor (Id_aux (Id "Read_stream") Unknown) (T_id "read_kind") (C_Enum 5) (toInterpValue ())
+  | Read_RISCV_acquire -> V_ctor (Id_aux (Id "Read_RISCV_acquire") Unknown) (T_id "read_kind") (C_Enum 6) (toInterpValue ())
+  | Read_RISCV_strong_acquire -> V_ctor (Id_aux (Id "Read_RISCV_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 7) (toInterpValue ())
+  | Read_RISCV_reserved -> V_ctor (Id_aux (Id "Read_RISCV_reserved") Unknown) (T_id "read_kind") (C_Enum 8) (toInterpValue ())
+  | Read_RISCV_reserved_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_acquire") Unknown) (T_id "read_kind") (C_Enum 9) (toInterpValue ())
+  | Read_RISCV_reserved_strong_acquire -> V_ctor (Id_aux (Id "Read_RISCV_reserved_strong_acquire") Unknown) (T_id "read_kind") (C_Enum 10) (toInterpValue ())
+  | Read_X86_locked -> V_ctor (Id_aux (Id "Read_X86_locked") Unknown) (T_id "read_kind") (C_Enum 11) (toInterpValue ())
+  end
+let rec read_kindFromInterpValue v = match v with
+  | V_ctor (Id_aux (Id "Read_plain") _) _ _ v -> Read_plain
+  | V_ctor (Id_aux (Id "Read_reserve") _) _ _ v -> Read_reserve
+  | V_ctor (Id_aux (Id "Read_acquire") _) _ _ v -> Read_acquire
+  | V_ctor (Id_aux (Id "Read_exclusive") _) _ _ v -> Read_exclusive
+  | V_ctor (Id_aux (Id "Read_exclusive_acquire") _) _ _ v -> Read_exclusive_acquire
+  | V_ctor (Id_aux (Id "Read_stream") _) _ _ v -> Read_stream
+  | V_ctor (Id_aux (Id "Read_RISCV_acquire") _) _ _ v -> Read_RISCV_acquire
+  | V_ctor (Id_aux (Id "Read_RISCV_strong_acquire") _) _ _ v -> Read_RISCV_strong_acquire
+  | V_ctor (Id_aux (Id "Read_RISCV_reserved") _) _ _ v -> Read_RISCV_reserved
+  | V_ctor (Id_aux (Id "Read_RISCV_reserved_acquire") _) _ _ v -> Read_RISCV_reserved_acquire
+  | V_ctor (Id_aux (Id "Read_RISCV_reserved_strong_acquire") _) _ _ v -> Read_RISCV_reserved_strong_acquire
+  | V_ctor (Id_aux (Id "Read_X86_locked") _) _ _ v -> Read_X86_locked
+  | V_tuple [v] -> read_kindFromInterpValue v
+  | v -> failwith ("fromInterpValue read_kind: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance (ToFromInterpValue read_kind)
+  let toInterpValue = read_kindToInterpValue
+  let fromInterpValue = read_kindFromInterpValue
+end
+
+
+let write_kindToInterpValue = function
+  | Write_plain -> V_ctor (Id_aux (Id "Write_plain") Unknown) (T_id "write_kind") (C_Enum 0) (toInterpValue ())
+  | Write_conditional -> V_ctor (Id_aux (Id "Write_conditional") Unknown) (T_id "write_kind") (C_Enum 1) (toInterpValue ())
+  | Write_release -> V_ctor (Id_aux (Id "Write_release") Unknown) (T_id "write_kind") (C_Enum 2) (toInterpValue ())
+  | Write_exclusive -> V_ctor (Id_aux (Id "Write_exclusive") Unknown) (T_id "write_kind") (C_Enum 3) (toInterpValue ())
+  | Write_exclusive_release -> V_ctor (Id_aux (Id "Write_exclusive_release") Unknown) (T_id "write_kind") (C_Enum 4) (toInterpValue ())
+  | Write_RISCV_release -> V_ctor (Id_aux (Id "Write_RISCV_release") Unknown) (T_id "write_kind") (C_Enum 5) (toInterpValue ())
+  | Write_RISCV_strong_release -> V_ctor (Id_aux (Id "Write_RISCV_strong_release") Unknown) (T_id "write_kind") (C_Enum 6) (toInterpValue ())
+  | Write_RISCV_conditional -> V_ctor (Id_aux (Id "Write_RISCV_conditional") Unknown) (T_id "write_kind") (C_Enum 7) (toInterpValue ())
+  | Write_RISCV_conditional_release -> V_ctor (Id_aux (Id "Write_RISCV_conditional_release") Unknown) (T_id "write_kind") (C_Enum 8) (toInterpValue ())
+  | Write_RISCV_conditional_strong_release -> V_ctor (Id_aux (Id "Write_RISCV_conditional_strong_release") Unknown) (T_id "write_kind") (C_Enum 9) (toInterpValue ())
+  | Write_X86_locked -> V_ctor (Id_aux (Id "Write_X86_locked") Unknown) (T_id "write_kind") (C_Enum 10) (toInterpValue ())
+  end
+let rec write_kindFromInterpValue v = match v with
+  | V_ctor (Id_aux (Id "Write_plain") _) _ _ v -> Write_plain
+  | V_ctor (Id_aux (Id "Write_conditional") _) _ _ v -> Write_conditional
+  | V_ctor (Id_aux (Id "Write_release") _) _ _ v -> Write_release
+  | V_ctor (Id_aux (Id "Write_exclusive") _) _ _ v -> Write_exclusive
+  | V_ctor (Id_aux (Id "Write_exclusive_release") _) _ _ v -> Write_exclusive_release
+  | V_ctor (Id_aux (Id "Write_RISCV_release") _) _ _ v -> Write_RISCV_release
+  | V_ctor (Id_aux (Id "Write_RISCV_strong_release") _) _ _ v -> Write_RISCV_strong_release
+  | V_ctor (Id_aux (Id "Write_RISCV_conditional") _) _ _ v -> Write_RISCV_conditional
+  | V_ctor (Id_aux (Id "Write_RISCV_conditional_release") _) _ _ v -> Write_RISCV_conditional_release
+  | V_ctor (Id_aux (Id "Write_RISCV_conditional_strong_release") _) _ _ v -> Write_RISCV_conditional_strong_release
+  | V_ctor (Id_aux (Id "Write_X86_locked") _) _ _ v -> Write_X86_locked
+  | V_tuple [v] -> write_kindFromInterpValue v
+  | v -> failwith ("fromInterpValue write_kind: unexpected value " ^
+                     Interp.debug_print_value v)
+  end
+instance (ToFromInterpValue write_kind)
+  let toInterpValue = write_kindToInterpValue
+  let fromInterpValue = write_kindFromInterpValue
+end
+
+
+let a64_barrier_domainToInterpValue = function
+  | A64_FullShare ->
+    V_ctor (Id_aux (Id "A64_FullShare") Unknown) (T_id "a64_barrier_domain") (C_Enum 0) (toInterpValue ())
+  | A64_InnerShare ->
+    V_ctor (Id_aux (Id "A64_InnerShare") Unknown) (T_id "a64_barrier_domain") (C_Enum 1) (toInterpValue ())
+  | A64_OuterShare ->
+    V_ctor (Id_aux (Id "A64_OuterShare") Unknown) (T_id "a64_barrier_domain") (C_Enum 2) (toInterpValue ())
+  | A64_NonShare ->
+    V_ctor (Id_aux (Id "A64_NonShare") Unknown) (T_id "a64_barrier_domain") (C_Enum 3) (toInterpValue ())
+end
+let rec a64_barrier_domainFromInterpValue v = match v with
+  | V_ctor (Id_aux (Id "A64_FullShare") _) _ _ v -> A64_FullShare
+  | V_ctor (Id_aux (Id "A64_InnerShare") _) _ _ v -> A64_InnerShare
+  | V_ctor (Id_aux (Id "A64_OuterShare") _) _ _ v -> A64_OuterShare
+  | V_ctor (Id_aux (Id "A64_NonShare") _) _ _ v -> A64_NonShare
+  | V_tuple [v] -> a64_barrier_domainFromInterpValue v
+  | v -> failwith ("fromInterpValue a64_barrier_domain: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance (ToFromInterpValue a64_barrier_domain)
+  let toInterpValue = a64_barrier_domainToInterpValue
+  let fromInterpValue = a64_barrier_domainFromInterpValue
+end
+
+let a64_barrier_typeToInterpValue = function
+  | A64_barrier_all ->
+    V_ctor (Id_aux (Id "A64_barrier_all") Unknown) (T_id "a64_barrier_type") (C_Enum 0) (toInterpValue ())
+  | A64_barrier_LD ->
+    V_ctor (Id_aux (Id "A64_barrier_LD") Unknown) (T_id "a64_barrier_type") (C_Enum 1) (toInterpValue ())
+  | A64_barrier_ST ->
+    V_ctor (Id_aux (Id "A64_barrier_ST") Unknown) (T_id "a64_barrier_type") (C_Enum 2) (toInterpValue ())
+end
+let rec a64_barrier_typeFromInterpValue v = match v with
+  | V_ctor (Id_aux (Id "A64_barrier_all") _) _ _ v -> A64_barrier_all
+  | V_ctor (Id_aux (Id "A64_barrier_LD") _) _ _ v -> A64_barrier_LD
+  | V_ctor (Id_aux (Id "A64_barrier_ST") _) _ _ v -> A64_barrier_ST
+  | V_tuple [v] -> a64_barrier_typeFromInterpValue v
+  | v -> failwith ("fromInterpValue a64_barrier_type: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance (ToFromInterpValue a64_barrier_type)
+  let toInterpValue = a64_barrier_typeToInterpValue
+  let fromInterpValue = a64_barrier_typeFromInterpValue
+end
+
+
+let barrier_kindToInterpValue = function
+  | Barrier_Sync -> V_ctor (Id_aux (Id "Barrier_Sync") Unknown) (T_id "barrier_kind") (C_Enum 0) (toInterpValue ())
+  | Barrier_LwSync -> V_ctor (Id_aux (Id "Barrier_LwSync") Unknown) (T_id "barrier_kind") (C_Enum 1) (toInterpValue ())
+  | Barrier_Eieio -> V_ctor (Id_aux (Id "Barrier_Eieio") Unknown) (T_id "barrier_kind") (C_Enum 2) (toInterpValue ())
+  | Barrier_Isync -> V_ctor (Id_aux (Id "Barrier_Isync") Unknown) (T_id "barrier_kind") (C_Enum 3) (toInterpValue ())
+  | Barrier_DMB (dom,typ) ->
+      V_ctor (Id_aux (Id "Barrier_DMB") Unknown) (T_id "barrier_kind") C_Union (toInterpValue (dom, typ))
+  | Barrier_DSB (dom,typ) ->
+      V_ctor (Id_aux (Id "Barrier_DSB") Unknown) (T_id "barrier_kind") C_Union (toInterpValue (dom, typ))
+  | Barrier_ISB -> V_ctor (Id_aux (Id "Barrier_ISB") Unknown) (T_id "barrier_kind") (C_Enum 10) (toInterpValue ())
+  | Barrier_TM_COMMIT -> V_ctor (Id_aux (Id "Barrier_TM_COMMIT") Unknown) (T_id "barrier_kind") (C_Enum 11) (toInterpValue ())
+  | Barrier_MIPS_SYNC -> V_ctor (Id_aux (Id "Barrier_MIPS_SYNC") Unknown) (T_id "barrier_kind") (C_Enum 12) (toInterpValue ())
+  | Barrier_RISCV_rw_rw -> V_ctor (Id_aux (Id "Barrier_RISCV_rw_rw") Unknown) (T_id "barrier_kind") (C_Enum 13) (toInterpValue ())
+  | Barrier_RISCV_r_rw -> V_ctor (Id_aux (Id "Barrier_RISCV_r_rw") Unknown) (T_id "barrier_kind") (C_Enum 14) (toInterpValue ())
+  | Barrier_RISCV_r_r -> V_ctor (Id_aux (Id "Barrier_RISCV_r_r") Unknown) (T_id "barrier_kind") (C_Enum 15) (toInterpValue ())
+  | Barrier_RISCV_rw_w -> V_ctor (Id_aux (Id "Barrier_RISCV_rw_w") Unknown) (T_id "barrier_kind") (C_Enum 16) (toInterpValue ())
+  | Barrier_RISCV_w_w -> V_ctor (Id_aux (Id "Barrier_RISCV_w_w") Unknown) (T_id "barrier_kind") (C_Enum 17) (toInterpValue ())
+  | Barrier_RISCV_i -> V_ctor (Id_aux (Id "Barrier_RISCV_i") Unknown) (T_id "barrier_kind") (C_Enum 18) (toInterpValue ())
+  | Barrier_x86_MFENCE -> V_ctor (Id_aux (Id "Barrier_x86_MFENCE") Unknown) (T_id "barrier_kind") (C_Enum 19) (toInterpValue ())
+  end
+let rec barrier_kindFromInterpValue v = match v with
+  | V_ctor (Id_aux (Id "Barrier_Sync") _) _ _ v -> Barrier_Sync
+  | V_ctor (Id_aux (Id "Barrier_LwSync") _) _ _ v -> Barrier_LwSync
+  | V_ctor (Id_aux (Id "Barrier_Eieio") _) _ _ v -> Barrier_Eieio
+  | V_ctor (Id_aux (Id "Barrier_Isync") _) _ _ v -> Barrier_Isync
+  | V_ctor (Id_aux (Id "Barrier_DMB") _) _ _ v ->
+      let (dom, typ) = fromInterpValue v in
+      Barrier_DMB (dom,typ)
+  | V_ctor (Id_aux (Id "Barrier_DSB") _) _ _ v ->
+      let (dom, typ) = fromInterpValue v in
+      Barrier_DSB (dom,typ)
+  | V_ctor (Id_aux (Id "Barrier_ISB") _) _ _ v -> Barrier_ISB
+  | V_ctor (Id_aux (Id "Barrier_TM_COMMIT") _) _ _ v -> Barrier_TM_COMMIT
+  | V_ctor (Id_aux (Id "Barrier_MIPS_SYNC") _) _ _ v -> Barrier_MIPS_SYNC
+  | V_ctor (Id_aux (Id "Barrier_RISCV_rw_rw") _) _ _ v -> Barrier_RISCV_rw_rw
+  | V_ctor (Id_aux (Id "Barrier_RISCV_r_rw") _) _ _ v -> Barrier_RISCV_r_rw
+  | V_ctor (Id_aux (Id "Barrier_RISCV_r_r") _) _ _ v -> Barrier_RISCV_r_r
+  | V_ctor (Id_aux (Id "Barrier_RISCV_rw_w") _) _ _ v -> Barrier_RISCV_rw_w
+  | V_ctor (Id_aux (Id "Barrier_RISCV_w_w") _) _ _ v -> Barrier_RISCV_w_w
+  | V_ctor (Id_aux (Id "Barrier_RISCV_i") _) _ _ v -> Barrier_RISCV_i
+  | V_ctor (Id_aux (Id "Barrier_x86_MFENCE") _) _ _ v -> Barrier_x86_MFENCE
+  | V_tuple [v] -> barrier_kindFromInterpValue v
+  | v -> failwith ("fromInterpValue barrier_kind: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance (ToFromInterpValue barrier_kind)
+  let toInterpValue = barrier_kindToInterpValue
+  let fromInterpValue = barrier_kindFromInterpValue
+end
+
+
+let trans_kindToInterpValue = function
+  | Transaction_start -> V_ctor (Id_aux (Id "Transaction_start") Unknown) (T_id "trans_kind") (C_Enum 0) (toInterpValue ())
+  | Transaction_commit -> V_ctor (Id_aux (Id "Transaction_commit") Unknown) (T_id "trans_kind") (C_Enum 1) (toInterpValue ())
+  | Transaction_abort -> V_ctor (Id_aux (Id "Transaction_abort") Unknown) (T_id "trans_kind") (C_Enum 2) (toInterpValue ())
+  end
+let rec trans_kindFromInterpValue v = match v with
+  | V_ctor (Id_aux (Id "Transaction_start") _) _ _ v -> Transaction_start
+  | V_ctor (Id_aux (Id "Transaction_commit") _) _ _ v -> Transaction_commit
+  | V_ctor (Id_aux (Id "Transaction_abort") _) _ _ v -> Transaction_abort
+  | V_tuple [v] -> trans_kindFromInterpValue v
+  | v -> failwith ("fromInterpValue trans_kind: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance (ToFromInterpValue trans_kind)
+  let toInterpValue = trans_kindToInterpValue
+  let fromInterpValue = trans_kindFromInterpValue
+end
+
+
+let instruction_kindToInterpValue = function
+  | IK_barrier v -> V_ctor (Id_aux (Id "IK_barrier") Unknown) (T_id "instruction_kind") C_Union (toInterpValue v)
+  | IK_mem_read v -> V_ctor (Id_aux (Id "IK_mem_read") Unknown) (T_id "instruction_kind") C_Union (toInterpValue v)
+  | IK_mem_write v -> V_ctor (Id_aux (Id "IK_mem_write") Unknown) (T_id "instruction_kind") C_Union (toInterpValue v)
+  | IK_mem_rmw v -> V_ctor (Id_aux (Id "IK_mem_rmw") Unknown) (T_id "instruction_kind") C_Union (toInterpValue v)
+  | IK_branch -> V_ctor (Id_aux (Id "IK_branch") Unknown) (T_id "instruction_kind") C_Union (toInterpValue ())
+  | IK_trans v -> V_ctor (Id_aux (Id "IK_trans") Unknown) (T_id "instruction_kind") C_Union (toInterpValue v)
+  | IK_simple -> V_ctor (Id_aux (Id "IK_simple") Unknown) (T_id "instruction_kind") C_Union (toInterpValue ())
+  end
+let rec instruction_kindFromInterpValue v = match v with
+  | V_ctor (Id_aux (Id "IK_barrier") _) _ _ v -> IK_barrier (fromInterpValue v)
+  | V_ctor (Id_aux (Id "IK_mem_read") _) _ _ v -> IK_mem_read (fromInterpValue v)
+  | V_ctor (Id_aux (Id "IK_mem_write") _) _ _ v -> IK_mem_write (fromInterpValue v)
+  | V_ctor (Id_aux (Id "IK_mem_rmw") _) _ _ v -> IK_mem_rmw (fromInterpValue v)
+  | V_ctor (Id_aux (Id "IK_branch") _) _ _ v -> IK_branch
+  | V_ctor (Id_aux (Id "IK_trans") _) _ _ v -> IK_trans (fromInterpValue v)
+  | V_ctor (Id_aux (Id "IK_simple") _) _ _ v -> IK_simple
+  | V_tuple [v] -> instruction_kindFromInterpValue v
+  | v -> failwith ("fromInterpValue instruction_kind: unexpected value. " ^
+                     Interp.debug_print_value v)
+  end
+instance (ToFromInterpValue instruction_kind)
+  let toInterpValue = instruction_kindToInterpValue
+  let fromInterpValue = instruction_kindFromInterpValue
+end
+
+let regfpToInterpValue = function
+  | RFull v -> Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RFull") Interp_ast.Unknown) (Interp_ast.T_id "regfp") Interp_ast.C_Union (toInterpValue v)
+  | RSlice v -> Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RSlice") Interp_ast.Unknown) (Interp_ast.T_id "regfp") Interp_ast.C_Union (toInterpValue v)
+  | RSliceBit v -> Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RSliceBit") Interp_ast.Unknown) (Interp_ast.T_id "regfp") Interp_ast.C_Union (toInterpValue v)
+  | RField v -> Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RField") Interp_ast.Unknown) (Interp_ast.T_id "regfp") Interp_ast.C_Union (toInterpValue v)
+  end
+
+let rec regfpFromInterpValue v = match v with
+  | Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RFull") _) _ _ v -> RFull (fromInterpValue v)
+  | Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RSlice") _) _ _ v -> RSlice (fromInterpValue v)
+  | Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RSliceBit") _) _ _ v -> RSliceBit (fromInterpValue v)
+  | Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id "RField") _) _ _ v -> RField (fromInterpValue v)
+  | Interp_ast.V_tuple [v] -> regfpFromInterpValue v
+  | v -> failwith ("fromInterpValue regfp: unexpected value. " ^ Interp.debug_print_value v)
+  end
+
+instance (ToFromInterpValue regfp)
+  let toInterpValue = regfpToInterpValue
+  let fromInterpValue = regfpFromInterpValue
+end
+
+
+
+
diff --git a/src/gen_lib/0.11/sail2_instr_kinds.lem b/src/gen_lib/0.11/sail2_instr_kinds.lem
new file mode 100644
index 00000000..3d238676
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_instr_kinds.lem
@@ -0,0 +1,306 @@
+(*========================================================================*)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(*========================================================================*)
+
+open import Pervasives_extra
+
+
+class ( EnumerationType 'a )
+  val toNat : 'a -> nat
+end
+
+
+val enumeration_typeCompare : forall 'a. EnumerationType 'a => 'a -> 'a -> ordering
+let ~{ocaml} enumeration_typeCompare e1 e2 =
+  compare (toNat e1) (toNat e2)
+let inline {ocaml} enumeration_typeCompare = defaultCompare
+
+
+default_instance forall 'a. EnumerationType 'a => (Ord 'a)
+  let compare = enumeration_typeCompare
+  let (<)  r1 r2 = (enumeration_typeCompare r1 r2) = LT
+  let (<=) r1 r2 = (enumeration_typeCompare r1 r2) <> GT
+  let (>)  r1 r2 = (enumeration_typeCompare r1 r2) = GT
+  let (>=) r1 r2 = (enumeration_typeCompare r1 r2) <> LT
+end
+
+
+(* Data structures for building up instructions *)
+
+(* careful: changes in the read/write/barrier kinds have to be
+   reflected in deep_shallow_convert *)
+type read_kind =
+  (* common reads *)
+  | Read_plain
+  (* Power reads *)
+  | Read_reserve
+  (* AArch64 reads *)
+  | Read_acquire | Read_exclusive | Read_exclusive_acquire | Read_stream
+  (* RISC-V reads *)
+  | Read_RISCV_acquire  | Read_RISCV_strong_acquire
+  | Read_RISCV_reserved | Read_RISCV_reserved_acquire
+  | Read_RISCV_reserved_strong_acquire
+  (* x86 reads *)
+  | Read_X86_locked (* the read part of a lock'd instruction (rmw) *)
+
+instance (Show read_kind)
+  let show = function
+    | Read_plain -> "Read_plain"
+    | Read_reserve -> "Read_reserve"
+    | Read_acquire -> "Read_acquire"
+    | Read_exclusive -> "Read_exclusive"
+    | Read_exclusive_acquire -> "Read_exclusive_acquire"
+    | Read_stream -> "Read_stream"
+    | Read_RISCV_acquire -> "Read_RISCV_acquire"
+    | Read_RISCV_strong_acquire -> "Read_RISCV_strong_acquire"
+    | Read_RISCV_reserved -> "Read_RISCV_reserved"
+    | Read_RISCV_reserved_acquire -> "Read_RISCV_reserved_acquire"
+    | Read_RISCV_reserved_strong_acquire -> "Read_RISCV_reserved_strong_acquire"
+    | Read_X86_locked -> "Read_X86_locked"
+  end
+end
+
+type write_kind =
+  (* common writes *)
+  | Write_plain
+  (* Power writes *)
+  | Write_conditional
+  (* AArch64 writes *)
+  | Write_release | Write_exclusive | Write_exclusive_release
+  (* RISC-V *)
+  | Write_RISCV_release     | Write_RISCV_strong_release
+  | Write_RISCV_conditional | Write_RISCV_conditional_release
+  | Write_RISCV_conditional_strong_release
+  (* x86 writes *)
+  | Write_X86_locked (* the write part of a lock'd instruction (rmw) *)
+
+instance (Show write_kind)
+  let show = function
+    | Write_plain -> "Write_plain"
+    | Write_conditional -> "Write_conditional"
+    | Write_release -> "Write_release"
+    | Write_exclusive -> "Write_exclusive"
+    | Write_exclusive_release -> "Write_exclusive_release"
+    | Write_RISCV_release -> "Write_RISCV_release"
+    | Write_RISCV_strong_release -> "Write_RISCV_strong_release"
+    | Write_RISCV_conditional -> "Write_RISCV_conditional"
+    | Write_RISCV_conditional_release -> "Write_RISCV_conditional_release"
+    | Write_RISCV_conditional_strong_release -> "Write_RISCV_conditional_strong_release"
+    | Write_X86_locked -> "Write_X86_locked"
+  end
+end
+
+type barrier_kind =
+  (* Power barriers *)
+  Barrier_Sync | Barrier_LwSync | Barrier_Eieio | Barrier_Isync
+  (* AArch64 barriers *)
+  | Barrier_DMB | Barrier_DMB_ST | Barrier_DMB_LD | Barrier_DSB
+  | Barrier_DSB_ST | Barrier_DSB_LD | Barrier_ISB
+  | Barrier_TM_COMMIT
+  (* MIPS barriers *)
+  | Barrier_MIPS_SYNC
+  (* RISC-V barriers *)
+  | Barrier_RISCV_rw_rw
+  | Barrier_RISCV_r_rw
+  | Barrier_RISCV_r_r
+  | Barrier_RISCV_rw_w
+  | Barrier_RISCV_w_w
+  | Barrier_RISCV_w_rw
+  | Barrier_RISCV_rw_r
+  | Barrier_RISCV_r_w
+  | Barrier_RISCV_w_r
+  | Barrier_RISCV_i
+  (* X86 *)
+  | Barrier_x86_MFENCE
+
+
+instance (Show barrier_kind)
+  let show = function
+    | Barrier_Sync -> "Barrier_Sync"
+    | Barrier_LwSync -> "Barrier_LwSync"
+    | Barrier_Eieio -> "Barrier_Eieio"
+    | Barrier_Isync -> "Barrier_Isync"
+    | Barrier_DMB -> "Barrier_DMB"
+    | Barrier_DMB_ST -> "Barrier_DMB_ST"
+    | Barrier_DMB_LD -> "Barrier_DMB_LD"
+    | Barrier_DSB -> "Barrier_DSB"
+    | Barrier_DSB_ST -> "Barrier_DSB_ST"
+    | Barrier_DSB_LD -> "Barrier_DSB_LD"
+    | Barrier_ISB -> "Barrier_ISB"
+    | Barrier_TM_COMMIT -> "Barrier_TM_COMMIT"
+    | Barrier_MIPS_SYNC -> "Barrier_MIPS_SYNC"
+    | Barrier_RISCV_rw_rw -> "Barrier_RISCV_rw_rw"
+    | Barrier_RISCV_r_rw  -> "Barrier_RISCV_r_rw"
+    | Barrier_RISCV_r_r   -> "Barrier_RISCV_r_r"
+    | Barrier_RISCV_rw_w  -> "Barrier_RISCV_rw_w"
+    | Barrier_RISCV_w_w   -> "Barrier_RISCV_w_w"
+    | Barrier_RISCV_w_rw  -> "Barrier_RISCV_w_rw"
+    | Barrier_RISCV_rw_r  -> "Barrier_RISCV_rw_r"
+    | Barrier_RISCV_r_w   -> "Barrier_RISCV_r_w"
+    | Barrier_RISCV_w_r   -> "Barrier_RISCV_w_r"
+    | Barrier_RISCV_i     -> "Barrier_RISCV_i"
+    | Barrier_x86_MFENCE  -> "Barrier_x86_MFENCE"
+  end
+end
+
+type trans_kind =
+  (* AArch64 *)
+  | Transaction_start | Transaction_commit | Transaction_abort
+
+instance (Show trans_kind)
+  let show = function
+  | Transaction_start  -> "Transaction_start"
+  | Transaction_commit -> "Transaction_commit"
+  | Transaction_abort  -> "Transaction_abort"
+  end
+end
+
+type instruction_kind =
+  | IK_barrier   of barrier_kind
+  | IK_mem_read  of read_kind
+  | IK_mem_write of write_kind
+  | IK_mem_rmw   of (read_kind * write_kind)
+  | IK_branch    of unit(* this includes conditional-branch (multiple nias, none of which is NIA_indirect_address),
+  indirect/computed-branch (single nia of kind NIA_indirect_address)
+  and branch/jump (single nia of kind NIA_concrete_address) *)
+  | IK_trans     of trans_kind
+  | IK_simple    of unit
+
+
+instance (Show instruction_kind)
+  let show = function
+    | IK_barrier barrier_kind -> "IK_barrier " ^ (show barrier_kind)
+    | IK_mem_read read_kind   -> "IK_mem_read " ^ (show read_kind)
+    | IK_mem_write write_kind -> "IK_mem_write " ^ (show write_kind)
+    | IK_mem_rmw (r, w)       -> "IK_mem_rmw " ^ (show r) ^ " " ^ (show w)
+    | IK_branch ()            -> "IK_branch"
+    | IK_trans trans_kind     -> "IK_trans " ^ (show trans_kind)
+    | IK_simple ()            -> "IK_simple"
+  end
+end
+
+
+let read_is_exclusive = function
+  | Read_plain -> false
+  | Read_reserve -> true
+  | Read_acquire -> false
+  | Read_exclusive -> true
+  | Read_exclusive_acquire -> true
+  | Read_stream -> false
+  | Read_RISCV_acquire -> false
+  | Read_RISCV_strong_acquire -> false
+  | Read_RISCV_reserved -> true
+  | Read_RISCV_reserved_acquire -> true
+  | Read_RISCV_reserved_strong_acquire -> true
+  | Read_X86_locked -> true
+end
+
+
+
+instance (EnumerationType read_kind)
+  let toNat = function
+    | Read_plain -> 0
+    | Read_reserve -> 1
+    | Read_acquire -> 2
+    | Read_exclusive -> 3
+    | Read_exclusive_acquire -> 4
+    | Read_stream -> 5
+    | Read_RISCV_acquire -> 6
+    | Read_RISCV_strong_acquire -> 7
+    | Read_RISCV_reserved -> 8
+    | Read_RISCV_reserved_acquire -> 9
+    | Read_RISCV_reserved_strong_acquire -> 10
+    | Read_X86_locked -> 11
+  end
+end
+
+instance (EnumerationType write_kind)
+  let toNat = function
+    | Write_plain -> 0
+    | Write_conditional -> 1
+    | Write_release -> 2
+    | Write_exclusive -> 3
+    | Write_exclusive_release -> 4
+    | Write_RISCV_release -> 5
+    | Write_RISCV_strong_release -> 6
+    | Write_RISCV_conditional -> 7
+    | Write_RISCV_conditional_release -> 8
+    | Write_RISCV_conditional_strong_release -> 9
+    | Write_X86_locked -> 10
+  end
+end
+
+instance (EnumerationType barrier_kind)
+  let toNat = function
+    | Barrier_Sync -> 0
+    | Barrier_LwSync -> 1
+    | Barrier_Eieio ->2
+    | Barrier_Isync -> 3
+    | Barrier_DMB -> 4
+    | Barrier_DMB_ST -> 5
+    | Barrier_DMB_LD -> 6
+    | Barrier_DSB -> 7
+    | Barrier_DSB_ST -> 8
+    | Barrier_DSB_LD -> 9
+    | Barrier_ISB -> 10
+    | Barrier_TM_COMMIT -> 11
+    | Barrier_MIPS_SYNC -> 12
+    | Barrier_RISCV_rw_rw -> 13
+    | Barrier_RISCV_r_rw -> 14
+    | Barrier_RISCV_r_r -> 15
+    | Barrier_RISCV_rw_w -> 16
+    | Barrier_RISCV_w_w -> 17
+    | Barrier_RISCV_w_rw -> 18
+    | Barrier_RISCV_rw_r -> 19
+    | Barrier_RISCV_r_w -> 20
+    | Barrier_RISCV_w_r -> 21
+    | Barrier_RISCV_i -> 22
+    | Barrier_x86_MFENCE -> 23
+  end
+end
diff --git a/src/gen_lib/0.11/sail2_operators.lem b/src/gen_lib/0.11/sail2_operators.lem
new file mode 100644
index 00000000..43a9812e
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_operators.lem
@@ -0,0 +1,207 @@
+open import Pervasives_extra
+open import Machine_word
+open import Sail2_values
+
+(*** Bit vector operations *)
+
+val concat_bv : forall 'a 'b. Bitvector 'a, Bitvector 'b => 'a -> 'b -> list bitU
+let concat_bv l r = (bits_of l ++ bits_of r)
+
+val cons_bv : forall 'a. Bitvector 'a => bitU -> 'a -> list bitU
+let cons_bv b v = b :: bits_of v
+
+val cast_unit_bv : bitU -> list bitU
+let cast_unit_bv b = [b]
+
+val bv_of_bit : integer -> bitU -> list bitU
+let bv_of_bit len b = extz_bits len [b]
+
+let most_significant v = match bits_of v with
+  | b :: _ -> b
+  | _ -> B0 (* Treat empty bitvector as all zeros *)
+  end
+
+let get_max_representable_in sign (n : integer) : integer =
+  if (n = 64) then match sign with | true -> max_64 | false -> max_64u end
+  else if (n=32) then match sign with | true -> max_32 | false -> max_32u end
+  else if (n=8) then max_8
+  else if (n=5) then max_5
+  else match sign with | true -> integerPow 2 ((natFromInteger n) -1)
+                       | false -> integerPow 2 (natFromInteger n)
+       end
+
+let get_min_representable_in _ (n : integer) : integer =
+  if n = 64 then min_64
+  else if n = 32 then min_32
+  else if n = 8 then min_8
+  else if n = 5 then min_5
+  else 0 - (integerPow 2 (natFromInteger n))
+
+val arith_op_bv_int : forall 'a 'b. Bitvector 'a =>
+  (integer -> integer -> integer) -> bool -> 'a -> integer -> 'a
+let arith_op_bv_int op sign l r =
+  let r' = of_int (length l) r in
+  arith_op_bv op sign l r'
+
+val arith_op_int_bv : forall 'a 'b. Bitvector 'a =>
+  (integer -> integer -> integer) -> bool -> integer -> 'a -> 'a
+let arith_op_int_bv op sign l r =
+  let l' = of_int (length r) l in
+  arith_op_bv op sign l' r
+
+let arith_op_bv_bool op sign l r = arith_op_bv_int op sign l (if r then 1 else 0)
+let arith_op_bv_bit op sign l r = Maybe.map (arith_op_bv_bool op sign l) (bool_of_bitU r)
+
+(* TODO (or just omit and define it per spec if needed)
+val arith_op_overflow_bv : forall 'a. Bitvector 'a =>
+  (integer -> integer -> integer) -> bool -> integer -> 'a -> 'a -> (list bitU * bitU * bitU)
+let arith_op_overflow_bv op sign size l r =
+  let len = length l in
+  let act_size = len * size in
+  match (int_of_bv sign l, int_of_bv sign r, int_of_bv false l, int_of_bv false r) with
+    | (Just l_sign, Just r_sign, Just l_unsign, Just r_unsign) ->
+       let n = op l_sign r_sign in
+       let n_unsign = op l_unsign r_unsign in
+       let correct_size = of_int act_size n in
+       let one_more_size_u = bits_of_int (act_size + 1) n_unsign in
+       let overflow =
+         if n <= get_max_representable_in sign len &&
+              n >= get_min_representable_in sign len
+         then B0 else B1 in
+       let c_out = most_significant one_more_size_u in
+       (correct_size,overflow,c_out)
+    | (_, _, _, _) ->
+       (repeat [BU] act_size, BU, BU)
+  end
+
+let add_overflow_bv = arith_op_overflow_bv integerAdd false 1
+let adds_overflow_bv = arith_op_overflow_bv integerAdd true 1
+let sub_overflow_bv = arith_op_overflow_bv integerMinus false 1
+let subs_overflow_bv = arith_op_overflow_bv integerMinus true 1
+let mult_overflow_bv = arith_op_overflow_bv integerMult false 2
+let mults_overflow_bv = arith_op_overflow_bv integerMult true 2
+
+val arith_op_overflow_bv_bit : forall 'a. Bitvector 'a =>
+  (integer -> integer -> integer) -> bool -> integer -> 'a -> bitU -> (list bitU * bitU * bitU)
+let arith_op_overflow_bv_bit op sign size l r_bit =
+  let act_size = length l * size in
+  match (int_of_bv sign l, int_of_bv false l, r_bit = BU) with
+    | (Just l', Just l_u, false) ->
+       let (n, nu, changed) = match r_bit with
+         | B1 -> (op l' 1, op l_u 1, true)
+         | B0 -> (l', l_u, false)
+         | BU -> (* unreachable due to check above *)
+            failwith "arith_op_overflow_bv_bit applied to undefined bit"
+         end in
+       let correct_size = of_int act_size n in
+       let one_larger = bits_of_int (act_size + 1) nu in
+       let overflow =
+         if changed
+         then
+           if n <= get_max_representable_in sign act_size && n >= get_min_representable_in sign act_size
+           then B0 else B1
+         else B0 in
+       (correct_size, overflow, most_significant one_larger)
+    | (_, _, _) ->
+       (repeat [BU] act_size, BU, BU)
+  end
+
+let add_overflow_bv_bit = arith_op_overflow_bv_bit integerAdd false 1
+let adds_overflow_bv_bit = arith_op_overflow_bv_bit integerAdd true 1
+let sub_overflow_bv_bit = arith_op_overflow_bv_bit integerMinus false 1
+let subs_overflow_bv_bit = arith_op_overflow_bv_bit integerMinus true 1*)
+
+type shift = LL_shift | RR_shift | RR_shift_arith | LL_rot | RR_rot
+
+let invert_shift = function
+  | LL_shift -> RR_shift
+  | RR_shift -> LL_shift
+  | RR_shift_arith -> LL_shift
+  | LL_rot -> RR_rot
+  | RR_rot -> LL_rot
+end
+
+val shift_op_bv : forall 'a. Bitvector 'a => shift -> 'a -> integer -> list bitU
+let shift_op_bv op v n =
+  let v = bits_of v in
+  if n = 0 then v else
+  let (op, n) = if n > 0 then (op, n) else (invert_shift op, ~n) in
+  match op with
+  | LL_shift ->
+     subrange_list true v n (length v - 1) ++ repeat [B0] n
+  | RR_shift ->
+     repeat [B0] n ++ subrange_list true v 0 (length v - n - 1)
+  | RR_shift_arith ->
+     repeat [most_significant v] n ++ subrange_list true v 0 (length v - n - 1)
+  | LL_rot ->
+     subrange_list true v n (length v - 1) ++ subrange_list true v 0 (n - 1)
+  | RR_rot ->
+     subrange_list false v 0 (n - 1) ++ subrange_list false v n (length v - 1)
+  end
+
+let shiftl_bv = shift_op_bv LL_shift (*"<<"*)
+let shiftr_bv = shift_op_bv RR_shift (*">>"*)
+let arith_shiftr_bv = shift_op_bv RR_shift_arith
+let rotl_bv = shift_op_bv LL_rot (*"<<<"*)
+let rotr_bv = shift_op_bv LL_rot (*">>>"*)
+
+let shiftl_mword w n = Machine_word.shiftLeft w (nat_of_int n)
+let shiftr_mword w n = Machine_word.shiftRight w (nat_of_int n)
+let arith_shiftr_mword w n = Machine_word.arithShiftRight w (nat_of_int n)
+let rotl_mword w n = Machine_word.rotateLeft (nat_of_int n) w
+let rotr_mword w n = Machine_word.rotateRight (nat_of_int n) w
+
+let rec arith_op_no0 (op : integer -> integer -> integer) l r =
+  if r = 0
+  then Nothing
+  else Just (op l r)
+
+val arith_op_bv_no0 : forall 'a 'b. Bitvector 'a, Bitvector 'b =>
+  (integer -> integer -> integer) -> bool -> integer -> 'a -> 'a -> maybe 'b
+let arith_op_bv_no0 op sign size l r =
+  Maybe.bind (int_of_bv sign l) (fun l' ->
+  Maybe.bind (int_of_bv sign r) (fun r' ->
+  if r' = 0 then Nothing else Just (of_int (length l * size) (op l' r'))))
+
+let mod_bv = arith_op_bv_no0 tmod_int false 1
+let quot_bv = arith_op_bv_no0 tdiv_int false 1
+let quots_bv = arith_op_bv_no0 tdiv_int true 1
+
+let mod_mword = Machine_word.modulo
+let quot_mword = Machine_word.unsignedDivide
+let quots_mword = Machine_word.signedDivide
+
+let arith_op_bv_int_no0 op sign size l r =
+  arith_op_bv_no0 op sign size l (of_int (length l) r)
+
+let quot_bv_int = arith_op_bv_int_no0 tdiv_int false 1
+let mod_bv_int = arith_op_bv_int_no0 tmod_int false 1
+
+let mod_mword_int l r = Machine_word.modulo l (wordFromInteger r)
+let quot_mword_int l r = Machine_word.unsignedDivide l (wordFromInteger r)
+let quots_mword_int l r = Machine_word.signedDivide l (wordFromInteger r)
+
+let replicate_bits_bv v count = repeat (bits_of v) count
+let duplicate_bit_bv bit len = replicate_bits_bv [bit] len
+
+val eq_bv : forall 'a. Bitvector 'a => 'a -> 'a -> bool
+let eq_bv l r = (bits_of l = bits_of r)
+
+let inline eq_mword l r = (l = r)
+
+val neq_bv : forall 'a. Bitvector 'a => 'a -> 'a -> bool
+let neq_bv l r = not (eq_bv l r)
+
+let inline neq_mword l r = (l <> r)
+
+val get_slice_int_bv : forall 'a. Bitvector 'a => integer -> integer -> integer -> 'a
+let get_slice_int_bv len n lo =
+  let hi = lo + len - 1 in
+  let bs = bools_of_int (hi + 1) n in
+  of_bools (subrange_list false bs hi lo)
+
+val set_slice_int_bv : forall 'a. Bitvector 'a => integer -> integer -> integer -> 'a -> integer
+let set_slice_int_bv len n lo v =
+  let hi = lo + len - 1 in
+  let bs = bits_of_int (hi + 1) n in
+  maybe_failwith (signed_of_bits (update_subrange_list false bs hi lo (bits_of v)))
diff --git a/src/gen_lib/0.11/sail2_operators_bitlists.lem b/src/gen_lib/0.11/sail2_operators_bitlists.lem
new file mode 100644
index 00000000..c9892e4c
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_operators_bitlists.lem
@@ -0,0 +1,308 @@
+open import Pervasives_extra
+open import Machine_word
+open import Sail2_values
+open import Sail2_operators
+open import Sail2_prompt_monad
+open import Sail2_prompt
+
+(* Specialisation of operators to bit lists *)
+
+val uint_maybe : list bitU -> maybe integer
+let uint_maybe v = unsigned v
+let uint_fail v = maybe_fail "uint" (unsigned v)
+let uint_nondet v =
+  bools_of_bits_nondet v >>= (fun bs ->
+  return (int_of_bools false bs))
+let uint v = maybe_failwith (uint_maybe v)
+
+val sint_maybe : list bitU -> maybe integer
+let sint_maybe v = signed v
+let sint_fail v = maybe_fail "sint" (signed v)
+let sint_nondet v =
+  bools_of_bits_nondet v >>= (fun bs ->
+  return (int_of_bools true bs))
+let sint v = maybe_failwith (sint_maybe v)
+
+val extz_vec : integer -> list bitU -> list bitU
+let extz_vec = extz_bv
+
+val exts_vec : integer -> list bitU -> list bitU
+let exts_vec = exts_bv
+
+val zero_extend : list bitU -> integer -> list bitU
+let zero_extend bits len = extz_bits len bits
+
+val sign_extend : list bitU -> integer -> list bitU
+let sign_extend bits len = exts_bits len bits
+
+val zeros : integer -> list bitU
+let zeros len = repeat [B0] len
+
+val vector_truncate : list bitU -> integer -> list bitU
+let vector_truncate bs len = extz_bv len bs
+
+val vector_truncateLSB : list bitU -> integer -> list bitU
+let vector_truncateLSB bs len = take_list len bs
+
+val vec_of_bits_maybe    : list bitU -> maybe (list bitU)
+val vec_of_bits_fail     : forall 'rv 'e. list bitU -> monad 'rv (list bitU) 'e
+val vec_of_bits_nondet   : forall 'rv 'e. list bitU -> monad 'rv (list bitU) 'e
+val vec_of_bits_failwith : list bitU -> list bitU
+val vec_of_bits          : list bitU -> list bitU
+let inline vec_of_bits bits = bits
+let inline vec_of_bits_maybe bits = Just bits
+let inline vec_of_bits_fail bits = return bits
+let inline vec_of_bits_nondet bits = return bits
+let inline vec_of_bits_failwith bits = bits
+
+val access_vec_inc : list bitU -> integer -> bitU
+let access_vec_inc = access_bv_inc
+
+val access_vec_dec : list bitU -> integer -> bitU
+let access_vec_dec = access_bv_dec
+
+val update_vec_inc : list bitU -> integer -> bitU -> list bitU
+let update_vec_inc = update_bv_inc
+let update_vec_inc_maybe v i b = Just (update_vec_inc v i b)
+let update_vec_inc_fail v i b = return (update_vec_inc v i b)
+let update_vec_inc_nondet v i b = return (update_vec_inc v i b)
+
+val update_vec_dec : list bitU -> integer -> bitU -> list bitU
+let update_vec_dec = update_bv_dec
+let update_vec_dec_maybe v i b = Just (update_vec_dec v i b)
+let update_vec_dec_fail v i b = return (update_vec_dec v i b)
+let update_vec_dec_nondet v i b = return (update_vec_dec v i b)
+
+val subrange_vec_inc : list bitU -> integer -> integer -> list bitU
+let subrange_vec_inc = subrange_bv_inc
+
+val subrange_vec_dec : list bitU -> integer -> integer -> list bitU
+let subrange_vec_dec = subrange_bv_dec
+
+val update_subrange_vec_inc : list bitU -> integer -> integer -> list bitU -> list bitU
+let update_subrange_vec_inc = update_subrange_bv_inc
+
+val update_subrange_vec_dec : list bitU -> integer -> integer -> list bitU -> list bitU
+let update_subrange_vec_dec = update_subrange_bv_dec
+
+val concat_vec : list bitU -> list bitU -> list bitU
+let concat_vec = concat_bv
+
+val cons_vec : bitU -> list bitU -> list bitU
+let cons_vec = cons_bv
+let cons_vec_maybe b v = Just (cons_vec b v)
+let cons_vec_fail b v = return (cons_vec b v)
+let cons_vec_nondet b v = return (cons_vec b v)
+
+val cast_unit_vec : bitU -> list bitU
+let cast_unit_vec = cast_unit_bv
+let cast_unit_vec_maybe b = Just (cast_unit_vec b)
+let cast_unit_vec_fail b = return (cast_unit_vec b)
+let cast_unit_vec_nondet b = return (cast_unit_vec b)
+
+val vec_of_bit : integer -> bitU -> list bitU
+let vec_of_bit = bv_of_bit
+let vec_of_bit_maybe len b = Just (vec_of_bit len b)
+let vec_of_bit_fail len b = return (vec_of_bit len b)
+let vec_of_bit_nondet len b = return (vec_of_bit len b)
+
+val msb : list bitU -> bitU
+let msb = most_significant
+
+val int_of_vec_maybe : bool -> list bitU -> maybe integer
+let int_of_vec_maybe = int_of_bv
+let int_of_vec_fail sign v = maybe_fail "int_of_vec" (int_of_vec_maybe sign v)
+let int_of_vec_nondet sign v = bools_of_bits_nondet v >>= (fun v -> return (int_of_bools sign v))
+let int_of_vec sign v = maybe_failwith (int_of_vec_maybe sign v)
+
+val string_of_bits : list bitU -> string
+let string_of_bits = string_of_bv
+
+val decimal_string_of_bits : list bitU -> string
+let decimal_string_of_bits = decimal_string_of_bv
+
+val and_vec : list bitU -> list bitU -> list bitU
+val or_vec  : list bitU -> list bitU -> list bitU
+val xor_vec : list bitU -> list bitU -> list bitU
+val not_vec : list bitU -> list bitU
+let and_vec = binop_list and_bit
+let or_vec  = binop_list or_bit
+let xor_vec = binop_list xor_bit
+let not_vec = List.map not_bit
+
+val arith_op_double_bl : forall 'a 'b. Bitvector 'a =>
+  (integer -> integer -> integer) -> bool -> 'a -> 'a -> list bitU
+let arith_op_double_bl op sign l r =
+  let len = 2 * length l in
+  let l' = if sign then exts_bv len l else extz_bv len l in
+  let r' = if sign then exts_bv len r else extz_bv len r in
+  arith_op_bv op sign l' r'
+
+val add_vec   : list bitU -> list bitU -> list bitU
+val adds_vec  : list bitU -> list bitU -> list bitU
+val sub_vec   : list bitU -> list bitU -> list bitU
+val subs_vec  : list bitU -> list bitU -> list bitU
+val mult_vec  : list bitU -> list bitU -> list bitU
+val mults_vec : list bitU -> list bitU -> list bitU
+let add_vec   = arith_op_bv integerAdd false
+let adds_vec  = arith_op_bv integerAdd true
+let sub_vec   = arith_op_bv integerMinus false
+let subs_vec  = arith_op_bv integerMinus true
+let mult_vec  = arith_op_double_bl integerMult false
+let mults_vec = arith_op_double_bl integerMult true
+
+val add_vec_int       : list bitU -> integer -> list bitU
+val sub_vec_int       : list bitU -> integer -> list bitU
+val mult_vec_int      : list bitU -> integer -> list bitU
+let add_vec_int   l r = arith_op_bv_int integerAdd false l r
+let sub_vec_int   l r = arith_op_bv_int integerMinus false l r
+let mult_vec_int  l r = arith_op_double_bl integerMult false l (of_int (length l) r)
+
+val add_int_vec       : integer -> list bitU -> list bitU
+val sub_int_vec       : integer -> list bitU -> list bitU
+val mult_int_vec      : integer -> list bitU -> list bitU
+let add_int_vec   l r = arith_op_int_bv integerAdd false l r
+let sub_int_vec   l r = arith_op_int_bv integerMinus false l r
+let mult_int_vec  l r = arith_op_double_bl integerMult false (of_int (length r) l) r
+
+val add_vec_bit      : list bitU -> bitU -> list bitU
+val adds_vec_bit     : list bitU -> bitU -> list bitU
+val sub_vec_bit      : list bitU -> bitU -> list bitU
+val subs_vec_bit     : list bitU -> bitU -> list bitU
+
+let add_vec_bool       l r = arith_op_bv_bool integerAdd false l r
+let add_vec_bit_maybe  l r = arith_op_bv_bit integerAdd false l r
+let add_vec_bit_fail   l r = maybe_fail "add_vec_bit" (add_vec_bit_maybe l r)
+let add_vec_bit_nondet l r = bool_of_bitU_nondet r >>= (fun r -> return (add_vec_bool l r))
+let add_vec_bit        l r = fromMaybe (repeat [BU] (length l)) (add_vec_bit_maybe l r)
+
+let adds_vec_bool       l r = arith_op_bv_bool integerAdd true l r
+let adds_vec_bit_maybe  l r = arith_op_bv_bit integerAdd true l r
+let adds_vec_bit_fail   l r = maybe_fail "adds_vec_bit" (adds_vec_bit_maybe l r)
+let adds_vec_bit_nondet l r = bool_of_bitU_nondet r >>= (fun r -> return (adds_vec_bool l r))
+let adds_vec_bit        l r = fromMaybe (repeat [BU] (length l)) (adds_vec_bit_maybe l r)
+
+let sub_vec_bool        l r = arith_op_bv_bool integerMinus false l r
+let sub_vec_bit_maybe   l r = arith_op_bv_bit integerMinus false l r
+let sub_vec_bit_fail    l r = maybe_fail "sub_vec_bit" (sub_vec_bit_maybe l r)
+let sub_vec_bit_nondet  l r = bool_of_bitU_nondet r >>= (fun r -> return (sub_vec_bool l r))
+let sub_vec_bit         l r = fromMaybe (repeat [BU] (length l)) (sub_vec_bit_maybe l r)
+
+let subs_vec_bool       l r = arith_op_bv_bool integerMinus true l r
+let subs_vec_bit_maybe  l r = arith_op_bv_bit integerMinus true l r
+let subs_vec_bit_fail   l r = maybe_fail "sub_vec_bit" (subs_vec_bit_maybe l r)
+let subs_vec_bit_nondet l r = bool_of_bitU_nondet r >>= (fun r -> return (subs_vec_bool l r))
+let subs_vec_bit        l r = fromMaybe (repeat [BU] (length l)) (subs_vec_bit_maybe l r)
+
+(*val add_overflow_vec         : list bitU -> list bitU -> (list bitU * bitU * bitU)
+val add_overflow_vec_signed  : list bitU -> list bitU -> (list bitU * bitU * bitU)
+val sub_overflow_vec         : list bitU -> list bitU -> (list bitU * bitU * bitU)
+val sub_overflow_vec_signed  : list bitU -> list bitU -> (list bitU * bitU * bitU)
+val mult_overflow_vec        : list bitU -> list bitU -> (list bitU * bitU * bitU)
+val mult_overflow_vec_signed : list bitU -> list bitU -> (list bitU * bitU * bitU)
+let add_overflow_vec         = add_overflow_bv
+let add_overflow_vec_signed  = add_overflow_bv_signed
+let sub_overflow_vec         = sub_overflow_bv
+let sub_overflow_vec_signed  = sub_overflow_bv_signed
+let mult_overflow_vec        = mult_overflow_bv
+let mult_overflow_vec_signed = mult_overflow_bv_signed
+
+val add_overflow_vec_bit         : list bitU -> bitU -> (list bitU * bitU * bitU)
+val add_overflow_vec_bit_signed  : list bitU -> bitU -> (list bitU * bitU * bitU)
+val sub_overflow_vec_bit         : list bitU -> bitU -> (list bitU * bitU * bitU)
+val sub_overflow_vec_bit_signed  : list bitU -> bitU -> (list bitU * bitU * bitU)
+let add_overflow_vec_bit         = add_overflow_bv_bit
+let add_overflow_vec_bit_signed  = add_overflow_bv_bit_signed
+let sub_overflow_vec_bit         = sub_overflow_bv_bit
+let sub_overflow_vec_bit_signed  = sub_overflow_bv_bit_signed*)
+
+val shiftl       : list bitU -> integer -> list bitU
+val shiftr       : list bitU -> integer -> list bitU
+val arith_shiftr : list bitU -> integer -> list bitU
+val rotl         : list bitU -> integer -> list bitU
+val rotr         : list bitU -> integer -> list bitU
+let shiftl       = shiftl_bv
+let shiftr       = shiftr_bv
+let arith_shiftr = arith_shiftr_bv
+let rotl         = rotl_bv
+let rotr         = rotr_bv
+
+val mod_vec        : list bitU -> list bitU -> list bitU
+val mod_vec_maybe  : list bitU -> list bitU -> maybe (list bitU)
+val mod_vec_fail   : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e
+val mod_vec_nondet : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e
+let mod_vec        l r = fromMaybe (repeat [BU] (length l)) (mod_bv l r)
+let mod_vec_maybe  l r = mod_bv l r
+let mod_vec_fail   l r = maybe_fail "mod_vec" (mod_bv l r)
+let mod_vec_nondet l r = of_bits_nondet (mod_vec l r)
+
+val quot_vec        : list bitU -> list bitU -> list bitU
+val quot_vec_maybe  : list bitU -> list bitU -> maybe (list bitU)
+val quot_vec_fail   : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e
+val quot_vec_nondet : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e
+let quot_vec        l r = fromMaybe (repeat [BU] (length l)) (quot_bv l r)
+let quot_vec_maybe  l r = quot_bv l r
+let quot_vec_fail   l r = maybe_fail "quot_vec" (quot_bv l r)
+let quot_vec_nondet l r = of_bits_nondet (quot_vec l r)
+
+val quots_vec        : list bitU -> list bitU -> list bitU
+val quots_vec_maybe  : list bitU -> list bitU -> maybe (list bitU)
+val quots_vec_fail   : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e
+val quots_vec_nondet : forall 'rv 'e. list bitU -> list bitU -> monad 'rv (list bitU) 'e
+let quots_vec        l r = fromMaybe (repeat [BU] (length l)) (quots_bv l r)
+let quots_vec_maybe  l r = quots_bv l r
+let quots_vec_fail   l r = maybe_fail "quots_vec" (quots_bv l r)
+let quots_vec_nondet l r = of_bits_nondet (quots_vec l r)
+
+val mod_vec_int        : list bitU -> integer -> list bitU
+val mod_vec_int_maybe  : list bitU -> integer -> maybe (list bitU)
+val mod_vec_int_fail   : forall 'rv 'e. list bitU -> integer -> monad 'rv (list bitU) 'e
+val mod_vec_int_nondet : forall 'rv 'e. list bitU -> integer -> monad 'rv (list bitU) 'e
+let mod_vec_int        l r = fromMaybe (repeat [BU] (length l)) (mod_bv_int l r)
+let mod_vec_int_maybe  l r = mod_bv_int l r
+let mod_vec_int_fail   l r = maybe_fail "mod_vec_int" (mod_bv_int l r)
+let mod_vec_int_nondet l r = of_bits_nondet (mod_vec_int l r)
+
+val quot_vec_int        : list bitU -> integer -> list bitU
+val quot_vec_int_maybe  : list bitU -> integer -> maybe (list bitU)
+val quot_vec_int_fail   : forall 'rv 'e. list bitU -> integer -> monad 'rv (list bitU) 'e
+val quot_vec_int_nondet : forall 'rv 'e. list bitU -> integer -> monad 'rv (list bitU) 'e
+let quot_vec_int        l r = fromMaybe (repeat [BU] (length l)) (quot_bv_int l r)
+let quot_vec_int_maybe  l r = quot_bv_int l r
+let quot_vec_int_fail   l r = maybe_fail "quot_vec_int" (quot_bv_int l r)
+let quot_vec_int_nondet l r = of_bits_nondet (quot_vec_int l r)
+
+val replicate_bits : list bitU -> integer -> list bitU
+let replicate_bits = replicate_bits_bv
+
+val duplicate : bitU -> integer -> list bitU
+let duplicate = duplicate_bit_bv
+let duplicate_maybe b n = Just (duplicate b n)
+let duplicate_fail b n = return (duplicate b n)
+let duplicate_nondet b n =
+  bool_of_bitU_nondet b >>= (fun b ->
+  return (duplicate (bitU_of_bool b) n))
+
+val reverse_endianness : list bitU -> list bitU
+let reverse_endianness v = reverse_endianness_list v
+
+val get_slice_int : integer -> integer -> integer -> list bitU
+let get_slice_int = get_slice_int_bv
+
+val set_slice_int : integer -> integer -> integer -> list bitU -> integer
+let set_slice_int = set_slice_int_bv
+
+val slice : list bitU -> integer -> integer -> list bitU
+let slice v lo len =
+  subrange_vec_dec v (lo + len - 1) lo
+
+val set_slice : integer -> integer -> list bitU -> integer -> list bitU -> list bitU
+let set_slice (out_len:ii) (slice_len:ii) out (n:ii) v =
+  update_subrange_vec_dec out (n + slice_len - 1) n v
+
+val eq_vec    : list bitU -> list bitU -> bool
+val neq_vec   : list bitU -> list bitU -> bool
+let eq_vec    = eq_bv
+let neq_vec   = neq_bv
+
+let inline count_leading_zeros v = count_leading_zero_bits v
diff --git a/src/gen_lib/0.11/sail2_operators_mwords.lem b/src/gen_lib/0.11/sail2_operators_mwords.lem
new file mode 100644
index 00000000..c8524e16
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_operators_mwords.lem
@@ -0,0 +1,334 @@
+open import Pervasives_extra
+open import Machine_word
+open import Sail2_values
+open import Sail2_operators
+open import Sail2_prompt_monad
+open import Sail2_prompt
+
+(* Specialisation of operators to machine words *)
+
+let inline uint v = unsignedIntegerFromWord v
+let uint_maybe v = Just (uint v)
+let uint_fail v = return (uint v)
+let uint_nondet v = return (uint v)
+
+let inline sint v = signedIntegerFromWord v
+let sint_maybe v = Just (sint v)
+let sint_fail v = return (sint v)
+let sint_nondet v = return (sint v)
+
+val vec_of_bits_maybe    : forall 'a. Size 'a => list bitU -> maybe (mword 'a)
+val vec_of_bits_fail     : forall 'rv 'a 'e. Size 'a => list bitU -> monad 'rv (mword 'a) 'e
+val vec_of_bits_nondet   : forall 'rv 'a 'e. Size 'a => list bitU -> monad 'rv (mword 'a) 'e
+val vec_of_bits_failwith : forall 'a. Size 'a => list bitU -> mword 'a
+val vec_of_bits          : forall 'a. Size 'a => list bitU -> mword 'a
+let vec_of_bits_maybe bits = of_bits bits
+let vec_of_bits_fail bits = of_bits_fail bits
+let vec_of_bits_nondet bits = of_bits_nondet bits
+let vec_of_bits_failwith bits = of_bits_failwith bits
+let vec_of_bits bits = of_bits_failwith bits
+
+val access_vec_inc : forall 'a. Size 'a => mword 'a -> integer -> bitU
+let access_vec_inc = access_bv_inc
+
+val access_vec_dec : forall 'a. Size 'a => mword 'a -> integer -> bitU
+let access_vec_dec = access_bv_dec
+
+let update_vec_dec_maybe w i b = update_mword_dec w i b
+let update_vec_dec_fail w i b =
+  bool_of_bitU_fail b >>= (fun b ->
+  return (update_mword_bool_dec w i b))
+let update_vec_dec_nondet w i b =
+  bool_of_bitU_nondet b >>= (fun b ->
+  return (update_mword_bool_dec w i b))
+let update_vec_dec w i b = maybe_failwith (update_vec_dec_maybe w i b)
+
+let update_vec_inc_maybe w i b = update_mword_inc w i b
+let update_vec_inc_fail w i b =
+  bool_of_bitU_fail b >>= (fun b ->
+  return (update_mword_bool_inc w i b))
+let update_vec_inc_nondet w i b =
+  bool_of_bitU_nondet b >>= (fun b ->
+  return (update_mword_bool_inc w i b))
+let update_vec_inc w i b = maybe_failwith (update_vec_inc_maybe w i b)
+
+val subrange_vec_dec : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> integer -> mword 'b
+let subrange_vec_dec w i j = Machine_word.word_extract (nat_of_int j) (nat_of_int i) w
+
+val subrange_vec_inc : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> integer -> mword 'b
+let subrange_vec_inc w i j = subrange_vec_dec w (length w - 1 - i) (length w - 1 - j)
+
+val update_subrange_vec_dec : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> integer -> mword 'b -> mword 'a
+let update_subrange_vec_dec w i j w' = Machine_word.word_update w (nat_of_int j) (nat_of_int i) w'
+
+val update_subrange_vec_inc : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> integer -> mword 'b -> mword 'a
+let update_subrange_vec_inc w i j w' = update_subrange_vec_dec w (length w - 1 - i) (length w - 1 - j) w'
+
+val extz_vec : forall 'a 'b. Size 'a, Size 'b => integer -> mword 'a -> mword 'b
+let extz_vec _ w = Machine_word.zeroExtend w
+
+val exts_vec : forall 'a 'b. Size 'a, Size 'b => integer -> mword 'a -> mword 'b
+let exts_vec _ w = Machine_word.signExtend w
+
+val zero_extend : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b
+let zero_extend w _ = Machine_word.zeroExtend w
+
+val sign_extend : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b
+let sign_extend w _ = Machine_word.signExtend w
+
+val zeros : forall 'a. Size 'a => integer -> mword 'a
+let zeros _ = Machine_word.wordFromNatural 0
+
+val vector_truncate : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b
+let vector_truncate w _ = Machine_word.zeroExtend w
+
+val vector_truncateLSB : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b
+let vector_truncateLSB w len =
+  let len = nat_of_int len in
+  let lo = Machine_word.word_length w - len in
+  let hi = lo + len - 1 in
+  Machine_word.word_extract lo hi w
+
+val concat_vec : forall 'a 'b 'c. Size 'a, Size 'b, Size 'c => mword 'a -> mword 'b -> mword 'c
+let concat_vec = Machine_word.word_concat
+
+val cons_vec_bool : forall 'a 'b 'c. Size 'a, Size 'b => bool -> mword 'a -> mword 'b
+let cons_vec_bool b w = wordFromBitlist (b :: bitlistFromWord w)
+let cons_vec_maybe b w = Maybe.map (fun b -> cons_vec_bool b w) (bool_of_bitU b)
+let cons_vec_fail b w = bool_of_bitU_fail b >>= (fun b -> return (cons_vec_bool b w))
+let cons_vec_nondet b w = bool_of_bitU_nondet b >>= (fun b -> return (cons_vec_bool b w))
+let cons_vec b w = maybe_failwith (cons_vec_maybe b w)
+
+val vec_of_bool : forall 'a. Size 'a => integer -> bool -> mword 'a
+let vec_of_bool _ b = wordFromBitlist [b]
+let vec_of_bit_maybe len b = Maybe.map (vec_of_bool len) (bool_of_bitU b)
+let vec_of_bit_fail len b = bool_of_bitU_fail b >>= (fun b -> return (vec_of_bool len b))
+let vec_of_bit_nondet len b = bool_of_bitU_nondet b >>= (fun b -> return (vec_of_bool len b))
+let vec_of_bit len b = maybe_failwith (vec_of_bit_maybe len b)
+
+val cast_bool_vec : bool -> mword ty1
+let cast_bool_vec b = vec_of_bool 1 b
+let cast_unit_vec_maybe b = vec_of_bit_maybe 1 b
+let cast_unit_vec_fail b = bool_of_bitU_fail b >>= (fun b -> return (cast_bool_vec b))
+let cast_unit_vec_nondet b = bool_of_bitU_nondet b >>= (fun b -> return (cast_bool_vec b))
+let cast_unit_vec b = maybe_failwith (cast_unit_vec_maybe b)
+
+val msb : forall 'a. Size 'a => mword 'a -> bitU
+let msb = most_significant
+
+val int_of_vec : forall 'a. Size 'a => bool -> mword 'a -> integer
+let int_of_vec sign w =
+  if sign
+  then signedIntegerFromWord w
+  else unsignedIntegerFromWord w
+let int_of_vec_maybe sign w = Just (int_of_vec sign w)
+let int_of_vec_fail sign w = return (int_of_vec sign w)
+
+val string_of_bits : forall 'a. Size 'a => mword 'a -> string
+let string_of_bits = string_of_bv
+
+val decimal_string_of_bits : forall 'a. Size 'a => mword 'a -> string
+let decimal_string_of_bits = decimal_string_of_bv
+
+val and_vec : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a
+val or_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a
+val xor_vec : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a
+val not_vec : forall 'a. Size 'a => mword 'a -> mword 'a
+let and_vec = Machine_word.lAnd
+let or_vec  = Machine_word.lOr
+let xor_vec = Machine_word.lXor
+let not_vec = Machine_word.lNot
+
+val add_vec   : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a
+val adds_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a
+val sub_vec   : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a
+val subs_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a
+val mult_vec  : forall 'a 'b. Size 'a, Size 'b => mword 'a -> mword 'a -> mword 'b
+val mults_vec : forall 'a 'b. Size 'a, Size 'b => mword 'a -> mword 'a -> mword 'b
+let add_vec   l r = arith_op_bv integerAdd   false l r
+let adds_vec  l r = arith_op_bv integerAdd   true  l r
+let sub_vec   l r = arith_op_bv integerMinus false l r
+let subs_vec  l r = arith_op_bv integerMinus true  l r
+let mult_vec  l r = arith_op_bv integerMult  false (zeroExtend l : mword 'b) (zeroExtend r : mword 'b)
+let mults_vec l r = arith_op_bv integerMult  true  (signExtend l : mword 'b) (signExtend r : mword 'b)
+
+val add_vec_int   : forall 'a. Size 'a => mword 'a -> integer -> mword 'a
+val sub_vec_int   : forall 'a. Size 'a => mword 'a -> integer -> mword 'a
+val mult_vec_int  : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b
+let add_vec_int   l r = arith_op_bv_int integerAdd   false l r
+let sub_vec_int   l r = arith_op_bv_int integerMinus false l r
+let mult_vec_int  l r = arith_op_bv_int integerMult  false (zeroExtend l : mword 'b) r
+
+val add_int_vec   : forall 'a. Size 'a => integer -> mword 'a -> mword 'a
+val sub_int_vec   : forall 'a. Size 'a => integer -> mword 'a -> mword 'a
+val mult_int_vec  : forall 'a 'b. Size 'a, Size 'b => integer -> mword 'a -> mword 'b
+let add_int_vec   l r = arith_op_int_bv integerAdd   false l r
+let sub_int_vec   l r = arith_op_int_bv integerMinus false l r
+let mult_int_vec  l r = arith_op_int_bv integerMult  false l (zeroExtend r : mword 'b)
+
+val add_vec_bool  : forall 'a. Size 'a => mword 'a -> bool -> mword 'a
+val adds_vec_bool : forall 'a. Size 'a => mword 'a -> bool -> mword 'a
+val sub_vec_bool  : forall 'a. Size 'a => mword 'a -> bool -> mword 'a
+val subs_vec_bool : forall 'a. Size 'a => mword 'a -> bool -> mword 'a
+
+let add_vec_bool        l r = arith_op_bv_bool integerAdd false l r
+let add_vec_bit_maybe   l r = Maybe.map (add_vec_bool l) (bool_of_bitU r)
+let add_vec_bit_fail    l r = bool_of_bitU_fail r >>= (fun r -> return (add_vec_bool l r))
+let add_vec_bit_nondet  l r = bool_of_bitU_nondet r >>= (fun r -> return (add_vec_bool l r))
+let add_vec_bit         l r = maybe_failwith (add_vec_bit_maybe  l r)
+
+let adds_vec_bool       l r = arith_op_bv_bool integerAdd true  l r
+let adds_vec_bit_maybe  l r = Maybe.map (adds_vec_bool l) (bool_of_bitU r)
+let adds_vec_bit_fail   l r = bool_of_bitU_fail r >>= (fun r -> return (adds_vec_bool l r))
+let adds_vec_bit_nondet l r = bool_of_bitU_nondet r >>= (fun r -> return (adds_vec_bool l r))
+let adds_vec_bit        l r = maybe_failwith (adds_vec_bit_maybe l r)
+
+let sub_vec_bool        l r = arith_op_bv_bool integerMinus false l r
+let sub_vec_bit_maybe   l r = Maybe.map (sub_vec_bool l) (bool_of_bitU r)
+let sub_vec_bit_fail    l r = bool_of_bitU_fail r >>= (fun r -> return (sub_vec_bool l r))
+let sub_vec_bit_nondet  l r = bool_of_bitU_nondet r >>= (fun r -> return (sub_vec_bool l r))
+let sub_vec_bit         l r = maybe_failwith (sub_vec_bit_maybe  l r)
+
+let subs_vec_bool       l r = arith_op_bv_bool integerMinus true  l r
+let subs_vec_bit_maybe  l r = Maybe.map (subs_vec_bool l) (bool_of_bitU r)
+let subs_vec_bit_fail   l r = bool_of_bitU_fail r >>= (fun r -> return (subs_vec_bool l r))
+let subs_vec_bit_nondet l r = bool_of_bitU_nondet r >>= (fun r -> return (subs_vec_bool l r))
+let subs_vec_bit        l r = maybe_failwith (subs_vec_bit_maybe  l r)
+
+(* TODO
+val maybe_mword_of_bits_overflow : forall 'a. Size 'a => (list bitU * bitU * bitU) -> maybe (mword 'a * bitU * bitU)
+let maybe_mword_of_bits_overflow (bits, overflow, carry) =
+  Maybe.map (fun w -> (w, overflow, carry)) (of_bits bits)
+
+val add_overflow_vec   : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+val adds_overflow_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+val sub_overflow_vec   : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+val subs_overflow_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+val mult_overflow_vec  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+val mults_overflow_vec : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a * bitU * bitU)
+let add_overflow_vec   l r = maybe_mword_of_bits_overflow (add_overflow_bv l r)
+let adds_overflow_vec  l r = maybe_mword_of_bits_overflow (adds_overflow_bv l r)
+let sub_overflow_vec   l r = maybe_mword_of_bits_overflow (sub_overflow_bv l r)
+let subs_overflow_vec  l r = maybe_mword_of_bits_overflow (subs_overflow_bv l r)
+let mult_overflow_vec  l r = maybe_mword_of_bits_overflow (mult_overflow_bv l r)
+let mults_overflow_vec l r = maybe_mword_of_bits_overflow (mults_overflow_bv l r)
+
+val add_overflow_vec_bit         : forall 'a. Size 'a => mword 'a -> bitU -> (mword 'a * bitU * bitU)
+val add_overflow_vec_bit_signed  : forall 'a. Size 'a => mword 'a -> bitU -> (mword 'a * bitU * bitU)
+val sub_overflow_vec_bit         : forall 'a. Size 'a => mword 'a -> bitU -> (mword 'a * bitU * bitU)
+val sub_overflow_vec_bit_signed  : forall 'a. Size 'a => mword 'a -> bitU -> (mword 'a * bitU * bitU)
+let add_overflow_vec_bit         = add_overflow_bv_bit
+let add_overflow_vec_bit_signed  = add_overflow_bv_bit_signed
+let sub_overflow_vec_bit         = sub_overflow_bv_bit
+let sub_overflow_vec_bit_signed  = sub_overflow_bv_bit_signed*)
+
+val shiftl       : forall 'a. Size 'a => mword 'a -> integer -> mword 'a
+val shiftr       : forall 'a. Size 'a => mword 'a -> integer -> mword 'a
+val arith_shiftr : forall 'a. Size 'a => mword 'a -> integer -> mword 'a
+val rotl         : forall 'a. Size 'a => mword 'a -> integer -> mword 'a
+val rotr         : forall 'a. Size 'a => mword 'a -> integer -> mword 'a
+let shiftl       = shiftl_mword
+let shiftr       = shiftr_mword
+let arith_shiftr = arith_shiftr_mword
+let rotl         = rotl_mword
+let rotr         = rotr_mword
+
+val mod_vec        : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a
+val mod_vec_maybe  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a)
+val mod_vec_fail   : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e
+val mod_vec_nondet : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e
+let mod_vec        l r = mod_mword l r
+let mod_vec_maybe  l r = mod_bv l r
+let mod_vec_fail   l r = maybe_fail "mod_vec" (mod_bv l r)
+let mod_vec_nondet l r =
+  match (mod_bv l r) with
+    | Just w -> return w
+    | Nothing -> mword_nondet ()
+  end
+
+val quot_vec        : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a
+val quot_vec_maybe  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a)
+val quot_vec_fail   : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e
+val quot_vec_nondet : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e
+let quot_vec        l r = quot_mword l r
+let quot_vec_maybe  l r = quot_bv l r
+let quot_vec_fail   l r = maybe_fail "quot_vec" (quot_bv l r)
+let quot_vec_nondet l r =
+  match (quot_bv l r) with
+    | Just w -> return w
+    | Nothing -> mword_nondet ()
+  end
+
+val quots_vec        : forall 'a. Size 'a => mword 'a -> mword 'a -> mword 'a
+val quots_vec_maybe  : forall 'a. Size 'a => mword 'a -> mword 'a -> maybe (mword 'a)
+val quots_vec_fail   : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e
+val quots_vec_nondet : forall 'rv 'a 'e. Size 'a => mword 'a -> mword 'a -> monad 'rv (mword 'a) 'e
+let quots_vec        l r = quots_mword l r
+let quots_vec_maybe  l r = quots_bv l r
+let quots_vec_fail   l r = maybe_fail "quots_vec" (quots_bv l r)
+let quots_vec_nondet l r =
+  match (quots_bv l r) with
+    | Just w -> return w
+    | Nothing -> mword_nondet ()
+  end
+
+val mod_vec_int        : forall 'a. Size 'a => mword 'a -> integer -> mword 'a
+val mod_vec_int_maybe  : forall 'a. Size 'a => mword 'a -> integer -> maybe (mword 'a)
+val mod_vec_int_fail   : forall 'rv 'a 'e. Size 'a => mword 'a -> integer -> monad 'rv (mword 'a) 'e
+val mod_vec_int_nondet : forall 'rv 'a 'e. Size 'a => mword 'a -> integer -> monad 'rv (mword 'a) 'e
+let mod_vec_int        l r = mod_mword_int l r
+let mod_vec_int_maybe  l r = mod_bv_int l r
+let mod_vec_int_fail   l r = maybe_fail "mod_vec_int" (mod_bv_int l r)
+let mod_vec_int_nondet l r =
+  match (mod_bv_int l r) with
+    | Just w -> return w
+    | Nothing -> mword_nondet ()
+  end
+
+val quot_vec_int        : forall 'a. Size 'a => mword 'a -> integer -> mword 'a
+val quot_vec_int_maybe  : forall 'a. Size 'a => mword 'a -> integer -> maybe (mword 'a)
+val quot_vec_int_fail   : forall 'rv 'a 'e. Size 'a => mword 'a -> integer -> monad 'rv (mword 'a) 'e
+val quot_vec_int_nondet : forall 'rv 'a 'e. Size 'a => mword 'a -> integer -> monad 'rv (mword 'a) 'e
+let quot_vec_int        l r = quot_mword_int l r
+let quot_vec_int_maybe  l r = quot_bv_int l r
+let quot_vec_int_fail   l r = maybe_fail "quot_vec_int" (quot_bv_int l r)
+let quot_vec_int_nondet l r =
+  match (quot_bv_int l r) with
+    | Just w -> return w
+    | Nothing -> mword_nondet ()
+  end
+
+val replicate_bits : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> mword 'b
+let replicate_bits v count = wordFromBitlist (repeat (bitlistFromWord v) count)
+
+val duplicate_bool : forall 'a. Size 'a => bool -> integer -> mword 'a
+let duplicate_bool   b n = wordFromBitlist (repeat [b] n)
+let duplicate_maybe  b n = Maybe.map (fun b -> duplicate_bool b n) (bool_of_bitU b)
+let duplicate_fail   b n = bool_of_bitU_fail b >>= (fun b -> return (duplicate_bool b n))
+let duplicate_nondet b n = bool_of_bitU_nondet b >>= (fun b -> return (duplicate_bool b n))
+let duplicate        b n = maybe_failwith (duplicate_maybe b n)
+
+val reverse_endianness : forall 'a. Size 'a => mword 'a -> mword 'a
+let reverse_endianness v = wordFromBitlist (reverse_endianness_list (bitlistFromWord v))
+
+val get_slice_int : forall 'a. Size 'a => integer -> integer -> integer -> mword 'a
+let get_slice_int = get_slice_int_bv
+
+val set_slice_int : forall 'a. Size 'a => integer -> integer -> integer -> mword 'a -> integer
+let set_slice_int = set_slice_int_bv
+
+val slice : forall 'a 'b. Size 'a, Size 'b => mword 'a -> integer -> integer -> mword 'b
+let slice v lo len =
+  subrange_vec_dec v (lo + len - 1) lo
+
+val set_slice : forall 'a 'b. Size 'a, Size 'b => integer -> integer -> mword 'a -> integer -> mword 'b -> mword 'a
+let set_slice (out_len:ii) (slice_len:ii) out (n:ii) v =
+  update_subrange_vec_dec out (n + slice_len - 1) n v
+
+val eq_vec    : forall 'a. Size 'a => mword 'a -> mword 'a -> bool
+val neq_vec   : forall 'a. Size 'a => mword 'a -> mword 'a -> bool
+let inline eq_vec    = eq_mword
+let inline neq_vec   = neq_mword
+
+val count_leading_zeros : forall 'a. Size 'a => mword 'a -> integer
+let count_leading_zeros v = count_leading_zeros_bv v
diff --git a/src/gen_lib/0.11/sail2_prompt.lem b/src/gen_lib/0.11/sail2_prompt.lem
new file mode 100644
index 00000000..3cde7ade
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_prompt.lem
@@ -0,0 +1,139 @@
+open import Pervasives_extra
+(*open import Sail_impl_base*)
+open import Sail2_values
+open import Sail2_prompt_monad
+open import {isabelle} `Sail2_prompt_monad_lemmas`
+
+val (>>=) : forall 'rv 'a 'b 'e. monad 'rv 'a 'e -> ('a -> monad 'rv 'b 'e) -> monad 'rv 'b 'e
+declare isabelle target_rep function (>>=) = infix `\<bind>`
+let inline ~{isabelle} (>>=) = bind
+
+val (>>) : forall 'rv 'b 'e. monad 'rv unit 'e -> monad 'rv 'b 'e -> monad 'rv 'b 'e
+declare isabelle target_rep function (>>) = infix `\<then>`
+let inline ~{isabelle} (>>) m n = m >>= fun (_ : unit) -> n
+
+val iter_aux : forall 'rv 'a 'e. integer -> (integer -> 'a -> monad 'rv unit 'e) -> list 'a -> monad 'rv unit 'e
+let rec iter_aux i f xs = match xs with
+  | x :: xs -> f i x >> iter_aux (i + 1) f xs
+  | [] -> return ()
+  end
+
+declare {isabelle} termination_argument iter_aux = automatic
+
+val iteri : forall 'rv 'a 'e. (integer -> 'a -> monad 'rv unit 'e) -> list 'a -> monad 'rv unit 'e
+let iteri f xs = iter_aux 0 f xs
+
+val iter : forall 'rv 'a 'e. ('a -> monad 'rv unit 'e) -> list 'a -> monad 'rv unit 'e
+let iter f xs = iteri (fun _ x -> f x) xs
+
+val foreachM : forall 'a 'rv 'vars 'e.
+  list 'a -> 'vars -> ('a -> 'vars -> monad 'rv 'vars 'e) -> monad 'rv 'vars 'e
+let rec foreachM l vars body =
+match l with
+| [] -> return vars
+| (x :: xs) ->
+  body x vars >>= fun vars ->
+  foreachM xs vars body
+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)
+
+val or_boolM : forall 'rv 'e. monad 'rv bool 'e -> monad 'rv bool 'e -> monad 'rv bool 'e
+let or_boolM l r = l >>= (fun l -> if l then return true else r)
+
+val bool_of_bitU_fail : forall 'rv 'e. bitU -> monad 'rv bool 'e
+let bool_of_bitU_fail = function
+  | B0 -> return false
+  | B1 -> return true
+  | BU -> Fail "bool_of_bitU"
+end
+
+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 -> choose_bool "bool_of_bitU"
+end
+
+val bools_of_bits_nondet : forall 'rv 'e. list bitU -> monad 'rv (list bool) 'e
+let bools_of_bits_nondet bits =
+  foreachM bits []
+    (fun b bools ->
+      bool_of_bitU_nondet b >>= (fun b ->
+      return (bools ++ [b])))
+
+val of_bits_nondet : forall 'rv 'a 'e. Bitvector 'a => list bitU -> monad 'rv 'a 'e
+let of_bits_nondet bits =
+  bools_of_bits_nondet bits >>= (fun bs ->
+  return (of_bools bs))
+
+val of_bits_fail : forall 'rv 'a 'e. Bitvector 'a => list bitU -> monad 'rv 'a 'e
+let of_bits_fail bits = maybe_fail "of_bits" (of_bits bits)
+
+val mword_nondet : forall 'rv 'a 'e. Size 'a => unit -> monad 'rv (mword 'a) 'e
+let mword_nondet () =
+  bools_of_bits_nondet (repeat [BU] (integerFromNat size)) >>= (fun bs ->
+  return (wordFromBitlist bs))
+
+val whileM : forall 'rv 'vars 'e. 'vars -> ('vars -> monad 'rv bool 'e) ->
+                ('vars -> monad 'rv 'vars 'e) -> monad 'rv 'vars 'e
+let rec whileM vars cond body =
+  cond vars >>= fun cond_val ->
+  if cond_val then
+    body vars >>= fun vars -> whileM vars cond body
+  else return vars
+
+val untilM : forall 'rv 'vars 'e. 'vars -> ('vars -> monad 'rv bool 'e) ->
+                ('vars -> monad 'rv 'vars 'e) -> monad 'rv 'vars 'e
+let rec untilM vars cond body =
+  body vars >>= fun vars ->
+  cond vars >>= fun cond_val ->
+  if cond_val then return vars else untilM vars cond body
+
+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 ("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
+    let is_inc_r2 = is_inc_of_reg r2 in
+    let () = ensure (is_inc_r1 = is_inc_r2)
+                    "write_two_regs called with vectors of different direction" in
+    is_inc_r1 in
+
+  let (size_r1 : integer) = size_of_reg r1 in
+  let (start_vec : integer) = get_start vec in
+  let size_vec = length vec in
+  let r1_v =
+    if is_inc
+    then slice vec start_vec (size_r1 - start_vec - 1)
+    else slice vec start_vec (start_vec - size_r1 - 1) in
+  let r2_v =
+    if is_inc
+    then slice vec (size_r1 - start_vec) (size_vec - start_vec)
+    else slice vec (start_vec - size_r1) (start_vec - size_vec) in
+  write_reg r1 r1_v >> write_reg r2 r2_v*)
diff --git a/src/gen_lib/0.11/sail2_prompt_monad.lem b/src/gen_lib/0.11/sail2_prompt_monad.lem
new file mode 100644
index 00000000..28c0a27e
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_prompt_monad.lem
@@ -0,0 +1,336 @@
+open import Pervasives_extra
+(*open import Sail_impl_base*)
+open import Sail2_instr_kinds
+open import Sail2_values
+
+type register_name = string
+type address = list bitU
+
+type monad 'regval 'a 'e =
+  | Done of 'a
+  (* 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 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 *)
+  | Barrier of barrier_kind * monad 'regval 'a 'e
+  (* Request to read register, will track dependency when mode.track_values *)
+  | 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. 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*)
+  | Fail of string
+  (* 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_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 () = 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
+
+val throw : forall 'rv 'a 'e. 'e -> monad 'rv 'a 'e
+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_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
+   the return value. The exception type is "either 'r 'e", where "Right e"
+   represents a proper exception and "Left r" an early return of value "r". *)
+type monadR 'rv 'a 'r 'e = monad 'rv 'a (either 'r 'e)
+
+val early_return : forall 'rv 'a 'r 'e. 'r -> monadR 'rv 'a 'r 'e
+let early_return r = throw (Left r)
+
+val catch_early_return : forall 'rv 'a 'e. monadR 'rv 'a 'a 'e -> monad 'rv 'a 'e
+let catch_early_return m =
+  try_catch m
+    (function
+      | Left a -> return a
+      | Right e -> throw e
+     end)
+
+(* Lift to monad with early return by wrapping exceptions *)
+val liftR : forall 'rv 'a 'r 'e. monad 'rv 'a 'e -> monadR 'rv 'a 'r 'e
+let liftR m = try_catch m (fun e -> throw (Right e))
+
+(* Catch exceptions in the presence of early returns *)
+val try_catchR : forall 'rv 'a 'r 'e1 'e2. monadR 'rv 'a 'r 'e1 -> ('e1 -> monadR 'rv 'a 'r 'e2) ->  monadR 'rv 'a 'r 'e2
+let try_catchR m h =
+  try_catch m
+    (function
+      | Left r -> throw (Left r)
+      | Right e -> h e
+     end)
+
+val maybe_fail : forall 'rv 'a 'e. string -> maybe 'a -> monad 'rv 'a 'e
+let maybe_fail msg = function
+  | Just a -> return a
+  | 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 =
+  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 'addrsize. Bitvector 'a, Bitvector 'b => read_kind -> 'addrsize -> 'a -> integer -> monad 'rv 'b 'e
+let read_mem rk addr_sz addr sz =
+  bind
+    (read_mem_bytes rk addr sz)
+    (fun bytes ->
+       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 () =
+  let k successful = (return successful) in
+  Excl_res k
+
+val write_mem_ea : forall 'rv 'a 'e 'addrsize. Bitvector 'a => write_kind -> 'addrsize -> 'a -> integer -> monad 'rv unit 'e
+let write_mem_ea wk addr_size 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 'addrsize. Bitvector 'a, Bitvector 'b =>
+  write_kind -> 'addrsize -> 'a -> integer -> 'b -> monad 'rv bool 'e
+let write_mem wk addr_size 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 =
+  let k v =
+    match reg.of_regval v with
+      | Just v -> Done v
+      | Nothing -> Fail "read_reg: unrecognised value"
+    end
+  in
+  Read_reg reg.name k
+
+(* TODO
+val read_reg_range : forall 's 'r 'rv 'a 'e. Bitvector 'a => register_ref 's 'rv 'r -> integer -> integer -> monad 'rv 'a 'e
+let read_reg_range reg i j =
+  read_reg_aux of_bits (external_reg_slice reg (nat_of_int i,nat_of_int j))
+
+let read_reg_bit reg i =
+  read_reg_aux (fun v -> v) (external_reg_slice reg (nat_of_int i,nat_of_int i)) >>= fun v ->
+  return (extract_only_element v)
+
+let read_reg_field reg regfield =
+  read_reg_aux (external_reg_field_whole reg regfield)
+
+let read_reg_bitfield reg regfield =
+  read_reg_aux (external_reg_field_whole reg regfield) >>= fun v ->
+  return (extract_only_element v)*)
+
+let reg_deref = read_reg
+
+val write_reg : forall 's 'rv 'a 'e. register_ref 's 'rv 'a -> 'a -> monad 'rv unit 'e
+let write_reg reg v = Write_reg reg.name (reg.regval_of v) (Done ())
+
+(* TODO
+let write_reg reg v =
+  write_reg_aux (external_reg_whole reg) v
+let write_reg_range reg i j v =
+  write_reg_aux (external_reg_slice reg (nat_of_int i,nat_of_int j)) v
+let write_reg_pos reg i v =
+  let iN = nat_of_int i in
+  write_reg_aux (external_reg_slice reg (iN,iN)) [v]
+let write_reg_bit = write_reg_pos
+let write_reg_field reg regfield v =
+  write_reg_aux (external_reg_field_whole reg regfield.field_name) v
+let write_reg_field_bit reg regfield bit =
+  write_reg_aux (external_reg_field_whole reg regfield.field_name)
+                (Vector [bit] 0 (is_inc_of_reg reg))
+let write_reg_field_range reg regfield i j v =
+  write_reg_aux (external_reg_field_slice reg regfield.field_name (nat_of_int i,nat_of_int j)) v
+let write_reg_field_pos reg regfield i v =
+  write_reg_field_range reg regfield i i [v]
+let write_reg_field_bit = write_reg_field_pos*)
+
+val barrier : forall 'rv 'e. barrier_kind -> monad 'rv unit 'e
+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. *)
+
+type base_monad 'regval 'regstate 'a 'e = monad 'regval 'a 'e
+type base_monadR 'regval 'regstate 'a 'r 'e = monadR 'regval 'a 'r 'e
diff --git a/src/gen_lib/0.11/sail2_state.lem b/src/gen_lib/0.11/sail2_state.lem
new file mode 100644
index 00000000..ec787764
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_state.lem
@@ -0,0 +1,105 @@
+open import Pervasives_extra
+open import Sail2_values
+open import Sail2_state_monad
+open import {isabelle} `Sail2_state_monad_lemmas`
+
+val iterS_aux : forall 'rv 'a 'e. integer -> (integer -> 'a -> monadS 'rv unit 'e) -> list 'a -> monadS 'rv unit 'e
+let rec iterS_aux i f xs = match xs with
+  | x :: xs -> f i x >>$ iterS_aux (i + 1) f xs
+  | [] -> returnS ()
+  end
+
+declare {isabelle} termination_argument iterS_aux = automatic
+
+val iteriS : forall 'rv 'a 'e. (integer -> 'a -> monadS 'rv unit 'e) -> list 'a -> monadS 'rv unit 'e
+let iteriS f xs = iterS_aux 0 f xs
+
+val iterS : forall 'rv 'a 'e. ('a -> monadS 'rv unit 'e) -> list 'a -> monadS 'rv unit 'e
+let iterS f xs = iteriS (fun _ x -> f x) xs
+
+val foreachS : forall 'a 'rv 'vars 'e.
+  list 'a -> 'vars -> ('a -> 'vars -> monadS 'rv 'vars 'e) -> monadS 'rv 'vars 'e
+let rec foreachS xs vars body = match xs with
+  | [] -> returnS vars
+  | x :: xs ->
+     body x vars >>$= fun vars ->
+     foreachS xs vars body
+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)
+
+val or_boolS : forall 'rv 'e. monadS 'rv bool 'e -> monadS 'rv bool 'e -> monadS 'rv bool 'e
+let or_boolS l r = l >>$= (fun l -> if l then returnS true else r)
+
+val bool_of_bitU_fail : forall 'rv 'e. bitU -> monadS 'rv bool 'e
+let bool_of_bitU_fail = function
+  | B0 -> returnS false
+  | B1 -> returnS true
+  | BU -> failS "bool_of_bitU"
+end
+
+val bool_of_bitU_nondetS : forall 'rv 'e. bitU -> monadS 'rv bool 'e
+let bool_of_bitU_nondetS = function
+  | B0 -> returnS false
+  | B1 -> returnS true
+  | BU -> undefined_boolS ()
+end
+
+val bools_of_bits_nondetS : forall 'rv 'e. list bitU -> monadS 'rv (list bool) 'e
+let bools_of_bits_nondetS bits =
+  foreachS bits []
+    (fun b bools ->
+      bool_of_bitU_nondetS b >>$= (fun b ->
+      returnS (bools ++ [b])))
+
+val of_bits_nondetS : forall 'rv 'a 'e. Bitvector 'a => list bitU -> monadS 'rv 'a 'e
+let of_bits_nondetS bits =
+  bools_of_bits_nondetS bits >>$= (fun bs ->
+  returnS (of_bools bs))
+
+val of_bits_failS : forall 'rv 'a 'e. Bitvector 'a => list bitU -> monadS 'rv 'a 'e
+let of_bits_failS bits = maybe_failS "of_bits" (of_bits bits)
+
+val mword_nondetS : forall 'rv 'a 'e. Size 'a => unit -> monadS 'rv (mword 'a) 'e
+let mword_nondetS () =
+  bools_of_bits_nondetS (repeat [BU] (integerFromNat size)) >>$= (fun bs ->
+  returnS (wordFromBitlist bs))
+
+
+val whileS : forall 'rv 'vars 'e. 'vars -> ('vars -> monadS 'rv bool 'e) ->
+                ('vars -> monadS 'rv 'vars 'e) -> monadS 'rv 'vars 'e
+let rec whileS vars cond body s =
+  (cond vars >>$= (fun cond_val s' ->
+  if cond_val then
+    (body vars >>$= (fun vars s'' -> whileS vars cond body s'')) s'
+  else returnS vars s')) s
+
+val untilS : forall 'rv 'vars 'e. 'vars -> ('vars -> monadS 'rv bool 'e) ->
+                ('vars -> monadS 'rv 'vars 'e) -> monadS 'rv 'vars 'e
+let rec untilS vars cond body s =
+  (body vars >>$= (fun vars 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 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 "choose internal_pick"
+  end
diff --git a/src/gen_lib/0.11/sail2_state_lifting.lem b/src/gen_lib/0.11/sail2_state_lifting.lem
new file mode 100644
index 00000000..98a5390d
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_state_lifting.lem
@@ -0,0 +1,57 @@
+open import Pervasives_extra
+open import Sail2_values
+open import Sail2_prompt_monad
+open import Sail2_prompt
+open import Sail2_state_monad
+open import {isabelle} `Sail2_state_monad_lemmas`
+
+(* 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 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/0.11/sail2_state_monad.lem b/src/gen_lib/0.11/sail2_state_monad.lem
new file mode 100644
index 00000000..8ea919f9
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_state_monad.lem
@@ -0,0 +1,278 @@
+open import Pervasives_extra
+open import Sail2_instr_kinds
+open import Sail2_values
+
+(* 'a is result type *)
+
+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 |>
+
+val init_state : forall 'regs. 'regs -> sequential_state 'regs
+let init_state regs =
+  <| regstate = regs;
+     memstate = Map.empty;
+     tagstate = Map.empty |>
+
+type ex 'e =
+  | Failure of string
+  | Throw of 'e
+
+type result 'a 'e =
+  | Value of 'a
+  | Ex of (ex 'e)
+
+(* State, nondeterminism and exception monad with result value type 'a
+   and exception type 'e. *)
+type monadS 'regs 'a 'e = sequential_state 'regs -> set (result 'a 'e * sequential_state 'regs)
+
+val returnS : forall 'regs 'a 'e. 'a -> monadS 'regs 'a 'e
+let returnS a s = {(Value a,s)}
+
+val bindS : forall 'regs 'a 'b 'e. monadS 'regs 'a 'e -> ('a -> monadS 'regs 'b 'e) -> monadS 'regs 'b 'e
+let bindS m f (s : sequential_state 'regs) =
+  Set.bigunion (Set.map (function
+                | (Value a, s') -> f a s'
+                | (Ex e, s') -> {(Ex e, s')}
+                end) (m s))
+
+val seqS: forall 'regs 'b 'e. monadS 'regs unit 'e -> monadS 'regs 'b 'e -> monadS 'regs 'b 'e
+let seqS m n = bindS m (fun (_ : unit) -> n)
+
+let inline (>>$=) = bindS
+let inline (>>$) = seqS
+
+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)
+
+val updateS : forall 'regs 'e. (sequential_state 'regs -> sequential_state 'regs) -> monadS 'regs unit 'e
+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 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"
+
+val throwS : forall 'regs 'a 'e. 'e -> monadS 'regs 'a 'e
+let throwS e s = {(Ex (Throw e), s)}
+
+val try_catchS : forall 'regs 'a 'e1 'e2. monadS 'regs 'a 'e1 -> ('e1 -> monadS 'regs 'a 'e2) ->  monadS 'regs 'a 'e2
+let try_catchS m h s =
+  Set.bigunion (Set.map (function
+                | (Value a, s') -> returnS a s'
+                | (Ex (Throw e), s') -> h e s'
+                | (Ex (Failure msg), s') -> {(Ex (Failure msg), s')}
+                end) (m s))
+
+val assert_expS : forall 'regs 'e. bool -> string -> monadS 'regs unit 'e
+let assert_expS exp msg = if exp then returnS () else failS msg
+
+(* For early return, we abuse exceptions by throwing and catching
+   the return value. The exception type is "either 'r 'e", where "Right e"
+   represents a proper exception and "Left r" an early return of value "r". *)
+type monadRS 'regs 'a 'r 'e = monadS 'regs 'a (either 'r 'e)
+
+val early_returnS : forall 'regs 'a 'r 'e. 'r -> monadRS 'regs 'a 'r 'e
+let early_returnS r = throwS (Left r)
+
+val catch_early_returnS : forall 'regs 'a 'e. monadRS 'regs 'a 'a 'e -> monadS 'regs 'a 'e
+let catch_early_returnS m =
+  try_catchS m
+    (function
+      | Left a -> returnS a
+      | Right e -> throwS e
+     end)
+
+(* Lift to monad with early return by wrapping exceptions *)
+val liftRS : forall 'a 'r 'regs 'e. monadS 'regs 'a 'e -> monadRS 'regs 'a 'r 'e
+let liftRS m = try_catchS m (fun e -> throwS (Right e))
+
+(* Catch exceptions in the presence of early returns *)
+val try_catchRS : forall 'regs 'a 'r 'e1 'e2. monadRS 'regs 'a 'r 'e1 -> ('e1 -> monadRS 'regs 'a 'r 'e2) ->  monadRS 'regs 'a 'r 'e2
+let try_catchRS m h =
+  try_catchS m
+    (function
+      | Left r -> throwS (Left r)
+      | Right e -> h e
+     end)
+
+val maybe_failS : forall 'regs 'a 'e. string -> maybe 'a -> monadS 'regs 'a 'e
+let maybe_failS msg = function
+  | Just a  -> returnS a
+  | Nothing -> failS msg
+end
+
+val read_tagS : forall 'regs 'a 'e. Bitvector 'a => 'a -> monadS 'regs bitU 'e
+let read_tagS 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 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
+  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 'addrsize. Bitvector 'a, Bitvector 'b => read_kind -> 'addrsize -> 'a -> integer -> monadS 'regs 'b 'e
+let read_memS rk addr_size a sz =
+  read_memtS rk a sz >>$= (fun (bytes, _) ->
+  returnS bytes)
+
+val excl_resultS : forall 'regs 'e. unit -> monadS 'regs bool 'e
+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 'addrsize. Bitvector 'a, Bitvector 'b =>
+  write_kind -> 'addrsize -> 'a -> integer -> 'b -> monadS 'regs bool 'e
+let write_memS wk addr_size 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)
+
+(* TODO
+let read_reg_range reg i j state =
+  let v = slice (get_reg state (name_of_reg reg)) i j in
+  [(Value (vec_to_bvec v),state)]
+let read_reg_bit reg i state =
+  let v = access (get_reg state (name_of_reg reg)) i in
+  [(Value v,state)]
+let read_reg_field reg regfield =
+  let (i,j) = register_field_indices reg regfield in
+  read_reg_range reg i j
+let read_reg_bitfield reg regfield =
+  let (i,_) = register_field_indices reg regfield in
+  read_reg_bit reg i *)
+
+val read_regvalS : forall 'regs 'rv 'e.
+  register_accessors 'regs 'rv -> string -> monadS 'regs 'rv 'e
+let read_regvalS (read, _) reg =
+  readS (fun s -> read reg s.regstate) >>$= (function
+      | Just v ->  returnS v
+      | Nothing -> failS ("read_regvalS " ^ reg)
+    end)
+
+val write_regvalS : forall 'regs 'rv 'e.
+  register_accessors 'regs 'rv -> string -> 'rv -> monadS 'regs unit 'e
+let write_regvalS (_, write) reg v =
+  readS (fun s -> write reg v s.regstate) >>$= (function
+      | Just rs' -> updateS (fun s -> <| s with regstate = rs' |>)
+      | Nothing ->  failS ("write_regvalS " ^ reg)
+    end)
+
+val write_regS : forall 'regs 'rv 'a 'e. register_ref 'regs 'rv 'a -> 'a -> monadS 'regs unit 'e
+let write_regS reg v =
+  updateS (fun s -> <| s with regstate = reg.write_to v s.regstate |>)
+
+(* TODO
+val update_reg : forall 'regs 'rv 'a 'b 'e. register_ref 'regs 'rv 'a -> ('a -> 'b -> 'a) -> 'b -> monadS 'regs unit 'e
+let update_reg reg f v state =
+  let current_value = get_reg state reg in
+  let new_value = f current_value v in
+  [(Value (), set_reg state reg new_value)]
+
+let write_reg_field reg regfield = update_reg reg regfield.set_field
+
+val update_reg_range : forall 'regs 'rv 'a 'b. Bitvector 'a, Bitvector 'b => register_ref 'regs 'rv 'a -> integer -> integer -> 'a -> 'b -> 'a
+let update_reg_range reg i j reg_val new_val = set_bits (reg.is_inc) reg_val i j (bits_of new_val)
+let write_reg_range reg i j = update_reg reg (update_reg_range reg i j)
+
+let update_reg_pos reg i reg_val x = update_list reg.is_inc reg_val i x
+let write_reg_pos reg i = update_reg reg (update_reg_pos reg i)
+
+let update_reg_bit reg i reg_val bit = set_bit (reg.is_inc) reg_val i (to_bitU bit)
+let write_reg_bit reg i = update_reg reg (update_reg_bit reg i)
+
+let update_reg_field_range regfield i j reg_val new_val =
+  let current_field_value = regfield.get_field reg_val in
+  let new_field_value = set_bits (regfield.field_is_inc) current_field_value i j (bits_of new_val) in
+  regfield.set_field reg_val new_field_value
+let write_reg_field_range reg regfield i j = update_reg reg (update_reg_field_range regfield i j)
+
+let update_reg_field_pos regfield i reg_val x =
+  let current_field_value = regfield.get_field reg_val in
+  let new_field_value = update_list regfield.field_is_inc current_field_value i x in
+  regfield.set_field reg_val new_field_value
+let write_reg_field_pos reg regfield i = update_reg reg (update_reg_field_pos regfield i)
+
+let update_reg_field_bit regfield i reg_val bit =
+  let current_field_value = regfield.get_field reg_val in
+  let new_field_value = set_bit (regfield.field_is_inc) current_field_value i (to_bitU bit) in
+  regfield.set_field reg_val new_field_value
+let write_reg_field_bit reg regfield i = update_reg reg (update_reg_field_bit regfield i)*)
+
+(* TODO Add Show typeclass for value and exception type *)
+val show_result : forall 'a 'e. result 'a 'e -> string
+let show_result = function
+  | Value _ -> "Value ()"
+  | Ex (Failure msg) -> "Failure " ^ msg
+  | Ex (Throw _) -> "Throw"
+end
+
+val prerr_results : forall 'a 'e 's. SetType 's => set (result 'a 'e * 's) -> unit
+let prerr_results rs =
+  let _ = Set.map (fun (r, _) -> let _ = prerr_endline (show_result r) in ()) rs in
+  ()
diff --git a/src/gen_lib/0.11/sail2_string.lem b/src/gen_lib/0.11/sail2_string.lem
new file mode 100644
index 00000000..33a665a0
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_string.lem
@@ -0,0 +1,448 @@
+open import Pervasives
+open import List
+open import List_extra
+open import String
+open import String_extra
+
+open import Sail2_operators
+open import Sail2_values
+
+val string_sub : string -> ii -> ii -> string
+let string_sub str start len =
+  toString (take (natFromInteger len) (drop (natFromInteger start) (toCharList str)))
+
+val string_startswith : string -> string -> bool
+let string_startswith str1 str2 =
+  let prefix = string_sub str1 0 (integerFromNat (stringLength str2)) in
+  (prefix = str2)
+
+val string_drop : string -> ii -> string
+let string_drop str n =
+  toString (drop (natFromInteger n) (toCharList str))
+
+val string_take : string -> ii -> string
+let string_take str n =
+  toString (take (natFromInteger n) (toCharList str))
+
+val string_length : string -> ii
+let string_length s = integerFromNat (stringLength s)
+
+let string_append = stringAppend
+
+(***********************************************
+ * Begin stuff that should be in Lem Num_extra *
+ ***********************************************)
+
+val maybeIntegerOfString : string -> maybe integer
+let maybeIntegerOfString _ = Nothing (* TODO FIXME *)
+declare ocaml target_rep function maybeIntegerOfString = `(fun s -> match int_of_string s with i -> Some (Nat_big_num.of_int i) | exception Failure _ -> None )`
+
+(***********************************************
+ * end stuff that should be in Lem Num_extra   *
+ ***********************************************)
+
+let rec maybe_int_of_prefix s =
+  match s with
+  | "" -> Nothing
+  | str ->
+     let len = string_length str in
+     match maybeIntegerOfString str with
+     | Just n -> Just (n, len)
+     | Nothing -> maybe_int_of_prefix (string_sub str 0 (len - 1))
+     end
+  end
+
+let maybe_int_of_string = maybeIntegerOfString
+
+val n_leading_spaces : string -> ii
+let rec n_leading_spaces s =
+  let len = string_length s in
+  if len = 0 then 0 else
+    if len = 1 then
+      match s with
+         | " " -> 1
+         | _ -> 0
+      end
+    else
+           (* Isabelle generation for pattern matching on characters
+              is currently broken, so use an if-expression *)
+           if nth s 0 = #' '
+           then 1 + (n_leading_spaces (string_sub s 1 (len - 1)))
+           else 0
+  (* end *)
+
+let opt_spc_matches_prefix s =
+  Just ((), n_leading_spaces s)
+
+let spc_matches_prefix s =
+  let n = n_leading_spaces s in
+  (* match n with *)
+(* | 0 -> Nothing *)
+  if n = 0 then Nothing else
+  (* | n -> *) Just ((), n)
+  (* end *)
+
+(* Python:
+f = """let hex_bits_{0}_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** {0}) then
+      Just ((of_int {0} n, len))
+    else
+      Nothing
+  end
+"""
+
+for i in list(range(1, 34)) + [48, 64]:
+  print(f.format(i))
+*)
+let hex_bits_1_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 1) then
+      Just ((of_int 1 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_2_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 2) then
+      Just ((of_int 2 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_3_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 3) then
+      Just ((of_int 3 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_4_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 4) then
+      Just ((of_int 4 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_5_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 5) then
+      Just ((of_int 5 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_6_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 6) then
+      Just ((of_int 6 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_7_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 7) then
+      Just ((of_int 7 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_8_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 8) then
+      Just ((of_int 8 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_9_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 9) then
+      Just ((of_int 9 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_10_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 10) then
+      Just ((of_int 10 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_11_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 11) then
+      Just ((of_int 11 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_12_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 12) then
+      Just ((of_int 12 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_13_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 13) then
+      Just ((of_int 13 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_14_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 14) then
+      Just ((of_int 14 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_15_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 15) then
+      Just ((of_int 15 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_16_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 16) then
+      Just ((of_int 16 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_17_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 17) then
+      Just ((of_int 17 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_18_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 18) then
+      Just ((of_int 18 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_19_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 19) then
+      Just ((of_int 19 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_20_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 20) then
+      Just ((of_int 20 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_21_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 21) then
+      Just ((of_int 21 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_22_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 22) then
+      Just ((of_int 22 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_23_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 23) then
+      Just ((of_int 23 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_24_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 24) then
+      Just ((of_int 24 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_25_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 25) then
+      Just ((of_int 25 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_26_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 26) then
+      Just ((of_int 26 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_27_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 27) then
+      Just ((of_int 27 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_28_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 28) then
+      Just ((of_int 28 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_29_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 29) then
+      Just ((of_int 29 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_30_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 30) then
+      Just ((of_int 30 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_31_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 31) then
+      Just ((of_int 31 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_32_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 32) then
+      Just ((of_int 32 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_33_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 33) then
+      Just ((of_int 33 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_48_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 48) then
+      Just ((of_int 48 n, len))
+    else
+      Nothing
+  end
+
+let hex_bits_64_matches_prefix s =
+  match maybe_int_of_prefix s with
+  | Nothing -> Nothing
+  | Just (n, len) ->
+    if 0 <= n && n < (2 ** 64) then
+      Just ((of_int 64 n, len))
+    else
+      Nothing
+  end
diff --git a/src/gen_lib/0.11/sail2_values.lem b/src/gen_lib/0.11/sail2_values.lem
new file mode 100644
index 00000000..f657803f
--- /dev/null
+++ b/src/gen_lib/0.11/sail2_values.lem
@@ -0,0 +1,999 @@
+open import Pervasives_extra
+open import Machine_word
+(*open import Sail_impl_base*)
+
+
+type ii = integer
+type nn = natural
+
+val nat_of_int : integer -> nat
+let nat_of_int i = if i < 0 then 0 else natFromInteger i
+
+val pow : integer -> integer -> integer
+let pow m n = m ** (nat_of_int n)
+
+let pow2 n = pow 2 n
+
+let inline lt = (<)
+let inline gt = (>)
+let inline lteq = (<=)
+let inline gteq = (>=)
+
+val eq : forall 'a. Eq 'a => 'a -> 'a -> bool
+let inline eq l r = (l = r)
+
+val neq : forall 'a. Eq 'a => 'a -> 'a -> bool
+let inline neq l r = (l <> r)
+
+(*let add_int l r = integerAdd l r
+let add_signed l r = integerAdd l r
+let sub_int l r = integerMinus l r
+let mult_int l r = integerMult l r
+let div_int l r = integerDiv l r
+let div_nat l r = natDiv l r
+let power_int_nat l r = integerPow l r
+let power_int_int l r = integerPow l (nat_of_int r)
+let negate_int i = integerNegate i
+let min_int l r = integerMin l r
+let max_int l r = integerMax l r
+
+let add_real l r = realAdd l r
+let sub_real l r = realMinus l r
+let mult_real l r = realMult l r
+let div_real l r = realDiv l r
+let negate_real r = realNegate r
+let abs_real r = realAbs r
+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`
+
+val print : string -> unit
+let print _ = ()
+declare ocaml target_rep function print = `print_string`
+
+val prerr_endline : string -> unit
+let prerr_endline _ = ()
+declare ocaml target_rep function prerr_endline = `prerr_endline`
+
+let prerr x = prerr_endline x
+
+val print_int : string -> integer -> unit
+let print_int msg i = print_endline (msg ^ (stringFromInteger i))
+
+val prerr_int : string -> integer -> unit
+let prerr_int msg i = prerr_endline (msg ^ (stringFromInteger i))
+
+val putchar : integer -> unit
+let putchar _ = ()
+declare ocaml target_rep function putchar i = (`print_char` (`char_of_int` (`Nat_big_num.to_int` i)))
+
+val shr_int : ii -> ii -> ii
+let rec shr_int x s = if s > 0 then shr_int (x / 2) (s - 1) else x
+
+val shl_int : integer -> integer -> integer
+let rec shl_int i shift = if shift > 0 then 2 * shl_int i (shift - 1) else i
+
+let inline or_bool l r = (l || r)
+let inline and_bool l r = (l && r)
+let inline xor_bool l r = xor l r
+
+let inline append_list l r = l ++ r
+let inline length_list xs = integerFromNat (List.length xs)
+let take_list n xs = List.take (nat_of_int n) xs
+let drop_list n xs = List.drop (nat_of_int n) xs
+
+val repeat : forall 'a. list 'a -> integer -> list 'a
+let rec repeat xs n =
+  if n <= 0 then []
+  else xs ++ repeat xs (n-1)
+declare {isabelle} termination_argument repeat = automatic
+
+let duplicate_to_list bit length = repeat [bit] length
+
+let rec replace bs (n : integer) b' = match bs with
+  | [] -> []
+  | b :: bs ->
+     if n = 0 then b' :: bs
+              else b :: replace bs (n - 1) b'
+  end
+declare {isabelle; hol} termination_argument replace = automatic
+
+let upper n = n
+
+(* Modulus operation corresponding to quot below -- result
+   has sign of dividend. *)
+let tmod_int (a: integer) (b:integer) : integer =
+  let m = (abs a) mod (abs b) in
+  if a < 0 then ~m else m
+
+let hardware_mod = tmod_int
+
+(* There are different possible answers for integer divide regarding
+rounding behaviour on negative operands. Positive operands always
+round down so derive the one we want (trucation towards zero) from
+that *)
+let tdiv_int (a:integer) (b:integer) : integer =
+  let q = (abs a) / (abs b) in
+  if ((a<0) = (b<0)) then
+    q  (* same sign -- result positive *)
+  else
+    ~q (* different sign -- result negative *)
+
+let hardware_quot = tdiv_int
+
+let max_64u = (integerPow 2 64) - 1
+let max_64  = (integerPow 2 63) - 1
+let min_64  = 0 - (integerPow 2 63)
+let max_32u = (4294967295 : integer)
+let max_32  = (2147483647 : integer)
+let min_32  = (0 - 2147483648 : integer)
+let max_8   = (127 : integer)
+let min_8   = (0 - 128 : integer)
+let max_5   = (31 : integer)
+let min_5   = (0 - 32 : integer)
+
+(* just_list takes a list of maybes and returns Just xs if all elements have
+   a value, and Nothing if one of the elements is Nothing. *)
+val just_list : forall 'a. list (maybe 'a) -> maybe (list 'a)
+let rec just_list l = match l with
+  | [] -> Just []
+  | (x :: xs) ->
+    match (x, just_list xs) with
+      | (Just x, Just xs) -> Just (x :: xs)
+      | (_, _) -> Nothing
+    end
+  end
+declare {isabelle; hol} termination_argument just_list = automatic
+
+lemma just_list_spec:
+  ((forall xs. (just_list xs = Nothing) <-> List.elem Nothing xs) &&
+   (forall xs es. (just_list xs = Just es) <-> (xs = List.map Just es)))
+
+val maybe_failwith : forall 'a. maybe 'a -> 'a
+let maybe_failwith = function
+  | Just a -> a
+  | Nothing -> failwith "maybe_failwith"
+end
+
+(*** Bits *)
+type bitU = B0 | B1 | BU
+
+let showBitU = function
+  | B0 -> "O"
+  | B1 -> "I"
+  | BU -> "U"
+end
+
+let bitU_char = function
+  | B0 -> #'0'
+  | B1 -> #'1'
+  | BU -> #'?'
+end
+
+instance (Show bitU)
+  let show = showBitU
+end
+
+val compare_bitU : bitU -> bitU -> ordering
+let compare_bitU l r = match (l, r) with
+  | (BU, BU) -> EQ
+  | (B0, B0) -> EQ
+  | (B1, B1) -> EQ
+  | (BU, _)  -> LT
+  | (_, BU)  -> GT
+  | (B0, _)  -> LT
+  | (_, _)   -> GT
+end
+
+instance (Ord bitU)
+  let compare = compare_bitU
+  let (<)  l r = (compare_bitU l r) = LT
+  let (<=) l r = (compare_bitU l r) <> GT
+  let (>)  l r = (compare_bitU l r) = GT
+  let (>=) l r = (compare_bitU l r) <> LT
+end
+
+class (BitU 'a)
+  val to_bitU : 'a -> bitU
+  val of_bitU : bitU -> 'a
+end
+
+instance (BitU bitU)
+  let to_bitU b = b
+  let of_bitU b = b
+end
+
+let bool_of_bitU = function
+  | B0 -> Just false
+  | B1 -> Just true
+  | BU -> Nothing
+  end
+
+let bitU_of_bool b = if b then B1 else B0
+
+(*instance (BitU bool)
+  let to_bitU = bitU_of_bool
+  let of_bitU = bool_of_bitU
+end*)
+
+let cast_bit_bool = bool_of_bitU
+
+let not_bit = function
+  | B1 -> B0
+  | B0 -> B1
+  | BU -> BU
+  end
+
+val is_one : integer -> bitU
+let is_one i =
+  if i = 1 then B1 else B0
+
+val and_bit : bitU -> bitU -> bitU
+let and_bit x y =
+  match (x, y) with
+    | (B0, _) -> B0
+    | (_, B0) -> B0
+    | (B1, B1) -> B1
+    | (_, _) -> BU
+  end
+
+val or_bit : bitU -> bitU -> bitU
+let or_bit x y =
+  match (x, y) with
+    | (B1, _) -> B1
+    | (_, B1) -> B1
+    | (B0, B0) -> B0
+    | (_, _) -> BU
+  end
+
+val xor_bit : bitU -> bitU -> bitU
+let xor_bit x y=
+  match (x, y) with
+    | (B0, B0) -> B0
+    | (B0, B1) -> B1
+    | (B1, B0) -> B1
+    | (B1, B1) -> B0
+    | (_, _) -> BU
+  end
+
+val (&.) : bitU -> bitU -> bitU
+let inline (&.) x y = and_bit x y
+
+val (|.) : bitU -> bitU -> bitU
+let inline (|.) x y = or_bit x y
+
+val (+.) : bitU -> bitU -> bitU
+let inline (+.) x y = xor_bit x y
+
+
+(*** Bool lists ***)
+
+val bools_of_nat_aux : integer -> natural -> list bool -> list bool
+let rec bools_of_nat_aux len x acc =
+  if len <= 0 then acc
+  else bools_of_nat_aux (len - 1) (x / 2) ((if x mod 2 = 1 then true else false) :: acc)
+  (*else (if x mod 2 = 1 then true else false) :: bools_of_nat_aux (x / 2)*)
+declare {isabelle} termination_argument bools_of_nat_aux = automatic
+let bools_of_nat len n = bools_of_nat_aux len n [] (*List.reverse (bools_of_nat_aux n)*)
+
+val nat_of_bools_aux : natural -> list bool -> natural
+let rec nat_of_bools_aux acc bs = match bs with
+  | [] -> acc
+  | true :: bs -> nat_of_bools_aux ((2 * acc) + 1) bs
+  | false :: bs -> nat_of_bools_aux (2 * acc) bs
+end
+declare {isabelle; hol} termination_argument nat_of_bools_aux = automatic
+let nat_of_bools bs = nat_of_bools_aux 0 bs
+
+val unsigned_of_bools : list bool -> integer
+let unsigned_of_bools bs = integerFromNatural (nat_of_bools bs)
+
+val signed_of_bools : list bool -> integer
+let signed_of_bools bs =
+  match bs with
+    | true :: _  -> 0 - (1 + (unsigned_of_bools (List.map not bs)))
+    | false :: _ -> unsigned_of_bools bs
+    | [] -> 0 (* Treat empty list as all zeros *)
+  end
+
+val int_of_bools : bool -> list bool -> integer
+let int_of_bools sign bs = if sign then signed_of_bools bs else unsigned_of_bools bs
+
+val pad_list : forall 'a. 'a -> list 'a -> integer -> list 'a
+let rec pad_list x xs n =
+  if n <= 0 then xs else pad_list x (x :: xs) (n - 1)
+declare {isabelle} termination_argument pad_list = automatic
+
+let ext_list pad len xs =
+  let longer = len - (integerFromNat (List.length xs)) in
+  if longer < 0 then drop (nat_of_int (abs (longer))) xs
+  else pad_list pad xs longer
+
+let extz_bools len bs = ext_list false len bs
+let exts_bools len bs =
+  match bs with
+    | true :: _ -> ext_list true len bs
+    | _ -> ext_list false len bs
+  end
+
+let rec add_one_bool_ignore_overflow_aux bits = match bits with
+  | [] -> []
+  | false :: bits -> true :: bits
+  | true :: bits -> false :: add_one_bool_ignore_overflow_aux bits
+end
+declare {isabelle; hol} termination_argument add_one_bool_ignore_overflow_aux = automatic
+
+let add_one_bool_ignore_overflow bits =
+  List.reverse (add_one_bool_ignore_overflow_aux (List.reverse bits))
+
+(*let bool_list_of_int n =
+  let bs_abs = false :: bools_of_nat (naturalFromInteger (abs n)) in
+  if n >= (0 : integer) then bs_abs
+  else add_one_bool_ignore_overflow (List.map not bs_abs)
+let bools_of_int len n = exts_bools len (bool_list_of_int n)*)
+let bools_of_int len n =
+  let bs_abs = bools_of_nat len (naturalFromInteger (abs n)) in
+  if n >= (0 : integer) then bs_abs
+  else add_one_bool_ignore_overflow (List.map not bs_abs)
+
+(*** Bit lists ***)
+
+val has_undefined_bits : list bitU -> bool
+let has_undefined_bits bs = List.any (function BU -> true | _ -> false end) bs
+
+let bits_of_nat len n = List.map bitU_of_bool (bools_of_nat len n)
+
+let nat_of_bits bits =
+  match (just_list (List.map bool_of_bitU bits)) with
+    | Just bs -> Just (nat_of_bools bs)
+    | Nothing -> Nothing
+  end
+
+let not_bits = List.map not_bit
+
+val binop_list : forall 'a. ('a -> 'a -> 'a) -> list 'a -> list 'a -> list 'a
+let binop_list op xs ys =
+  foldr (fun (x, y) acc -> op x y :: acc) [] (zip xs ys)
+
+let unsigned_of_bits bits =
+  match (just_list (List.map bool_of_bitU bits)) with
+    | Just bs -> Just (unsigned_of_bools bs)
+    | Nothing -> Nothing
+  end
+
+let signed_of_bits bits =
+  match (just_list (List.map bool_of_bitU bits)) with
+    | Just bs -> Just (signed_of_bools bs)
+    | Nothing -> Nothing
+  end
+
+val int_of_bits : bool -> list bitU -> maybe integer
+let int_of_bits sign bs = if sign then signed_of_bits bs else unsigned_of_bits bs
+
+let extz_bits len bits = ext_list B0 len bits
+let exts_bits len bits =
+  match bits with
+  | BU :: _ -> ext_list BU len bits
+  | B1 :: _ -> ext_list B1 len bits
+  | _ -> ext_list B0 len bits
+  end
+
+let rec add_one_bit_ignore_overflow_aux bits = match bits with
+  | [] -> []
+  | B0 :: bits -> B1 :: bits
+  | B1 :: bits -> B0 :: add_one_bit_ignore_overflow_aux bits
+  | BU :: bits -> BU :: List.map (fun _ -> BU) bits
+end
+declare {isabelle; hol} termination_argument add_one_bit_ignore_overflow_aux = automatic
+
+let add_one_bit_ignore_overflow bits =
+  List.reverse (add_one_bit_ignore_overflow_aux (List.reverse bits))
+
+(*let bit_list_of_int n = List.map bitU_of_bool (bool_list_of_int n)
+let bits_of_int len n = exts_bits len (bit_list_of_int n)*)
+let bits_of_int len n = List.map bitU_of_bool (bools_of_int len n)
+
+val arith_op_bits :
+  (integer -> integer -> integer) -> bool -> list bitU -> list bitU -> list bitU
+let arith_op_bits op sign l r =
+  match (int_of_bits sign l, int_of_bits sign r) with
+    | (Just li, Just ri) -> bits_of_int (length_list l) (op li ri)
+    | (_, _) -> repeat [BU] (length_list l)
+  end
+
+let char_of_nibble = function
+  | (B0, B0, B0, B0) -> Just #'0'
+  | (B0, B0, B0, B1) -> Just #'1'
+  | (B0, B0, B1, B0) -> Just #'2'
+  | (B0, B0, B1, B1) -> Just #'3'
+  | (B0, B1, B0, B0) -> Just #'4'
+  | (B0, B1, B0, B1) -> Just #'5'
+  | (B0, B1, B1, B0) -> Just #'6'
+  | (B0, B1, B1, B1) -> Just #'7'
+  | (B1, B0, B0, B0) -> Just #'8'
+  | (B1, B0, B0, B1) -> Just #'9'
+  | (B1, B0, B1, B0) -> Just #'A'
+  | (B1, B0, B1, B1) -> Just #'B'
+  | (B1, B1, B0, B0) -> Just #'C'
+  | (B1, B1, B0, B1) -> Just #'D'
+  | (B1, B1, B1, B0) -> Just #'E'
+  | (B1, B1, B1, B1) -> Just #'F'
+  | _ -> Nothing
+  end
+
+let rec hexstring_of_bits bs = match bs with
+  | b1 :: b2 :: b3 :: b4 :: bs ->
+     let n = char_of_nibble (b1, b2, b3, b4) in
+     let s = hexstring_of_bits bs in
+     match (n, s) with
+     | (Just n, Just s) -> Just (n :: s)
+     | _ -> Nothing
+     end
+  | [] -> Just []
+  | _ -> Nothing
+  end
+declare {isabelle; hol} termination_argument hexstring_of_bits = automatic
+
+let show_bitlist bs =
+  match hexstring_of_bits bs with
+  | Just s -> toString (#'0' :: #'x' :: s)
+  | Nothing -> toString (#'0' :: #'b' :: map bitU_char bs)
+  end
+
+(*** List operations *)
+
+let inline (^^) = append_list
+
+val subrange_list_inc : forall 'a. list 'a -> integer -> integer -> list 'a
+let subrange_list_inc xs i j =
+  let (toJ,_suffix) = List.splitAt (nat_of_int (j + 1)) xs in
+  let (_prefix,fromItoJ) = List.splitAt (nat_of_int i) toJ in
+  fromItoJ
+
+val subrange_list_dec : forall 'a. list 'a -> integer -> integer -> list 'a
+let subrange_list_dec xs i j =
+  let top = (length_list xs) - 1 in
+  subrange_list_inc xs (top - i) (top - j)
+
+val subrange_list : forall 'a. bool -> list 'a -> integer -> integer -> list 'a
+let subrange_list is_inc xs i j = if is_inc then subrange_list_inc xs i j else subrange_list_dec xs i j
+
+val update_subrange_list_inc : forall 'a. list 'a -> integer -> integer -> list 'a -> list 'a
+let update_subrange_list_inc xs i j xs' =
+  let (toJ,suffix) = List.splitAt (nat_of_int (j + 1)) xs in
+  let (prefix,_fromItoJ) = List.splitAt (nat_of_int i) toJ in
+  prefix ++ xs' ++ suffix
+
+val update_subrange_list_dec : forall 'a. list 'a -> integer -> integer -> list 'a -> list 'a
+let update_subrange_list_dec xs i j xs' =
+  let top = (length_list xs) - 1 in
+  update_subrange_list_inc xs (top - i) (top - j) xs'
+
+val update_subrange_list : forall 'a. bool -> list 'a -> integer -> integer -> list 'a -> list 'a
+let update_subrange_list is_inc xs i j xs' =
+  if is_inc then update_subrange_list_inc xs i j xs' else update_subrange_list_dec xs i j xs'
+
+val access_list_inc : forall 'a. list 'a -> integer -> 'a
+let access_list_inc xs n = List_extra.nth xs (nat_of_int n)
+
+val access_list_dec : forall 'a. list 'a -> integer -> 'a
+let access_list_dec xs n =
+  let top = (length_list xs) - 1 in
+  access_list_inc xs (top - n)
+
+val access_list : forall 'a. bool -> list 'a -> integer -> 'a
+let access_list is_inc xs n =
+  if is_inc then access_list_inc xs n else access_list_dec xs n
+
+val update_list_inc : forall 'a. list 'a -> integer -> 'a -> list 'a
+let update_list_inc xs n x = List.update xs (nat_of_int n) x
+
+val update_list_dec : forall 'a. list 'a -> integer -> 'a -> list 'a
+let update_list_dec xs n x =
+  let top = (length_list xs) - 1 in
+  update_list_inc xs (top - n) x
+
+val update_list : forall 'a. bool -> list 'a -> integer -> 'a -> list 'a
+let update_list is_inc xs n x =
+  if is_inc then update_list_inc xs n x else update_list_dec xs n x
+
+let extract_only_bit = function
+  | [] ->  BU
+  | [e] -> e
+  | _ ->   BU
+end
+
+(*** Machine words *)
+
+val length_mword : forall 'a. mword 'a -> integer
+let inline length_mword w = integerFromNat (word_length w)
+
+val slice_mword_dec : forall 'a 'b. mword 'a -> integer -> integer -> mword 'b
+let slice_mword_dec w i j = word_extract (nat_of_int i) (nat_of_int j) w
+
+val slice_mword_inc : forall 'a 'b. mword 'a -> integer -> integer -> mword 'b
+let slice_mword_inc w i j =
+  let top = (length_mword w) - 1 in
+  slice_mword_dec w (top - i) (top - j)
+
+val slice_mword : forall 'a 'b. bool -> mword 'a -> integer -> integer -> mword 'b
+let slice_mword is_inc w i j = if is_inc then slice_mword_inc w i j else slice_mword_dec w i j
+
+val update_slice_mword_dec : forall 'a 'b. mword 'a -> integer -> integer -> mword 'b -> mword 'a
+let update_slice_mword_dec w i j w' = word_update w (nat_of_int i) (nat_of_int j) w'
+
+val update_slice_mword_inc : forall 'a 'b. mword 'a -> integer -> integer -> mword 'b -> mword 'a
+let update_slice_mword_inc w i j w' =
+  let top = (length_mword w) - 1 in
+  update_slice_mword_dec w (top - i) (top - j) w'
+
+val update_slice_mword : forall 'a 'b. bool -> mword 'a -> integer -> integer -> mword 'b -> mword 'a
+let update_slice_mword is_inc w i j w' =
+  if is_inc then update_slice_mword_inc w i j w' else update_slice_mword_dec w i j w'
+
+val access_mword_dec : forall 'a. mword 'a -> integer -> bitU
+let access_mword_dec w n = bitU_of_bool (getBit w (nat_of_int n))
+
+val access_mword_inc : forall 'a. mword 'a -> integer -> bitU
+let access_mword_inc w n =
+  let top = (length_mword w) - 1 in
+  access_mword_dec w (top - n)
+
+val access_mword : forall 'a. bool -> mword 'a -> integer -> bitU
+let access_mword is_inc w n =
+  if is_inc then access_mword_inc w n else access_mword_dec w n
+
+val update_mword_bool_dec : forall 'a. mword 'a -> integer -> bool -> mword 'a
+let update_mword_bool_dec w n b = setBit w (nat_of_int n) b
+let update_mword_dec w n b = Maybe.map (update_mword_bool_dec w n) (bool_of_bitU b)
+
+val update_mword_bool_inc : forall 'a. mword 'a -> integer -> bool -> mword 'a
+let update_mword_bool_inc w n b =
+  let top = (length_mword w) - 1 in
+  update_mword_bool_dec w (top - n) b
+let update_mword_inc w n b = Maybe.map (update_mword_bool_inc w n) (bool_of_bitU b)
+
+val int_of_mword : forall 'a. bool -> mword 'a -> integer
+let int_of_mword sign w =
+  if sign then signedIntegerFromWord w else unsignedIntegerFromWord w
+
+(* Translating between a type level number (itself 'n) and an integer *)
+
+let size_itself_int x = integerFromNat (size_itself x)
+
+(* NB: the corresponding sail type is forall 'n. atom('n) -> itself('n),
+   the actual integer is ignored. *)
+
+val make_the_value : forall 'n. integer -> itself 'n
+let make_the_value _ = the_value
+
+(*** Bitvectors *)
+
+class (Bitvector 'a)
+  val bits_of : 'a -> list bitU
+  (* We allow of_bits to be partial, as not all bitvector representations
+     support undefined bits *)
+  val of_bits : list bitU -> maybe 'a
+  val of_bools : list bool -> 'a
+  val length : 'a -> integer
+  (* of_int: the first parameter specifies the desired length of the bitvector *)
+  val of_int : integer -> integer -> 'a
+  (* Conversion to integers is undefined if any bit is undefined *)
+  val unsigned : 'a -> maybe integer
+  val signed : 'a -> maybe integer
+  (* Lifting of integer operations to bitvectors:  The boolean flag indicates
+     whether to treat the bitvectors as signed (true) or not (false). *)
+  val arith_op_bv : (integer -> integer -> integer) -> bool -> 'a -> 'a -> 'a
+end
+
+val of_bits_failwith : forall 'a. Bitvector 'a => list bitU -> 'a
+let of_bits_failwith bits = maybe_failwith (of_bits bits)
+
+let int_of_bv sign = if sign then signed else unsigned
+
+instance forall 'a. BitU 'a => (Bitvector (list 'a))
+  let bits_of v = List.map to_bitU v
+  let of_bits v = Just (List.map of_bitU v)
+  let of_bools v = List.map of_bitU (List.map bitU_of_bool v)
+  let of_int len n = List.map of_bitU (bits_of_int len n)
+  let length = length_list
+  let unsigned v = unsigned_of_bits (List.map to_bitU v)
+  let signed v = signed_of_bits (List.map to_bitU v)
+  let arith_op_bv op sign l r = List.map of_bitU (arith_op_bits op sign (List.map to_bitU l) (List.map to_bitU r))
+end
+
+instance forall 'a. Size 'a => (Bitvector (mword 'a))
+  let bits_of v = List.map bitU_of_bool (bitlistFromWord v)
+  let of_bits v = Maybe.map wordFromBitlist (just_list (List.map bool_of_bitU v))
+  let of_bools v = wordFromBitlist v
+  let of_int = (fun _ n -> wordFromInteger n)
+  let length v = integerFromNat (word_length v)
+  let unsigned v = Just (unsignedIntegerFromWord v)
+  let signed v = Just (signedIntegerFromWord v)
+  let arith_op_bv op sign l r = wordFromInteger (op (int_of_mword sign l) (int_of_mword sign r))
+end
+
+let access_bv_inc v n = access_list true  (bits_of v) n
+let access_bv_dec v n = access_list false (bits_of v) n
+
+let update_bv_inc v n b = update_list true  (bits_of v) n b
+let update_bv_dec v n b = update_list false (bits_of v) n b
+
+let subrange_bv_inc v i j = subrange_list true  (bits_of v) i j
+let subrange_bv_dec v i j = subrange_list false (bits_of v) i j
+
+let update_subrange_bv_inc v i j v' = update_subrange_list true  (bits_of v) i j (bits_of v')
+let update_subrange_bv_dec v i j v' = update_subrange_list false (bits_of v) i j (bits_of v')
+
+val extz_bv : forall 'a. Bitvector 'a => integer -> 'a -> list bitU
+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
+  | B0 -> 0
+  | B1 -> 1
+  | _ -> failwith "int_of_bit saw unknown"
+  end
+
+val count_leading_zero_bits : list bitU -> integer
+let rec count_leading_zero_bits v =
+  match v with
+  | B0 :: v' -> count_leading_zero_bits v' + 1
+  | _ -> 0
+  end
+
+val count_leading_zeros_bv : forall 'a. Bitvector 'a => 'a -> integer
+let count_leading_zeros_bv v = count_leading_zero_bits (bits_of v)
+
+val decimal_string_of_bv : forall 'a. Bitvector 'a => 'a -> string
+let decimal_string_of_bv bv =
+  let place_values =
+    List.mapi
+      (fun i b -> (int_of_bit b) * (2 ** i))
+      (List.reverse (bits_of bv))
+  in
+  let sum = List.foldl (+) 0 place_values in
+  show sum
+
+(*** Bytes and addresses *)
+
+type memory_byte = list bitU
+
+val byte_chunks : forall 'a. list 'a -> maybe (list (list 'a))
+let rec byte_chunks bs = match bs with
+  | [] -> Just []
+  | a::b::c::d::e::f::g::h::rest ->
+     Maybe.bind (byte_chunks rest) (fun rest -> Just ([a;b;c;d;e;f;g;h] :: rest))
+  | _ -> Nothing
+end
+declare {isabelle; hol} termination_argument byte_chunks = automatic
+
+val bytes_of_bits : forall 'a. Bitvector 'a => 'a -> maybe (list memory_byte)
+let bytes_of_bits bs = byte_chunks (bits_of bs)
+
+val bits_of_bytes : list memory_byte -> list bitU
+let bits_of_bytes bs = List.concat (List.map bits_of bs)
+
+let mem_bytes_of_bits bs = Maybe.map List.reverse (bytes_of_bits bs)
+let bits_of_mem_bytes bs = bits_of_bytes (List.reverse bs)
+
+(*val bitv_of_byte_lifteds : list Sail_impl_base.byte_lifted -> list bitU
+let bitv_of_byte_lifteds v =
+  foldl (fun x (Byte_lifted y) -> x ++ (List.map bitU_of_bit_lifted y)) [] v
+
+val bitv_of_bytes : list Sail_impl_base.byte -> list bitU
+let bitv_of_bytes v =
+  foldl (fun x (Byte y) -> x ++ (List.map bitU_of_bit y)) [] v
+
+val byte_lifteds_of_bitv : list bitU -> list byte_lifted
+let byte_lifteds_of_bitv bits =
+  let bits = List.map bit_lifted_of_bitU bits in
+  byte_lifteds_of_bit_lifteds bits
+
+val bytes_of_bitv : list bitU -> list byte
+let bytes_of_bitv bits =
+  let bits = List.map bit_of_bitU bits in
+  bytes_of_bits bits
+
+val bit_lifteds_of_bitUs : list bitU -> list bit_lifted
+let bit_lifteds_of_bitUs bits = List.map bit_lifted_of_bitU bits
+
+val bit_lifteds_of_bitv : list bitU -> list bit_lifted
+let bit_lifteds_of_bitv v = bit_lifteds_of_bitUs v
+
+
+val address_lifted_of_bitv : list bitU -> address_lifted
+let address_lifted_of_bitv v =
+  let byte_lifteds = byte_lifteds_of_bitv v in
+  let maybe_address_integer =
+    match (maybe_all (List.map byte_of_byte_lifted byte_lifteds)) with
+    | Just bs -> Just (integer_of_byte_list bs)
+    | _ -> Nothing
+    end in
+  Address_lifted byte_lifteds maybe_address_integer
+
+val bitv_of_address_lifted : address_lifted -> list bitU
+let bitv_of_address_lifted (Address_lifted bs _) = bitv_of_byte_lifteds bs
+
+val address_of_bitv : list bitU -> address
+let address_of_bitv v =
+  let bytes = bytes_of_bitv v in
+  address_of_byte_list bytes*)
+
+let rec reverse_endianness_list bits =
+  if List.length bits <= 8 then bits else
+    reverse_endianness_list (drop_list 8 bits) ++ take_list 8 bits
+
+
+(*** Registers *)
+
+(*type register_field = string
+type register_field_index = string * (integer * integer) (* name, start and end *)
+
+type register =
+  | Register of string * (* name *)
+                integer * (* length *)
+                integer * (* start index *)
+                bool * (* is increasing *)
+                  list register_field_index
+  | UndefinedRegister of integer (* length *)
+  | RegisterPair of register * register*)
+
+type register_ref 'regstate 'regval 'a =
+  <| name : string;
+     (*is_inc : bool;*)
+     read_from : 'regstate -> 'a;
+     write_to : 'a -> 'regstate -> 'regstate;
+     of_regval : 'regval -> maybe 'a;
+     regval_of : 'a -> 'regval |>
+
+(* Register accessors: pair of functions for reading and writing register values *)
+type register_accessors 'regstate 'regval =
+  ((string -> 'regstate -> maybe 'regval) *
+   (string -> 'regval -> 'regstate -> maybe 'regstate))
+
+type field_ref 'regtype 'a =
+  <| field_name : string;
+     field_start : integer;
+     field_is_inc : bool;
+     get_field : 'regtype -> 'a;
+     set_field : 'regtype -> 'a -> 'regtype |>
+
+(*let name_of_reg = function
+  | Register name _ _ _ _ -> name
+  | UndefinedRegister _ -> failwith "name_of_reg UndefinedRegister"
+  | RegisterPair _ _ -> failwith "name_of_reg RegisterPair"
+end
+
+let size_of_reg = function
+  | Register _ size _ _ _ -> size
+  | UndefinedRegister size -> size
+  | RegisterPair _ _ -> failwith "size_of_reg RegisterPair"
+end
+
+let start_of_reg = function
+  | Register _ _ start _ _ -> start
+  | UndefinedRegister _ -> failwith "start_of_reg UndefinedRegister"
+  | RegisterPair _ _ -> failwith "start_of_reg RegisterPair"
+end
+
+let is_inc_of_reg = function
+  | Register _ _ _ is_inc _ -> is_inc
+  | UndefinedRegister _ -> failwith "is_inc_of_reg UndefinedRegister"
+  | RegisterPair _ _ -> failwith "in_inc_of_reg RegisterPair"
+end
+
+let dir_of_reg = function
+  | Register _ _ _ is_inc _ -> dir_of_bool is_inc
+  | UndefinedRegister _ -> failwith "dir_of_reg UndefinedRegister"
+  | RegisterPair _ _ -> failwith "dir_of_reg RegisterPair"
+end
+
+let size_of_reg_nat reg = natFromInteger (size_of_reg reg)
+let start_of_reg_nat reg = natFromInteger (start_of_reg reg)
+
+val register_field_indices_aux : register -> register_field -> maybe (integer * integer)
+let rec register_field_indices_aux register rfield =
+  match register with
+  | Register _ _ _ _ rfields -> List.lookup rfield rfields
+  | RegisterPair r1 r2 ->
+      let m_indices = register_field_indices_aux r1 rfield in
+      if isJust m_indices then m_indices else register_field_indices_aux r2 rfield
+  | UndefinedRegister _ -> Nothing
+  end
+
+val register_field_indices : register -> register_field -> integer * integer
+let register_field_indices register rfield =
+  match register_field_indices_aux register rfield with
+  | Just indices -> indices
+  | Nothing -> failwith "Invalid register/register-field combination"
+  end
+
+let register_field_indices_nat reg regfield=
+  let (i,j) = register_field_indices reg regfield in
+  (natFromInteger i,natFromInteger j)*)
+
+(*let rec external_reg_value reg_name v =
+  let (internal_start, external_start, direction) =
+    match reg_name with
+     | Reg _ start size dir ->
+        (start, (if dir = D_increasing then start else (start - (size +1))), dir)
+     | Reg_slice _ reg_start dir (slice_start, _) ->
+        ((if dir = D_increasing then slice_start else (reg_start - slice_start)),
+         slice_start, dir)
+     | Reg_field _ reg_start dir _ (slice_start, _) ->
+        ((if dir = D_increasing then slice_start else (reg_start - slice_start)),
+         slice_start, dir)
+     | Reg_f_slice _ reg_start dir _ _ (slice_start, _) ->
+        ((if dir = D_increasing then slice_start else (reg_start - slice_start)),
+         slice_start, dir)
+     end in
+  let bits = bit_lifteds_of_bitv v in
+  <| rv_bits           = bits;
+     rv_dir            = direction;
+     rv_start          = external_start;
+     rv_start_internal = internal_start |>
+
+val internal_reg_value : register_value -> list bitU
+let internal_reg_value v =
+  List.map bitU_of_bit_lifted v.rv_bits
+         (*(integerFromNat v.rv_start_internal)
+         (v.rv_dir = D_increasing)*)
+
+
+let external_slice (d:direction) (start:nat) ((i,j):(nat*nat)) =
+  match d with
+  (*This is the case the thread/concurrecny model expects, so no change needed*)
+  | D_increasing -> (i,j)
+  | D_decreasing -> let slice_i = start - i in
+                    let slice_j = (i - j) + slice_i in
+                    (slice_i,slice_j)
+  end *)
+
+(* TODO
+let external_reg_whole r =
+  Reg (r.name) (natFromInteger r.start) (natFromInteger r.size) (dir_of_bool r.is_inc)
+
+let external_reg_slice r (i,j) =
+  let start = natFromInteger r.start in
+  let dir = dir_of_bool r.is_inc in
+  Reg_slice (r.name) start dir (external_slice dir start (i,j))
+
+let external_reg_field_whole reg rfield =
+  let (m,n) = register_field_indices_nat reg rfield in
+  let start = start_of_reg_nat reg in
+  let dir = dir_of_reg reg in
+  Reg_field (name_of_reg reg) start dir rfield (external_slice dir start (m,n))
+
+let external_reg_field_slice reg rfield (i,j) =
+  let (m,n) = register_field_indices_nat reg rfield in
+  let start = start_of_reg_nat reg in
+  let dir = dir_of_reg reg in
+  Reg_f_slice (name_of_reg reg) start dir rfield
+              (external_slice dir start (m,n))
+              (external_slice dir start (i,j))*)
+
+(*val external_mem_value : list bitU -> memory_value
+let external_mem_value v =
+  byte_lifteds_of_bitv v $> List.reverse
+
+val internal_mem_value : memory_value -> list bitU
+let internal_mem_value bytes =
+  List.reverse bytes $> bitv_of_byte_lifteds*)
+
+
+val foreach : forall 'a 'vars.
+  (list 'a) -> 'vars -> ('a -> 'vars -> 'vars) -> 'vars
+let rec foreach l vars body =
+  match l with
+    | [] -> vars
+    | (x :: xs) -> foreach xs (body x vars) body
+  end
+
+declare {isabelle; hol} termination_argument foreach = automatic
+
+val index_list : integer -> integer -> integer -> list integer
+let rec index_list from to step =
+  if (step > 0 && from <= to) || (step < 0 && to <= from) then
+    from :: index_list (from + step) to step
+  else []
+
+val while : forall 'vars. 'vars -> ('vars -> bool) -> ('vars -> 'vars) -> 'vars
+let rec while vars cond body =
+  if cond vars then while (body vars) cond body else vars
+
+val until : forall 'vars. 'vars -> ('vars -> bool) -> ('vars -> 'vars) -> 'vars
+let rec until vars cond body =
+  let vars = body vars in
+  if cond vars then vars else until (body vars) cond body
+
+
+(* convert numbers unsafely to naturals *)
+
+class (ToNatural 'a) val toNatural : 'a -> natural end
+(* eta-expanded for Isabelle output, otherwise it breaks *)
+instance (ToNatural integer) let toNatural = (fun n -> naturalFromInteger n) end
+instance (ToNatural int)     let toNatural = (fun n -> naturalFromInt n)     end
+instance (ToNatural nat)     let toNatural = (fun n -> naturalFromNat n)     end
+instance (ToNatural natural) let toNatural = (fun n -> n)                    end
+
+let toNaturalFiveTup (n1,n2,n3,n4,n5) =
+  (toNatural n1,
+   toNatural n2,
+   toNatural n3,
+   toNatural n4,
+   toNatural n5)
+
+(* Let the following types be generated by Sail per spec, using either bitlists
+   or machine words as bitvector representation *)
+(*type regfp =
+  | RFull of (string)
+  | RSlice of (string * integer * integer)
+  | RSliceBit of (string * integer)
+  | RField of (string * string)
+
+type niafp =
+  | NIAFP_successor
+  | NIAFP_concrete_address of vector bitU
+  | NIAFP_indirect_address
+
+(* only for MIPS *)
+type diafp =
+  | DIAFP_none
+  | DIAFP_concrete of vector bitU
+  | DIAFP_reg of regfp
+
+let regfp_to_reg (reg_info : string -> maybe string -> (nat * nat * direction * (nat * nat))) = function
+  | RFull name ->
+     let (start,length,direction,_) = reg_info name Nothing in
+     Reg name start length direction
+  | RSlice (name,i,j) ->
+     let i = natFromInteger i in
+     let j = natFromInteger j in
+     let (start,length,direction,_) = reg_info name Nothing in
+     let slice = external_slice direction start (i,j) in
+     Reg_slice name start direction slice
+  | RSliceBit (name,i) ->
+     let i = natFromInteger i in
+     let (start,length,direction,_) = reg_info name Nothing in
+     let slice = external_slice direction start (i,i) in
+     Reg_slice name start direction slice
+  | RField (name,field_name) ->
+     let (start,length,direction,span) = reg_info name (Just field_name) in
+     let slice = external_slice direction start span in
+     Reg_field name start direction field_name slice
+end
+
+let niafp_to_nia reginfo = function
+  | NIAFP_successor -> NIA_successor
+  | NIAFP_concrete_address v -> NIA_concrete_address (address_of_bitv v)
+  | NIAFP_indirect_address -> NIA_indirect_address
+end
+
+let diafp_to_dia reginfo = function
+  | DIAFP_none -> DIA_none
+  | DIAFP_concrete v -> DIA_concrete_address (address_of_bitv v)
+  | DIAFP_reg r -> DIA_register (regfp_to_reg reginfo r)
+end
+*)
diff --git a/src/gen_lib/0.11/sail_impl_base.lem b/src/gen_lib/0.11/sail_impl_base.lem
new file mode 100644
index 00000000..421219da
--- /dev/null
+++ b/src/gen_lib/0.11/sail_impl_base.lem
@@ -0,0 +1,1518 @@
+(*========================================================================*)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(*========================================================================*)
+
+open import Pervasives_extra
+
+
+
+class ( EnumerationType 'a ) 
+  val toNat : 'a -> nat
+end
+
+
+val enumeration_typeCompare : forall 'a. EnumerationType 'a => 'a -> 'a -> ordering
+let ~{ocaml} enumeration_typeCompare e1 e2 =
+  compare (toNat e1) (toNat e2)
+let inline {ocaml} enumeration_typeCompare = defaultCompare
+
+ 
+default_instance forall 'a. EnumerationType 'a => (Ord 'a)
+  let compare = enumeration_typeCompare
+  let (<)  r1 r2 = (enumeration_typeCompare r1 r2) = LT
+  let (<=) r1 r2 = (enumeration_typeCompare r1 r2) <> GT
+  let (>)  r1 r2 = (enumeration_typeCompare r1 r2) = GT
+  let (>=) r1 r2 = (enumeration_typeCompare r1 r2) <> LT
+end
+
+
+
+(* maybe isn't a member of type Ord - this should be in the Lem standard library*)
+instance forall 'a. Ord 'a => (Ord (maybe 'a))
+  let compare = maybeCompare compare
+  let (<)  r1 r2 = (maybeCompare compare r1 r2) = LT
+  let (<=) r1 r2 = (maybeCompare compare r1 r2) <> GT
+  let (>)  r1 r2 = (maybeCompare compare r1 r2) = GT
+  let (>=) r1 r2 = (maybeCompare compare r1 r2) <> LT
+end
+
+type word8 = nat (* bounded at a byte, for when lem supports it*)
+
+type end_flag =
+  | E_big_endian
+  | E_little_endian
+
+type bit =
+  | Bitc_zero
+  | Bitc_one
+
+type bit_lifted = 
+  | Bitl_zero
+  | Bitl_one
+  | Bitl_undef    (* used for modelling h/w arch unspecified bits *)
+  | Bitl_unknown  (* used for interpreter analysis exhaustive execution *)
+
+type direction = 
+  | D_increasing
+  | D_decreasing
+
+(* at some point this should probably not mention bit_lifted anymore *)
+type register_value = <| 
+    rv_bits: list bit_lifted (* MSB first, smallest index number *); 
+    rv_dir: direction; 
+    rv_start: nat ;
+    rv_start_internal: nat; 
+    (*when dir is increasing, rv_start = rv_start_internal. 
+      Otherwise, tells interpreter how to reconstruct a proper decreasing value*)
+    |>
+
+type byte_lifted = Byte_lifted of list bit_lifted (* of length 8 *) (*MSB first everywhere*)
+
+type instruction_field_value = list bit
+
+type byte = Byte of list bit (* of length 8 *)  (*MSB first everywhere*) 
+
+type address_lifted = Address_lifted of list byte_lifted (* of length 8 for 64bit machines*) * maybe integer
+(* for both values of end_flag, MSBy first *)
+
+type memory_byte = byte_lifted (* of length 8 *) (*MSB first everywhere*)
+
+type memory_value = list memory_byte
+(* the list is of length >=1 *)
+(* the head of the list is the byte stored at the lowest address;
+when calling a Sail function with a wmv effect, the least significant 8
+bits of the bit vector passed to the function will be interpreted as
+the lowest address byte; similarly, when calling a Sail function with
+rmem effect, the lowest address byte will be placed in the least
+significant 8 bits of the bit vector returned by the function; this
+behaviour is consistent with little-endian. *)
+
+
+(* not sure which of these is more handy yet *)
+type address = Address of list byte (* of length 8 *) * integer
+(* type address = Address of integer *)
+
+type opcode = Opcode of list byte (* of length 4 *)
+
+(** typeclass instantiations *)
+
+let ~{ocaml} bitCompare (b1:bit) (b2:bit) =
+  match (b1,b2) with
+  | (Bitc_zero, Bitc_zero) -> EQ
+  | (Bitc_one, Bitc_one) -> EQ
+  | (Bitc_zero, _) -> LT
+  | (_,_) -> GT
+  end
+let inline {ocaml} bitCompare = defaultCompare
+
+let ~{ocaml} bitLess b1 b2      = bitCompare b1 b2 =  LT
+let ~{ocaml} bitLessEq b1 b2    = bitCompare b1 b2 <> GT
+let ~{ocaml} bitGreater b1 b2   = bitCompare b1 b2 =  GT
+let ~{ocaml} bitGreaterEq b1 b2 = bitCompare b1 b2 <> LT
+
+let inline {ocaml} bitLess      = defaultLess
+let inline {ocaml} bitLessEq    = defaultLessEq
+let inline {ocaml} bitGreater   = defaultGreater
+let inline {ocaml} bitGreaterEq = defaultGreaterEq
+
+instance (Ord bit)
+  let compare = bitCompare
+  let (<)  = bitLess
+  let (<=) = bitLessEq
+  let (>)  = bitGreater
+  let (>=) = bitGreaterEq
+end
+
+let ~{ocaml} bit_liftedCompare (bl1:bit_lifted) (bl2:bit_lifted) =
+  match (bl1,bl2) with
+  | (Bitl_zero, Bitl_zero) -> EQ
+  | (Bitl_zero,_) -> LT
+  | (Bitl_one, Bitl_zero) -> GT
+  | (Bitl_one, Bitl_one) -> EQ
+  | (Bitl_one, _) -> LT
+  | (Bitl_undef,Bitl_zero) -> GT
+  | (Bitl_undef,Bitl_one) -> GT
+  | (Bitl_undef,Bitl_undef) -> EQ
+  | (Bitl_undef,_) -> LT
+  | (Bitl_unknown,Bitl_unknown) -> EQ
+  | (Bitl_unknown,_) -> GT
+  end
+let inline {ocaml} bit_liftedCompare = defaultCompare
+
+let ~{ocaml} bit_liftedLess b1 b2      = bit_liftedCompare b1 b2 =  LT
+let ~{ocaml} bit_liftedLessEq b1 b2    = bit_liftedCompare b1 b2 <> GT
+let ~{ocaml} bit_liftedGreater b1 b2   = bit_liftedCompare b1 b2 =  GT
+let ~{ocaml} bit_liftedGreaterEq b1 b2 = bit_liftedCompare b1 b2 <> LT
+
+let inline {ocaml} bit_liftedLess      = defaultLess
+let inline {ocaml} bit_liftedLessEq    = defaultLessEq
+let inline {ocaml} bit_liftedGreater   = defaultGreater
+let inline {ocaml} bit_liftedGreaterEq = defaultGreaterEq
+
+instance (Ord bit_lifted)
+  let compare = bit_liftedCompare
+  let (<)  = bit_liftedLess
+  let (<=) = bit_liftedLessEq
+  let (>)  = bit_liftedGreater
+  let (>=) = bit_liftedGreaterEq
+end
+
+let ~{ocaml} byte_liftedCompare (Byte_lifted b1) (Byte_lifted b2) = compare b1 b2
+let inline {ocaml} byte_liftedCompare = defaultCompare
+
+let ~{ocaml} byte_liftedLess b1 b2      = byte_liftedCompare b1 b2 =  LT
+let ~{ocaml} byte_liftedLessEq b1 b2    = byte_liftedCompare b1 b2 <> GT
+let ~{ocaml} byte_liftedGreater b1 b2   = byte_liftedCompare b1 b2 =  GT
+let ~{ocaml} byte_liftedGreaterEq b1 b2 = byte_liftedCompare b1 b2 <> LT
+
+let inline {ocaml} byte_liftedLess      = defaultLess
+let inline {ocaml} byte_liftedLessEq    = defaultLessEq
+let inline {ocaml} byte_liftedGreater   = defaultGreater
+let inline {ocaml} byte_liftedGreaterEq = defaultGreaterEq
+
+instance (Ord byte_lifted)
+  let compare = byte_liftedCompare
+  let (<)  = byte_liftedLess
+  let (<=) = byte_liftedLessEq
+  let (>)  = byte_liftedGreater
+  let (>=) = byte_liftedGreaterEq
+end
+
+let ~{ocaml} byteCompare (Byte b1) (Byte b2) = compare b1 b2
+let inline {ocaml} byteCompare = defaultCompare
+
+let ~{ocaml} byteLess b1 b2      = byteCompare b1 b2 =  LT
+let ~{ocaml} byteLessEq b1 b2    = byteCompare b1 b2 <> GT
+let ~{ocaml} byteGreater b1 b2   = byteCompare b1 b2 =  GT
+let ~{ocaml} byteGreaterEq b1 b2 = byteCompare b1 b2 <> LT
+
+let inline {ocaml} byteLess      = defaultLess
+let inline {ocaml} byteLessEq    = defaultLessEq
+let inline {ocaml} byteGreater   = defaultGreater
+let inline {ocaml} byteGreaterEq = defaultGreaterEq
+
+instance (Ord byte)
+  let compare = byteCompare
+  let (<)  = byteLess
+  let (<=) = byteLessEq
+  let (>)  = byteGreater
+  let (>=) = byteGreaterEq
+end
+
+let ~{ocaml} opcodeCompare (Opcode o1) (Opcode o2) =
+  compare o1 o2
+let {ocaml} opcodeCompare = defaultCompare
+
+let ~{ocaml} opcodeLess b1 b2      = opcodeCompare b1 b2 =  LT
+let ~{ocaml} opcodeLessEq b1 b2    = opcodeCompare b1 b2 <> GT
+let ~{ocaml} opcodeGreater b1 b2   = opcodeCompare b1 b2 =  GT
+let ~{ocaml} opcodeGreaterEq b1 b2 = opcodeCompare b1 b2 <> LT
+
+let inline {ocaml} opcodeLess      = defaultLess
+let inline {ocaml} opcodeLessEq    = defaultLessEq
+let inline {ocaml} opcodeGreater   = defaultGreater
+let inline {ocaml} opcodeGreaterEq = defaultGreaterEq
+
+instance (Ord opcode)
+  let compare = opcodeCompare
+  let (<)  = opcodeLess
+  let (<=) = opcodeLessEq
+  let (>)  = opcodeGreater
+  let (>=) = opcodeGreaterEq
+end
+
+let addressCompare (Address b1 i1) (Address b2 i2) = compare i1 i2
+(* this cannot be defaultCompare for OCaml because addresses contain big ints *)
+
+let addressLess b1 b2      = addressCompare b1 b2 =  LT
+let addressLessEq b1 b2    = addressCompare b1 b2 <> GT
+let addressGreater b1 b2   = addressCompare b1 b2 =  GT
+let addressGreaterEq b1 b2 = addressCompare b1 b2 <> LT
+
+instance (SetType address)
+  let setElemCompare = addressCompare
+end
+
+instance (Ord address)
+  let compare = addressCompare
+  let (<)  = addressLess
+  let (<=) = addressLessEq
+  let (>)  = addressGreater
+  let (>=) = addressGreaterEq
+end
+
+let {coq; ocaml} addressEqual a1 a2 = (addressCompare a1 a2) = EQ
+let inline {hol; isabelle} addressEqual = unsafe_structural_equality
+
+let {coq; ocaml} addressInequal a1 a2 = not (addressEqual a1 a2)
+let inline {hol; isabelle} addressInequal = unsafe_structural_inequality
+
+instance  (Eq address)
+  let (=)  = addressEqual
+  let (<>) = addressInequal
+end
+
+let ~{ocaml} directionCompare d1 d2 =
+  match (d1, d2) with
+  | (D_decreasing, D_increasing) -> GT
+  | (D_increasing, D_decreasing) -> LT
+  | _ -> EQ
+  end
+let inline {ocaml} directionCompare = defaultCompare
+
+let ~{ocaml} directionLess b1 b2      = directionCompare b1 b2 =  LT
+let ~{ocaml} directionLessEq b1 b2    = directionCompare b1 b2 <> GT
+let ~{ocaml} directionGreater b1 b2   = directionCompare b1 b2 =  GT
+let ~{ocaml} directionGreaterEq b1 b2 = directionCompare b1 b2 <> LT
+
+let inline {ocaml} directionLess      = defaultLess
+let inline {ocaml} directionLessEq    = defaultLessEq
+let inline {ocaml} directionGreater   = defaultGreater
+let inline {ocaml} directionGreaterEq = defaultGreaterEq
+
+instance (Ord direction)
+  let compare = directionCompare
+  let (<)  = directionLess
+  let (<=) = directionLessEq
+  let (>)  = directionGreater
+  let (>=) = directionGreaterEq
+end
+
+instance (Show direction)
+  let show = function D_increasing -> "D_increasing" | D_decreasing  -> "D_decreasing" end
+end
+
+let ~{ocaml} register_valueCompare rv1 rv2 =
+  compare (rv1.rv_bits, rv1.rv_dir, rv1.rv_start, rv1.rv_start_internal)
+          (rv2.rv_bits, rv2.rv_dir, rv2.rv_start, rv2.rv_start_internal)
+let inline {ocaml} register_valueCompare = defaultCompare
+
+let ~{ocaml} register_valueLess b1 b2      = register_valueCompare b1 b2 =  LT
+let ~{ocaml} register_valueLessEq b1 b2    = register_valueCompare b1 b2 <> GT
+let ~{ocaml} register_valueGreater b1 b2   = register_valueCompare b1 b2 =  GT
+let ~{ocaml} register_valueGreaterEq b1 b2 = register_valueCompare b1 b2 <> LT
+
+let inline {ocaml} register_valueLess      = defaultLess
+let inline {ocaml} register_valueLessEq    = defaultLessEq
+let inline {ocaml} register_valueGreater   = defaultGreater
+let inline {ocaml} register_valueGreaterEq = defaultGreaterEq
+
+instance (Ord register_value)
+  let compare = register_valueCompare
+  let (<)  = register_valueLess
+  let (<=) = register_valueLessEq
+  let (>)  = register_valueGreater
+  let (>=) = register_valueGreaterEq
+end
+
+let address_liftedCompare (Address_lifted b1 i1) (Address_lifted b2 i2) =
+  compare (i1,b1) (i2,b2)
+(* this cannot be defaultCompare for OCaml because address_lifteds contain big
+   ints *)
+
+let address_liftedLess b1 b2      = address_liftedCompare b1 b2 =  LT
+let address_liftedLessEq b1 b2    = address_liftedCompare b1 b2 <> GT
+let address_liftedGreater b1 b2   = address_liftedCompare b1 b2 =  GT
+let address_liftedGreaterEq b1 b2 = address_liftedCompare b1 b2 <> LT
+
+instance (Ord address_lifted)
+  let compare = address_liftedCompare
+  let (<)  = address_liftedLess
+  let (<=) = address_liftedLessEq
+  let (>)  = address_liftedGreater
+  let (>=) = address_liftedGreaterEq
+end
+
+(* Registers *)
+type slice = (nat * nat)
+
+type reg_name = 
+  (* do we really need this here if ppcmem already has this information by itself? *)
+| Reg of string * nat * nat * direction
+(*Name of the register, accessing the entire register, the start and size of this register, and its direction *)
+
+| Reg_slice of string * nat * direction * slice 
+(* Name of the register, accessing from the bit indexed by the first
+to the bit indexed by the second integer of the slice, inclusive. For
+machineDef* the first is a smaller number or equal to the second, adjusted
+to reflect the correct span direction in the interpreter side.  *)
+
+| Reg_field of string * nat * direction * string * slice 
+(*Name of the register, start and direction, and name of the field of the register
+accessed. The slice specifies where this field is in the register*)
+
+| Reg_f_slice of string * nat * direction * string * slice * slice 
+(* The first four components are as in Reg_field; the final slice
+specifies a part of the field, indexed w.r.t. the register as a whole *)
+
+let register_base_name : reg_name -> string = function
+  | Reg s _ _ _             -> s
+  | Reg_slice s _ _ _       -> s
+  | Reg_field s _ _ _ _     -> s
+  | Reg_f_slice s _ _ _ _ _ -> s
+  end
+
+let slice_of_reg_name : reg_name -> slice = function
+  | Reg _ start width D_increasing -> (start, start + width -1)
+  | Reg _ start width D_decreasing -> (start - width - 1, start)
+  | Reg_slice _ _ _ sl             -> sl
+  | Reg_field _ _ _ _ sl           -> sl
+  | Reg_f_slice _ _ _ _ _ sl       -> sl
+  end
+
+let width_of_reg_name (r: reg_name) : nat =
+  let width_of_slice (i, j) = (* j - i + 1 in *)
+
+    (integerFromNat j) - (integerFromNat i) + 1
+    $> abs $> natFromInteger
+  in
+  match r with
+  | Reg _ _ width _          -> width
+  | Reg_slice _ _ _ sl       -> width_of_slice sl
+  | Reg_field _ _ _ _ sl     -> width_of_slice sl
+  | Reg_f_slice _ _ _ _ _ sl -> width_of_slice sl
+  end
+
+let reg_name_non_empty_intersection (r: reg_name) (r': reg_name) : bool = 
+  register_base_name r = register_base_name r' &&
+  let (i1,  i2)  = slice_of_reg_name r in
+  let (i1', i2') = slice_of_reg_name r' in
+  i1' <= i2 && i2' >= i1
+
+let reg_nameCompare r1 r2 = 
+  compare (register_base_name r1,slice_of_reg_name r1)
+          (register_base_name r2,slice_of_reg_name r2)
+
+let reg_nameLess b1 b2      = reg_nameCompare b1 b2 =  LT
+let reg_nameLessEq b1 b2    = reg_nameCompare b1 b2 <> GT
+let reg_nameGreater b1 b2   = reg_nameCompare b1 b2 =  GT
+let reg_nameGreaterEq b1 b2 = reg_nameCompare b1 b2 <> LT
+
+instance (Ord reg_name)
+  let compare = reg_nameCompare
+  let (<)  = reg_nameLess
+  let (<=) = reg_nameLessEq
+  let (>)  = reg_nameGreater
+  let (>=) = reg_nameGreaterEq
+end
+
+let {coq;ocaml} reg_nameEqual a1 a2 = (reg_nameCompare a1 a2) = EQ
+let {hol;isabelle} reg_nameEqual = unsafe_structural_equality
+let {coq;ocaml} reg_nameInequal a1 a2 = not (reg_nameEqual a1 a2)
+let {hol;isabelle} reg_nameInequal = unsafe_structural_inequality
+
+instance (Eq reg_name)
+  let (=)  = reg_nameEqual
+  let (<>) = reg_nameInequal
+end
+
+instance (SetType reg_name)
+  let setElemCompare = reg_nameCompare
+end
+
+let direction_of_reg_name r = match r with
+  | Reg _ _ _ d -> d
+  | Reg_slice _ _ d _ -> d
+  | Reg_field _ _ d _ _ -> d
+  | Reg_f_slice _ _ d _ _ _ -> d
+ end
+
+let start_of_reg_name r = match r with
+  | Reg _ start _ _ -> start
+  | Reg_slice _ start _ _ -> start
+  | Reg_field _ start _ _ _ -> start
+  | Reg_f_slice _ start _ _ _ _ -> start
+end
+
+(* Data structures for building up instructions *)
+
+(* careful: changes in the read/write/barrier kinds have to be
+   reflected in deep_shallow_convert *)
+type read_kind =
+  (* common reads *)
+  | Read_plain
+  (* Power reads *)
+  | Read_reserve
+  (* AArch64 reads *)
+  | Read_acquire | Read_exclusive | Read_exclusive_acquire | Read_stream
+  (* RISC-V reads *)
+  | Read_RISCV_acquire  | Read_RISCV_strong_acquire
+  | Read_RISCV_reserved | Read_RISCV_reserved_acquire
+  | Read_RISCV_reserved_strong_acquire
+  (* x86 reads *)
+  | Read_X86_locked (* the read part of a lock'd instruction (rmw) *)
+
+instance (Show read_kind)
+  let show = function
+    | Read_plain -> "Read_plain"
+    | Read_reserve -> "Read_reserve"
+    | Read_acquire -> "Read_acquire"
+    | Read_exclusive -> "Read_exclusive"
+    | Read_exclusive_acquire -> "Read_exclusive_acquire"
+    | Read_stream -> "Read_stream"
+    | Read_RISCV_acquire -> "Read_RISCV_acquire"
+    | Read_RISCV_strong_acquire -> "Read_RISCV_strong_acquire"
+    | Read_RISCV_reserved -> "Read_RISCV_reserved"
+    | Read_RISCV_reserved_acquire -> "Read_RISCV_reserved_acquire"
+    | Read_RISCV_reserved_strong_acquire -> "Read_RISCV_reserved_strong_acquire"
+    | Read_X86_locked -> "Read_X86_locked"
+  end
+end
+
+type write_kind =
+  (* common writes *)
+  | Write_plain
+  (* Power writes *)
+  | Write_conditional
+  (* AArch64 writes *)
+  | Write_release | Write_exclusive | Write_exclusive_release
+  (* RISC-V *)
+  | Write_RISCV_release     | Write_RISCV_strong_release
+  | Write_RISCV_conditional | Write_RISCV_conditional_release
+  | Write_RISCV_conditional_strong_release
+  (* x86 writes *)
+  | Write_X86_locked (* the write part of a lock'd instruction (rmw) *)
+
+instance (Show write_kind)
+  let show = function
+    | Write_plain -> "Write_plain"
+    | Write_conditional -> "Write_conditional"
+    | Write_release -> "Write_release"
+    | Write_exclusive -> "Write_exclusive"
+    | Write_exclusive_release -> "Write_exclusive_release"
+    | Write_RISCV_release -> "Write_RISCV_release"
+    | Write_RISCV_strong_release -> "Write_RISCV_strong_release"
+    | Write_RISCV_conditional -> "Write_RISCV_conditional"
+    | Write_RISCV_conditional_release -> "Write_RISCV_conditional_release"
+    | Write_RISCV_conditional_strong_release -> "Write_RISCV_conditional_strong_release"
+    | Write_X86_locked -> "Write_X86_locked"
+  end
+end
+
+type barrier_kind =
+  (* Power barriers *)
+  Barrier_Sync | Barrier_LwSync | Barrier_Eieio | Barrier_Isync
+  (* AArch64 barriers *)
+  | Barrier_DMB | Barrier_DMB_ST | Barrier_DMB_LD | Barrier_DSB
+  | Barrier_DSB_ST | Barrier_DSB_LD | Barrier_ISB
+  | Barrier_TM_COMMIT
+  (* MIPS barriers *)
+  | Barrier_MIPS_SYNC
+  (* RISC-V barriers *)
+  | Barrier_RISCV_rw_rw
+  | Barrier_RISCV_r_rw
+  | Barrier_RISCV_r_r
+  | Barrier_RISCV_rw_w
+  | Barrier_RISCV_w_w
+  | Barrier_RISCV_i
+  (* X86 *)
+  | Barrier_x86_MFENCE
+
+
+instance (Show barrier_kind)
+  let show = function
+    | Barrier_Sync -> "Barrier_Sync"
+    | Barrier_LwSync -> "Barrier_LwSync"
+    | Barrier_Eieio -> "Barrier_Eieio"
+    | Barrier_Isync -> "Barrier_Isync"
+    | Barrier_DMB -> "Barrier_DMB"
+    | Barrier_DMB_ST -> "Barrier_DMB_ST"
+    | Barrier_DMB_LD -> "Barrier_DMB_LD"
+    | Barrier_DSB -> "Barrier_DSB"
+    | Barrier_DSB_ST -> "Barrier_DSB_ST"
+    | Barrier_DSB_LD -> "Barrier_DSB_LD"
+    | Barrier_ISB -> "Barrier_ISB"
+    | Barrier_TM_COMMIT -> "Barrier_TM_COMMIT"
+    | Barrier_MIPS_SYNC -> "Barrier_MIPS_SYNC"
+    | Barrier_RISCV_rw_rw -> "Barrier_RISCV_rw_rw"
+    | Barrier_RISCV_r_rw  -> "Barrier_RISCV_r_rw"
+    | Barrier_RISCV_r_r   -> "Barrier_RISCV_r_r"
+    | Barrier_RISCV_rw_w  -> "Barrier_RISCV_rw_w"
+    | Barrier_RISCV_w_w   -> "Barrier_RISCV_w_w"
+    | Barrier_RISCV_i     -> "Barrier_RISCV_i"
+    | Barrier_x86_MFENCE  -> "Barrier_x86_MFENCE"
+  end
+end
+
+type trans_kind =
+  (* AArch64 *)
+  | Transaction_start | Transaction_commit | Transaction_abort
+
+instance (Show trans_kind)
+  let show = function
+  | Transaction_start  -> "Transaction_start"
+  | Transaction_commit -> "Transaction_commit"
+  | Transaction_abort  -> "Transaction_abort"
+  end
+end
+
+type instruction_kind = 
+  | IK_barrier   of barrier_kind
+  | IK_mem_read  of read_kind
+  | IK_mem_write of write_kind
+  | IK_mem_rmw   of (read_kind * write_kind)
+  | IK_cond_branch
+  (* unconditional branches are not distinguished in the instruction_kind;
+  they just have particular nias (and will be IK_simple *)
+  (* | IK_uncond_branch *)
+  | IK_trans     of trans_kind
+  | IK_simple
+
+
+instance (Show instruction_kind)
+  let show = function
+    | IK_barrier barrier_kind -> "IK_barrier " ^ (show barrier_kind)
+    | IK_mem_read read_kind -> "IK_mem_read " ^ (show read_kind)
+    | IK_mem_write write_kind -> "IK_mem_write " ^ (show write_kind)
+    | IK_cond_branch -> "IK_cond_branch"
+    | IK_trans trans_kind -> "IK_trans " ^ (show trans_kind)
+    | IK_simple -> "IK_simple"
+  end
+end
+
+
+
+let ~{ocaml} read_kindCompare rk1 rk2 =
+  match (rk1, rk2) with
+  | (Read_plain, Read_plain)             -> EQ
+  | (Read_plain, Read_reserve)           -> LT
+  | (Read_plain, Read_acquire)           -> LT
+  | (Read_plain, Read_exclusive)         -> LT
+  | (Read_plain, Read_exclusive_acquire) -> LT
+  | (Read_plain, Read_stream)            -> LT
+
+  | (Read_reserve, Read_plain)             -> GT
+  | (Read_reserve, Read_reserve)           -> EQ
+  | (Read_reserve, Read_acquire)           -> LT
+  | (Read_reserve, Read_exclusive)         -> LT
+  | (Read_reserve, Read_exclusive_acquire) -> LT
+  | (Read_reserve, Read_stream)            -> LT
+
+  | (Read_acquire, Read_plain)             -> GT
+  | (Read_acquire, Read_reserve)           -> GT
+  | (Read_acquire, Read_acquire)           -> EQ
+  | (Read_acquire, Read_exclusive)         -> LT
+  | (Read_acquire, Read_exclusive_acquire) -> LT
+  | (Read_acquire, Read_stream)            -> LT
+
+  | (Read_exclusive, Read_plain)             -> GT
+  | (Read_exclusive, Read_reserve)           -> GT
+  | (Read_exclusive, Read_acquire)           -> GT
+  | (Read_exclusive, Read_exclusive)         -> EQ
+  | (Read_exclusive, Read_exclusive_acquire) -> LT
+  | (Read_exclusive, Read_stream)            -> LT
+
+  | (Read_exclusive_acquire, Read_plain)             -> GT
+  | (Read_exclusive_acquire, Read_reserve)           -> GT
+  | (Read_exclusive_acquire, Read_acquire)           -> GT
+  | (Read_exclusive_acquire, Read_exclusive)         -> GT
+  | (Read_exclusive_acquire, Read_exclusive_acquire) -> EQ
+  | (Read_exclusive_acquire, Read_stream)            -> GT
+
+  | (Read_stream, Read_plain)             -> GT
+  | (Read_stream, Read_reserve)           -> GT
+  | (Read_stream, Read_acquire)           -> GT
+  | (Read_stream, Read_exclusive)         -> GT
+  | (Read_stream, Read_exclusive_acquire) -> GT
+  | (Read_stream, Read_stream)            -> EQ
+end
+let inline {ocaml} read_kindCompare = defaultCompare
+
+let ~{ocaml} read_kindLess b1 b2      = read_kindCompare b1 b2 =  LT
+let ~{ocaml} read_kindLessEq b1 b2    = read_kindCompare b1 b2 <> GT
+let ~{ocaml} read_kindGreater b1 b2   = read_kindCompare b1 b2 =  GT
+let ~{ocaml} read_kindGreaterEq b1 b2 = read_kindCompare b1 b2 <> LT
+
+let inline {ocaml} read_kindLess      = defaultLess
+let inline {ocaml} read_kindLessEq    = defaultLessEq
+let inline {ocaml} read_kindGreater   = defaultGreater
+let inline {ocaml} read_kindGreaterEq = defaultGreaterEq
+
+instance (Ord read_kind)
+  let compare = read_kindCompare
+  let (<)  = read_kindLess
+  let (<=) = read_kindLessEq
+  let (>)  = read_kindGreater
+  let (>=) = read_kindGreaterEq
+end
+
+let ~{ocaml} write_kindCompare wk1 wk2 =
+  match (wk1, wk2) with
+  | (Write_plain, Write_plain)             -> EQ
+  | (Write_plain, Write_conditional)       -> LT
+  | (Write_plain, Write_release)           -> LT
+  | (Write_plain, Write_exclusive)         -> LT
+  | (Write_plain, Write_exclusive_release) -> LT
+
+  | (Write_conditional, Write_plain)             -> GT
+  | (Write_conditional, Write_conditional)       -> EQ
+  | (Write_conditional, Write_release)           -> LT
+  | (Write_conditional, Write_exclusive)         -> LT
+  | (Write_conditional, Write_exclusive_release) -> LT
+
+  | (Write_release, Write_plain)             -> GT
+  | (Write_release, Write_conditional)       -> GT
+  | (Write_release, Write_release)           -> EQ
+  | (Write_release, Write_exclusive)         -> LT
+  | (Write_release, Write_exclusive_release) -> LT
+
+  | (Write_exclusive, Write_plain)             -> GT
+  | (Write_exclusive, Write_conditional)       -> GT
+  | (Write_exclusive, Write_release)           -> GT
+  | (Write_exclusive, Write_exclusive)         -> EQ
+  | (Write_exclusive, Write_exclusive_release) -> LT
+
+  | (Write_exclusive_release, Write_plain)             -> GT
+  | (Write_exclusive_release, Write_conditional)       -> GT
+  | (Write_exclusive_release, Write_release)           -> GT
+  | (Write_exclusive_release, Write_exclusive)         -> GT
+  | (Write_exclusive_release, Write_exclusive_release) -> EQ
+end
+let inline {ocaml} write_kindCompare = defaultCompare
+
+let ~{ocaml} write_kindLess b1 b2      = write_kindCompare b1 b2 =  LT
+let ~{ocaml} write_kindLessEq b1 b2    = write_kindCompare b1 b2 <> GT
+let ~{ocaml} write_kindGreater b1 b2   = write_kindCompare b1 b2 =  GT
+let ~{ocaml} write_kindGreaterEq b1 b2 = write_kindCompare b1 b2 <> LT
+
+let inline {ocaml} write_kindLess      = defaultLess
+let inline {ocaml} write_kindLessEq    = defaultLessEq
+let inline {ocaml} write_kindGreater   = defaultGreater
+let inline {ocaml} write_kindGreaterEq = defaultGreaterEq
+
+instance (Ord write_kind)
+  let compare = write_kindCompare
+  let (<)  = write_kindLess
+  let (<=) = write_kindLessEq
+  let (>)  = write_kindGreater
+  let (>=) = write_kindGreaterEq
+end
+
+(* Barrier comparison that uses less memory in Isabelle/HOL *)
+let ~{ocaml} barrier_number = function
+    | Barrier_Sync -> (0 : natural)
+    | Barrier_LwSync -> 1
+    | Barrier_Eieio -> 2
+    | Barrier_Isync -> 3
+    | Barrier_DMB -> 4
+    | Barrier_DMB_ST -> 5
+    | Barrier_DMB_LD -> 6
+    | Barrier_DSB -> 7
+    | Barrier_DSB_ST -> 8
+    | Barrier_DSB_LD -> 9
+    | Barrier_ISB -> 10
+    | Barrier_TM_COMMIT -> 11
+    | Barrier_MIPS_SYNC -> 12
+    | Barrier_RISCV_rw_rw -> 13
+    | Barrier_RISCV_r_rw -> 14
+    | Barrier_RISCV_r_r -> 15
+    | Barrier_RISCV_rw_w -> 16
+    | Barrier_RISCV_w_w -> 17
+    | Barrier_RISCV_i -> 18
+    | Barrier_x86_MFENCE -> 19
+  end
+
+let ~{ocaml} barrier_kindCompare bk1 bk2 =
+  let n1 = barrier_number bk1 in
+  let n2 = barrier_number bk2 in
+  if n1 < n2 then LT
+  else if n1 = n2 then EQ
+  else GT
+let inline {ocaml} barrier_kindCompare = defaultCompare
+
+(*let ~{ocaml} barrier_kindCompare bk1 bk2 =
+  match (bk1, bk2) with
+  | (Barrier_Sync, Barrier_Sync) -> EQ
+  | (Barrier_Sync, _) -> LT
+  | (_, Barrier_Sync) -> GT
+
+  | (Barrier_LwSync, Barrier_LwSync) -> EQ
+  | (Barrier_LwSync, _) -> LT
+  | (_, Barrier_LwSync) -> GT
+
+  | (Barrier_Eieio, Barrier_Eieio) -> EQ
+  | (Barrier_Eieio, _) -> LT
+  | (_, Barrier_Eieio) -> GT
+
+  | (Barrier_Isync, Barrier_Isync) -> EQ
+  | (Barrier_Isync, _) -> LT
+  | (_, Barrier_Isync) -> GT
+
+  | (Barrier_DMB, Barrier_DMB) -> EQ
+  | (Barrier_DMB, _) -> LT
+  | (_, Barrier_DMB) -> GT
+
+  | (Barrier_DMB_ST, Barrier_DMB_ST) -> EQ
+  | (Barrier_DMB_ST, _) -> LT
+  | (_, Barrier_DMB_ST) -> GT
+
+  | (Barrier_DMB_LD, Barrier_DMB_LD) -> EQ
+  | (Barrier_DMB_LD, _) -> LT
+  | (_, Barrier_DMB_LD) -> GT
+
+  | (Barrier_DSB, Barrier_DSB) -> EQ
+  | (Barrier_DSB, _) -> LT
+  | (_, Barrier_DSB) -> GT
+
+  | (Barrier_DSB_ST, Barrier_DSB_ST) -> EQ
+  | (Barrier_DSB_ST, _) -> LT
+  | (_, Barrier_DSB_ST) -> GT
+
+  | (Barrier_DSB_LD, Barrier_DSB_LD) -> EQ
+  | (Barrier_DSB_LD, _) -> LT
+  | (_, Barrier_DSB_LD) -> GT
+                          
+  | (Barrier_ISB, Barrier_ISB) -> EQ
+  | (Barrier_ISB, _) -> LT
+  | (_, Barrier_ISB) -> GT
+
+  | (Barrier_TM_COMMIT, Barrier_TM_COMMIT) -> EQ
+  | (Barrier_TM_COMMIT, _) -> LT
+  | (_, Barrier_TM_COMMIT) -> GT
+
+  | (Barrier_MIPS_SYNC, Barrier_MIPS_SYNC) -> EQ
+  (* | (Barrier_MIPS_SYNC, _) -> LT
+  | (_, Barrier_MIPS_SYNC) -> GT *)
+
+  end*)
+
+let ~{ocaml} barrier_kindLess b1 b2      = barrier_kindCompare b1 b2 =  LT
+let ~{ocaml} barrier_kindLessEq b1 b2    = barrier_kindCompare b1 b2 <> GT
+let ~{ocaml} barrier_kindGreater b1 b2   = barrier_kindCompare b1 b2 =  GT
+let ~{ocaml} barrier_kindGreaterEq b1 b2 = barrier_kindCompare b1 b2 <> LT
+
+let inline {ocaml} barrier_kindLess      = defaultLess
+let inline {ocaml} barrier_kindLessEq    = defaultLessEq
+let inline {ocaml} barrier_kindGreater   = defaultGreater
+let inline {ocaml} barrier_kindGreaterEq = defaultGreaterEq
+
+instance (Ord barrier_kind)
+  let compare = barrier_kindCompare
+  let (<)  = barrier_kindLess
+  let (<=) = barrier_kindLessEq
+  let (>)  = barrier_kindGreater
+  let (>=) = barrier_kindGreaterEq
+end
+
+type event = 
+  | E_read_mem of read_kind * address_lifted * nat * maybe (list reg_name)
+  | E_read_memt of read_kind * address_lifted * nat * maybe (list reg_name)
+  | E_write_mem of write_kind * address_lifted * nat * maybe (list reg_name) * memory_value * maybe (list reg_name)
+  | E_write_ea of write_kind * address_lifted * nat * maybe (list reg_name)
+  | E_excl_res
+  | E_write_memv of maybe address_lifted * memory_value * maybe (list reg_name)
+  | E_write_memvt of maybe address_lifted * (bit_lifted * memory_value) * maybe (list reg_name)
+  | E_barrier of barrier_kind
+  | E_footprint 
+  | E_read_reg of reg_name
+  | E_write_reg of reg_name * register_value
+  | E_escape
+  | E_error of string 
+
+
+let eventCompare e1 e2 = 
+  match (e1,e2) with
+  | (E_read_mem rk1 v1 i1 tr1, E_read_mem rk2 v2 i2 tr2) ->
+     compare (rk1, (v1,i1,tr1)) (rk2,(v2, i2, tr2)) 
+  | (E_read_memt rk1 v1 i1 tr1, E_read_memt rk2 v2 i2 tr2) ->
+     compare (rk1, (v1,i1,tr1)) (rk2,(v2, i2, tr2)) 
+  | (E_write_mem wk1 v1 i1 tr1 v1' tr1', E_write_mem wk2 v2 i2 tr2 v2' tr2') -> 
+    compare ((wk1,v1,i1),(tr1,v1',tr1'))  ((wk2,v2,i2),(tr2,v2',tr2')) 
+  | (E_write_ea wk1 a1 i1 tr1, E_write_ea wk2 a2 i2 tr2) ->
+    compare (wk1, (a1, i1, tr1)) (wk2, (a2, i2, tr2))
+  | (E_excl_res, E_excl_res) -> EQ
+  | (E_write_memv _ mv1 tr1, E_write_memv _ mv2 tr2) -> compare (mv1,tr1) (mv2,tr2)
+  | (E_write_memvt _ mv1 tr1, E_write_memvt _ mv2 tr2) -> compare (mv1,tr1) (mv2,tr2)
+  | (E_barrier bk1, E_barrier bk2) -> compare bk1 bk2
+  | (E_read_reg r1, E_read_reg r2) -> compare r1 r2
+  | (E_write_reg r1 v1, E_write_reg r2 v2) -> compare (r1,v1) (r2,v2)
+  | (E_error s1, E_error s2) -> compare s1 s2
+  | (E_escape,E_escape) -> EQ
+  | (E_read_mem _ _ _ _, _) -> LT
+  | (E_write_mem _ _ _ _ _ _, _) -> LT
+  | (E_write_ea _ _ _ _, _) -> LT
+  | (E_excl_res, _) -> LT
+  | (E_write_memv _ _ _, _) -> LT
+  | (E_barrier _, _) -> LT
+  | (E_read_reg _, _) -> LT
+  | (E_write_reg _ _, _) -> LT
+  | _ -> GT
+  end
+
+let eventLess b1 b2      = eventCompare b1 b2 =  LT
+let eventLessEq b1 b2    = eventCompare b1 b2 <> GT
+let eventGreater b1 b2   = eventCompare b1 b2 =  GT
+let eventGreaterEq b1 b2 = eventCompare b1 b2 <> LT
+
+instance (Ord event)
+  let compare = eventCompare
+  let (<)  = eventLess
+  let (<=) = eventLessEq
+  let (>)  = eventGreater
+  let (>=) = eventGreaterEq
+end
+
+instance (SetType event)
+  let setElemCompare = compare
+end
+
+
+(* the address_lifted types should go away here and be replaced by address *)
+type with_aux 'o = 'o * maybe ((unit -> (string * string)) * ((list (reg_name * register_value)) -> list event))
+type outcome_r 'a 'r =
+  (* Request to read memory, value is location to read, integer is size to read,
+     followed by registers that were used in computing that size *)
+  | Read_mem of (read_kind * address_lifted * nat) * (memory_value -> with_aux (outcome_r 'a 'r))
+  (* Tell the system a write is imminent, at address lifted, of size nat *)
+  | Write_ea of (write_kind * address_lifted * nat) * (with_aux (outcome_r 'a 'r))
+  (* Request the result of store-exclusive *)
+  | Excl_res of (bool -> with_aux (outcome_r 'a 'r))
+  (* Request to write memory at last signalled address. Memory value should be 8
+     times the size given in ea signal *)
+  | Write_memv of memory_value * (bool -> with_aux (outcome_r 'a 'r))
+  (* Request a memory barrier *)
+  | Barrier of barrier_kind * with_aux (outcome_r 'a 'r)
+  (* Tell the system to dynamically recalculate dependency footprint *)
+  | Footprint of with_aux (outcome_r 'a 'r)
+  (* Request to read register, will track dependency when mode.track_values *)
+  | Read_reg of reg_name * (register_value -> with_aux (outcome_r 'a 'r))
+  (* Request to write register *)
+  | Write_reg of (reg_name * register_value) * with_aux (outcome_r 'a 'r)
+  | Escape of maybe string
+  (*Result of a failed assert with possible error message to report*)
+  | Fail of maybe string
+  (* Early return with value of type 'r *)
+  | Return of 'r
+  | Internal of (maybe string * maybe (unit -> string)) * with_aux (outcome_r 'a 'r)
+  | Done of 'a
+  | Error of string
+
+type outcome 'a = outcome_r 'a unit
+type outcome_s 'a = with_aux (outcome 'a)
+(* first string : output of instruction_stack_to_string
+   second string: output of local_variables_to_string *)
+
+(** operations and coercions on basic values *)
+
+val word8_to_bitls : word8 -> list bit_lifted
+val bitls_to_word8 : list bit_lifted -> word8
+
+val integer_of_word8_list : list word8 -> integer
+val word8_list_of_integer : integer -> integer -> list word8 
+
+val concretizable_bitl : bit_lifted -> bool
+val concretizable_bytl : byte_lifted -> bool
+val concretizable_bytls : list byte_lifted -> bool
+
+let concretizable_bitl = function
+  | Bitl_zero -> true
+  | Bitl_one -> true
+  | Bitl_undef -> false
+  | Bitl_unknown -> false
+end 
+
+let concretizable_bytl (Byte_lifted bs) = List.all concretizable_bitl bs
+let concretizable_bytls = List.all concretizable_bytl
+
+(* constructing values *)
+
+val build_register_value : list bit_lifted -> direction -> nat -> nat -> register_value
+let build_register_value bs dir width start_index =
+  <| rv_bits = bs;
+     rv_dir = dir; (* D_increasing for Power, D_decreasing for ARM *)
+     rv_start_internal = start_index; 
+     rv_start = if dir = D_increasing
+       then start_index
+       else (start_index+1) - width; (* Smaller index, as in Power, for external interaction *)
+  |>
+
+val register_value : bit_lifted -> direction -> nat -> nat -> register_value
+let register_value b dir width start_index = 
+  build_register_value (List.replicate width b) dir width start_index
+
+val register_value_zeros : direction -> nat -> nat -> register_value
+let register_value_zeros dir width start_index = 
+  register_value Bitl_zero dir width start_index
+
+val register_value_ones : direction -> nat -> nat -> register_value
+let register_value_ones dir width start_index = 
+  register_value Bitl_one dir width start_index
+
+val register_value_for_reg : reg_name -> list bit_lifted -> register_value
+let register_value_for_reg r bs : register_value =
+  let () = ensure (width_of_reg_name r = List.length bs)
+      ("register_value_for_reg (\"" ^ show (register_base_name r) ^ "\") length mismatch: "
+          ^ show (width_of_reg_name r) ^ " vs " ^ show (List.length bs))
+  in
+  let (j1, j2) = slice_of_reg_name r in
+  let d = direction_of_reg_name r in
+  <|  rv_bits = bs;
+      rv_dir = d;
+      rv_start_internal = if d = D_increasing then j1 else (start_of_reg_name r) - j1;
+      rv_start = j1;
+  |>
+
+val byte_lifted_undef : byte_lifted
+let byte_lifted_undef = Byte_lifted (List.replicate 8 Bitl_undef)
+
+val byte_lifted_unknown : byte_lifted
+let byte_lifted_unknown = Byte_lifted (List.replicate 8 Bitl_unknown)
+  
+val memory_value_unknown : nat (*the number of bytes*) -> memory_value
+let memory_value_unknown (width:nat) : memory_value = 
+  List.replicate width byte_lifted_unknown 
+
+val memory_value_undef : nat (*the number of bytes*) -> memory_value
+let memory_value_undef (width:nat) : memory_value = 
+  List.replicate width byte_lifted_undef 
+
+val match_endianness : forall 'a. end_flag -> list 'a -> list 'a
+let match_endianness endian l =
+  match endian with
+  | E_little_endian -> List.reverse l
+  | E_big_endian    -> l
+  end
+
+(* lengths *)  
+
+val memory_value_length : memory_value -> nat
+let memory_value_length (mv:memory_value) = List.length mv
+
+
+(* aux fns *)
+
+val maybe_all : forall 'a.  list (maybe 'a) -> maybe (list 'a)
+let rec maybe_all' xs acc = 
+  match xs with
+  | [] -> Just (List.reverse acc)
+  | Nothing :: _ -> Nothing
+  | (Just y)::xs' -> maybe_all' xs' (y::acc)
+  end
+let maybe_all xs = maybe_all' xs [] 
+
+(** coercions *)
+
+(* bits and bytes *)
+
+let bit_to_bool = function (* TODO: rename bool_of_bit *)
+  | Bitc_zero -> false
+  | Bitc_one -> true
+end
+
+
+val bit_lifted_of_bit : bit -> bit_lifted
+let bit_lifted_of_bit b = 
+  match b with
+  | Bitc_zero -> Bitl_zero
+  | Bitc_one -> Bitl_one
+  end
+
+val bit_of_bit_lifted : bit_lifted -> maybe bit
+let bit_of_bit_lifted bl =
+  match bl with
+  | Bitl_zero -> Just Bitc_zero
+  | Bitl_one -> Just Bitc_one
+  | Bitl_undef -> Nothing
+  | Bitl_unknown -> Nothing
+  end
+
+
+val byte_lifted_of_byte : byte -> byte_lifted
+let byte_lifted_of_byte (Byte bs) : byte_lifted = Byte_lifted (List.map bit_lifted_of_bit bs)
+
+val byte_of_byte_lifted : byte_lifted -> maybe byte
+let byte_of_byte_lifted bl = 
+  match bl with
+  | Byte_lifted bls -> 
+      match maybe_all (List.map bit_of_bit_lifted bls) with
+      | Nothing -> Nothing
+      | Just bs -> Just (Byte bs)
+      end
+  end
+
+
+val bytes_of_bits : list bit -> list byte (*assumes (length bits) mod 8 = 0*)
+let rec bytes_of_bits bits = match bits with
+  | [] -> []
+  | b0::b1::b2::b3::b4::b5::b6::b7::bits -> 
+    (Byte [b0;b1;b2;b3;b4;b5;b6;b7])::(bytes_of_bits bits)
+  | _ -> failwith "bytes_of_bits not given bits divisible by 8"
+end
+
+val byte_lifteds_of_bit_lifteds : list bit_lifted -> list byte_lifted (*assumes (length bits) mod 8 = 0*)
+let rec byte_lifteds_of_bit_lifteds bits = match bits with
+  | [] -> []
+  | b0::b1::b2::b3::b4::b5::b6::b7::bits -> 
+    (Byte_lifted [b0;b1;b2;b3;b4;b5;b6;b7])::(byte_lifteds_of_bit_lifteds bits)
+  | _ -> failwith "byte_lifteds of bit_lifteds not given bits divisible by 8"
+end
+
+
+val byte_of_memory_byte : memory_byte -> maybe byte
+let byte_of_memory_byte = byte_of_byte_lifted
+
+val memory_byte_of_byte : byte -> memory_byte
+let memory_byte_of_byte = byte_lifted_of_byte
+
+
+(* to and from nat *)
+
+(* this natFromBoolList could move to the Lem word.lem library *)
+val natFromBoolList : list bool -> nat
+let rec natFromBoolListAux (acc : nat) (bl : list bool) = 
+  match bl with 
+    | [] -> acc
+    | (true :: bl') -> natFromBoolListAux ((acc * 2) + 1) bl'
+    | (false :: bl') -> natFromBoolListAux (acc * 2) bl'
+  end
+let natFromBoolList bl = 
+  natFromBoolListAux 0 (List.reverse bl)
+
+
+val nat_of_bit_list : list bit -> nat 
+let nat_of_bit_list b =
+  natFromBoolList (List.reverse (List.map bit_to_bool b))
+  (* natFromBoolList takes a list with LSB first, for consistency with rest of Lem word library, so we reverse it. twice. *)
+
+
+(* to and from integer *)
+
+val integer_of_bit_list : list bit -> integer 
+let integer_of_bit_list b =
+  integerFromBoolList (false,(List.reverse (List.map bit_to_bool b)))
+  (* integerFromBoolList takes a list with LSB first, so we reverse it *)
+
+val bit_list_of_integer : nat -> integer -> list bit 
+let bit_list_of_integer len b = 
+  List.map (fun b -> if b then Bitc_one else Bitc_zero) 
+    (reverse (boolListFrombitSeq len (bitSeqFromInteger Nothing b)))
+
+val integer_of_byte_list : list byte -> integer 
+let integer_of_byte_list bytes = integer_of_bit_list (List.concatMap (fun (Byte bs) -> bs) bytes)
+
+val byte_list_of_integer : nat -> integer -> list byte 
+let byte_list_of_integer (len:nat) (a:integer):list byte = 
+  let bits = bit_list_of_integer (len * 8) a in bytes_of_bits bits
+
+
+val integer_of_address : address -> integer 
+let integer_of_address (a:address):integer = 
+  match a with
+  | Address bs i -> i 
+  end
+
+val address_of_integer : integer -> address 
+let address_of_integer (i:integer):address =
+  Address (byte_list_of_integer 8 i) i
+
+(* to and from signed-integer *)
+
+val signed_integer_of_bit_list : list bit -> integer
+let signed_integer_of_bit_list b =
+  match b with
+  | [] -> failwith "empty bit list"
+  | Bitc_zero :: b' ->
+      integerFromBoolList (false,(List.reverse (List.map bit_to_bool b)))
+  | Bitc_one :: b' ->
+      let b'_val = integerFromBoolList (false,(List.reverse (List.map bit_to_bool b'))) in
+      (* integerFromBoolList takes a list with LSB first, so we reverse it *)
+      let msb_val = integerPow 2 ((List.length b) - 1) in
+      b'_val - msb_val
+  end
+
+
+(* regarding a list of int as a list of bytes in memory, MSB lowest-address first, convert to an integer *)
+val integer_address_of_int_list : list int -> integer
+let rec integerFromIntListAux (acc: integer) (is: list int) = 
+  match is with 
+  | [] -> acc
+  | (i :: is') -> integerFromIntListAux ((acc * 256) + integerFromInt i) is'
+  end
+let integer_address_of_int_list (is: list int) =
+  integerFromIntListAux 0 is
+
+val address_of_byte_list : list byte -> address 
+let address_of_byte_list bs = 
+  if List.length bs <> 8 then failwith "address_of_byte_list given list not of length 8" else 
+  Address bs (integer_of_byte_list bs)
+
+let address_of_byte_lifted_list bls =
+  match maybe_all (List.map byte_of_byte_lifted bls) with
+  | Nothing -> Nothing
+  | Just bs -> Just (address_of_byte_list bs)
+  end
+
+(* operations on addresses *)
+
+val add_address_nat : address -> nat -> address 
+let add_address_nat (a:address) (i:nat) : address = 
+  address_of_integer ((integer_of_address a) + (integerFromNat i))
+
+val clear_low_order_bits_of_address : address -> address 
+let clear_low_order_bits_of_address a = 
+  match a with 
+  | Address [b0;b1;b2;b3;b4;b5;b6;b7] i -> 
+      match b7 with
+      | Byte [bt0;bt1;bt2;bt3;bt4;bt5;bt6;bt7] -> 
+          let b7' = Byte [bt0;bt1;bt2;bt3;bt4;bt5;Bitc_zero;Bitc_zero] in
+	  let bytes = [b0;b1;b2;b3;b4;b5;b6;b7'] in
+          Address bytes (integer_of_byte_list bytes)
+      | _ -> failwith "Byte does not contain 8 bits"
+      end
+  | _ -> failwith "Address does not contain 8 bytes"
+  end
+
+
+
+val byte_list_of_memory_value : end_flag -> memory_value -> maybe (list byte)
+let byte_list_of_memory_value endian mv =
+  match_endianness endian mv
+  $> List.map byte_of_memory_byte
+  $> maybe_all
+
+
+val integer_of_memory_value : end_flag -> memory_value -> maybe integer
+let integer_of_memory_value endian (mv:memory_value):maybe integer =
+  match byte_list_of_memory_value endian mv with
+  | Just bs -> Just (integer_of_byte_list bs)
+  | Nothing -> Nothing 
+  end
+
+val memory_value_of_integer : end_flag  -> nat -> integer -> memory_value
+let memory_value_of_integer endian (len:nat) (i:integer):memory_value =
+  List.map byte_lifted_of_byte (byte_list_of_integer len i)
+  $> match_endianness endian
+
+
+val integer_of_register_value : register_value -> maybe integer 
+let integer_of_register_value (rv:register_value):maybe integer = 
+  match maybe_all (List.map bit_of_bit_lifted rv.rv_bits) with
+  | Nothing -> Nothing
+  | Just bs -> Just (integer_of_bit_list bs)
+  end
+
+(* NOTE: register_value_for_reg_of_integer might be easier to use *)
+val register_value_of_integer : nat -> nat -> direction -> integer -> register_value 
+let register_value_of_integer (len:nat) (start:nat) (dir:direction) (i:integer):register_value =
+  let bs = bit_list_of_integer len i in
+  build_register_value (List.map bit_lifted_of_bit bs) dir len start
+
+val register_value_for_reg_of_integer : reg_name -> integer -> register_value
+let register_value_for_reg_of_integer (r: reg_name) (i:integer) : register_value =
+  register_value_of_integer (width_of_reg_name r) (start_of_reg_name r) (direction_of_reg_name r) i
+
+(* *)
+
+val opcode_of_bytes : byte -> byte -> byte -> byte -> opcode
+let opcode_of_bytes b0 b1 b2 b3 : opcode = Opcode [b0;b1;b2;b3]
+
+val register_value_of_address : address -> direction -> register_value   
+let register_value_of_address (Address bytes _) dir : register_value = 
+  let bits = List.concatMap (fun (Byte bs) -> List.map bit_lifted_of_bit bs) bytes in
+   <| rv_bits = bits;
+      rv_dir = dir;
+      rv_start = 0; 
+      rv_start_internal = if dir = D_increasing then 0 else (List.length bits) - 1
+   |>
+
+val register_value_of_memory_value : memory_value -> direction -> register_value
+let register_value_of_memory_value bytes dir : register_value =
+  let bitls = List.concatMap (fun (Byte_lifted bs) -> bs) bytes in
+  <| rv_bits = bitls;
+     rv_dir = dir;
+     rv_start = 0;
+     rv_start_internal = if dir = D_increasing then 0 else (List.length bitls) - 1
+   |>                                                     
+
+val memory_value_of_register_value: register_value -> memory_value
+let memory_value_of_register_value r =
+  (byte_lifteds_of_bit_lifteds r.rv_bits)
+   
+val address_lifted_of_register_value : register_value -> maybe address_lifted
+(* returning Nothing iff the register value is not 64 bits wide, but
+allowing Bitl_undef and Bitl_unknown *)
+let address_lifted_of_register_value (rv:register_value) : maybe address_lifted = 
+  if List.length rv.rv_bits <> 64 then Nothing
+  else 
+    Just (Address_lifted (byte_lifteds_of_bit_lifteds rv.rv_bits)
+                         (if List.all concretizable_bitl rv.rv_bits 
+			  then match (maybe_all (List.map bit_of_bit_lifted rv.rv_bits)) with
+                              | (Just(bits)) -> Just (integer_of_bit_list bits)
+                              | Nothing -> Nothing end
+			  else Nothing))
+
+val address_of_address_lifted : address_lifted -> maybe address
+(* returning Nothing iff the address contains any Bitl_undef or Bitl_unknown *)
+let address_of_address_lifted (al:address_lifted): maybe address =
+  match al with
+  | Address_lifted bls (Just i)-> 
+      match maybe_all ((List.map byte_of_byte_lifted) bls) with
+      | Nothing -> Nothing
+      | Just bs -> Just (Address bs i)
+      end
+  | _ -> Nothing
+end
+
+val address_of_register_value : register_value -> maybe address
+(* returning Nothing iff the register value is not 64 bits wide, or contains Bitl_undef or Bitl_unknown *)
+let address_of_register_value (rv:register_value) : maybe address = 
+  match address_lifted_of_register_value rv with
+  | Nothing -> Nothing
+  | Just al -> 
+      match address_of_address_lifted al with
+      | Nothing -> Nothing
+      | Just a -> Just a
+      end
+  end
+
+let address_of_memory_value (endian: end_flag) (mv:memory_value) : maybe address =
+  match byte_list_of_memory_value endian mv with
+  | Nothing -> Nothing
+  | Just bs -> 
+      if List.length bs <> 8 then Nothing else
+      Just (address_of_byte_list bs)
+  end 
+
+val byte_of_int : int -> byte
+let byte_of_int (i:int) : byte = 
+  Byte (bit_list_of_integer 8 (integerFromInt i))
+
+val memory_byte_of_int : int -> memory_byte
+let memory_byte_of_int (i:int) : memory_byte = 
+  memory_byte_of_byte (byte_of_int i)
+
+(*
+val int_of_memory_byte : int -> maybe memory_byte
+let int_of_memory_byte (mb:memory_byte) : int = 
+  failwith "TODO"
+*)
+
+
+
+val memory_value_of_address_lifted : end_flag -> address_lifted -> memory_value
+let memory_value_of_address_lifted endian (Address_lifted bs _ :address_lifted) =
+  match_endianness endian bs
+
+val byte_list_of_address : address -> list byte
+let byte_list_of_address (Address bs _) : list byte = bs
+
+val memory_value_of_address : end_flag -> address -> memory_value
+let memory_value_of_address endian (Address bs _) =
+  match_endianness endian bs
+  $> List.map byte_lifted_of_byte
+
+val byte_list_of_opcode : opcode -> list byte
+let byte_list_of_opcode (Opcode bs) : list byte = bs
+
+(** ****************************************** *)
+(** show type class instantiations             *)
+(** ****************************************** *)
+
+(* matching printing_functions.ml *)
+val stringFromReg_name : reg_name -> string
+let stringFromReg_name r =
+  let norm_sl start dir (first,second) = (first,second)
+    (* match dir with
+      | D_increasing -> (first,second)
+      | D_decreasing -> (start - first, start - second)
+    end *)
+  in
+  match r with
+  | Reg s start size dir -> s
+  | Reg_slice s start dir sl ->
+      let (first,second) = norm_sl start dir sl in
+      s ^ "[" ^ show first ^ (if (first = second) then "" else ".." ^ (show second)) ^ "]"
+  | Reg_field s start dir f sl ->
+      let (first,second) = norm_sl start dir sl in
+      s ^ "." ^ f ^ " (" ^ (show start) ^ ", " ^ (show dir) ^ ", " ^ (show first) ^ ", " ^ (show second) ^ ")"
+  | Reg_f_slice s start dir f (first1,second1) (first,second) ->
+      let (first,second) =
+        match dir with
+        | D_increasing -> (first,second)
+        | D_decreasing -> (start - first, start - second)
+        end in
+      s ^ "." ^ f ^ "]" ^ show first ^ (if (first = second) then "" else ".." ^ (show second)) ^ "]"
+  end
+
+instance (Show reg_name)
+  let show = stringFromReg_name
+end
+
+
+(* hex pp of integers, adapting the Lem string_extra.lem code *)
+val stringFromNaturalHexHelper : natural -> list char -> list char
+let rec stringFromNaturalHexHelper n acc =
+  if n = 0 then
+    acc
+  else
+    stringFromNaturalHexHelper (n / 16) (String_extra.chr (natFromNatural (let nd = n mod 16 in if nd <=9 then nd + 48 else nd - 10 + 97)) :: acc)
+
+val stringFromNaturalHex : natural -> string
+let (*~{ocaml;hol}*) stringFromNaturalHex n = 
+  if n = 0 then "0" else toString (stringFromNaturalHexHelper n [])
+
+val stringFromIntegerHex : integer -> string
+let (*~{ocaml}*) stringFromIntegerHex i = 
+  if i < 0 then 
+    "-" ^ stringFromNaturalHex (naturalFromInteger i)
+  else
+    stringFromNaturalHex (naturalFromInteger i)
+
+
+let stringFromAddress (Address bs i) = 
+  let i' = integer_of_byte_list bs in
+  if i=i' then
+(*TODO: ideally this should be made to match the src/pp.ml pp_address; the following very roughly matches what's used in the ppcmem UI, enough to make exceptions readable *)
+    if i < 65535 then 
+      show i 
+    else
+      stringFromIntegerHex i
+  else
+    "stringFromAddress bytes and integer mismatch"
+
+instance (Show address)
+  let show = stringFromAddress
+end
+
+let stringFromByte_lifted bl =
+  match byte_of_byte_lifted bl with
+  | Nothing -> "u?"  
+  | Just (Byte bits) -> 
+      let i = integer_of_bit_list bits in
+      show i
+  end
+
+instance (Show byte_lifted)
+  let show = stringFromByte_lifted
+end
+
+(* possible next instruction address options *)
+type nia = 
+  | NIA_successor
+  | NIA_concrete_address of address
+  | NIA_LR   (* "LR0:61 || 0b00" in Power pseudocode *)
+  | NIA_CTR  (* "CTR0:61 || 0b00" in Power pseudocode *)
+  | NIA_register of reg_name (* the address will be in a register,
+                                corresponds to AArch64 BLR, BR, RET
+                                instructions *)
+
+let niaCompare n1 n2 = match (n1,n2) with
+  | (NIA_successor, NIA_successor) -> EQ
+  | (NIA_successor, _) -> LT
+  | (NIA_concrete_address _, NIA_successor) -> GT
+  | (NIA_concrete_address a1, NIA_concrete_address a2) -> compare a1 a2
+  | (NIA_concrete_address _, _) -> LT
+  | (NIA_LR, NIA_successor) -> GT
+  | (NIA_LR, NIA_concrete_address _) -> GT
+  | (NIA_LR, NIA_LR) -> EQ
+  | (NIA_LR, _) -> LT
+  | (NIA_CTR, NIA_successor) -> GT
+  | (NIA_CTR, NIA_concrete_address _) -> GT
+  | (NIA_CTR, NIA_LR) -> GT
+  | (NIA_CTR, NIA_CTR) -> EQ
+  | (NIA_CTR, NIA_register _) -> LT
+  | (NIA_register _, NIA_successor) -> GT
+  | (NIA_register _, NIA_concrete_address _) -> GT
+  | (NIA_register _, NIA_LR) -> GT
+  | (NIA_register _, NIA_CTR) -> GT
+  | (NIA_register r1, NIA_register r2) -> compare r1 r2
+  end
+
+instance (Ord nia)
+  let compare = niaCompare
+  let (<)  n1 n2 = (niaCompare n1 n2) = LT
+  let (<=) n1 n2 = (niaCompare n1 n2) <> GT
+  let (>)  n1 n2 = (niaCompare n1 n2) = GT
+  let (>=) n1 n2 = (niaCompare n1 n2) <> LT
+end
+
+let stringFromNia = function
+  | NIA_successor -> "NIA_successor"
+  | NIA_concrete_address a -> "NIA_concrete_address " ^ show a
+  | NIA_LR -> "NIA_LR"
+  | NIA_CTR -> "NIA_CTR"
+  | NIA_register r -> "NIA_register " ^ show r
+end
+
+instance (Show nia)
+  let show = stringFromNia
+end
+
+type dia =
+  | DIA_none
+  | DIA_concrete_address of address
+  | DIA_register of reg_name
+
+let diaCompare d1 d2 = match (d1, d2) with
+  | (DIA_none, DIA_none) -> EQ
+  | (DIA_none, _) -> LT
+  | (DIA_concrete_address a1, DIA_none) -> GT
+  | (DIA_concrete_address a1, DIA_concrete_address a2) -> compare a1 a2
+  | (DIA_concrete_address a1, _) -> LT
+  | (DIA_register r1, DIA_register r2) -> compare r1 r2
+  | (DIA_register _, _) -> GT
+end
+
+instance (Ord dia)
+  let compare = diaCompare
+  let (<)  n1 n2 = (diaCompare n1 n2) = LT
+  let (<=) n1 n2 = (diaCompare n1 n2) <> GT
+  let (>)  n1 n2 = (diaCompare n1 n2) = GT
+  let (>=) n1 n2 = (diaCompare n1 n2) <> LT
+end
+
+let stringFromDia = function
+  | DIA_none               ->  "DIA_none"
+  | DIA_concrete_address a ->  "DIA_concrete_address " ^ show a
+  | DIA_register r ->  "DIA_delayed_register " ^ show r
+end
+
+instance (Show dia)
+  let show = stringFromDia
+end
diff --git a/src/gen_lib/sail2_deep_shallow_convert.lem b/src/gen_lib/sail2_deep_shallow_convert.lem
index 2e3543b4..b963e537 100644
--- a/src/gen_lib/sail2_deep_shallow_convert.lem
+++ b/src/gen_lib/sail2_deep_shallow_convert.lem
@@ -455,61 +455,17 @@ instance (ToFromInterpValue write_kind)
 end
 
 
-let a64_barrier_domainToInterpValue = function
-  | A64_FullShare ->
-    V_ctor (Id_aux (Id "A64_FullShare") Unknown) (T_id "a64_barrier_domain") (C_Enum 0) (toInterpValue ())
-  | A64_InnerShare ->
-    V_ctor (Id_aux (Id "A64_InnerShare") Unknown) (T_id "a64_barrier_domain") (C_Enum 1) (toInterpValue ())
-  | A64_OuterShare ->
-    V_ctor (Id_aux (Id "A64_OuterShare") Unknown) (T_id "a64_barrier_domain") (C_Enum 2) (toInterpValue ())
-  | A64_NonShare ->
-    V_ctor (Id_aux (Id "A64_NonShare") Unknown) (T_id "a64_barrier_domain") (C_Enum 3) (toInterpValue ())
-end
-let rec a64_barrier_domainFromInterpValue v = match v with
-  | V_ctor (Id_aux (Id "A64_FullShare") _) _ _ v -> A64_FullShare
-  | V_ctor (Id_aux (Id "A64_InnerShare") _) _ _ v -> A64_InnerShare
-  | V_ctor (Id_aux (Id "A64_OuterShare") _) _ _ v -> A64_OuterShare
-  | V_ctor (Id_aux (Id "A64_NonShare") _) _ _ v -> A64_NonShare
-  | V_tuple [v] -> a64_barrier_domainFromInterpValue v
-  | v -> failwith ("fromInterpValue a64_barrier_domain: unexpected value. " ^
-                     Interp.debug_print_value v)
-  end
-instance (ToFromInterpValue a64_barrier_domain)
-  let toInterpValue = a64_barrier_domainToInterpValue
-  let fromInterpValue = a64_barrier_domainFromInterpValue
-end
-
-let a64_barrier_typeToInterpValue = function
-  | A64_barrier_all ->
-    V_ctor (Id_aux (Id "A64_barrier_all") Unknown) (T_id "a64_barrier_type") (C_Enum 0) (toInterpValue ())
-  | A64_barrier_LD ->
-    V_ctor (Id_aux (Id "A64_barrier_LD") Unknown) (T_id "a64_barrier_type") (C_Enum 1) (toInterpValue ())
-  | A64_barrier_ST ->
-    V_ctor (Id_aux (Id "A64_barrier_ST") Unknown) (T_id "a64_barrier_type") (C_Enum 2) (toInterpValue ())
-end
-let rec a64_barrier_typeFromInterpValue v = match v with
-  | V_ctor (Id_aux (Id "A64_barrier_all") _) _ _ v -> A64_barrier_all
-  | V_ctor (Id_aux (Id "A64_barrier_LD") _) _ _ v -> A64_barrier_LD
-  | V_ctor (Id_aux (Id "A64_barrier_ST") _) _ _ v -> A64_barrier_ST
-  | V_tuple [v] -> a64_barrier_typeFromInterpValue v
-  | v -> failwith ("fromInterpValue a64_barrier_type: unexpected value. " ^
-                     Interp.debug_print_value v)
-  end
-instance (ToFromInterpValue a64_barrier_type)
-  let toInterpValue = a64_barrier_typeToInterpValue
-  let fromInterpValue = a64_barrier_typeFromInterpValue
-end
-
-
 let barrier_kindToInterpValue = function
   | Barrier_Sync -> V_ctor (Id_aux (Id "Barrier_Sync") Unknown) (T_id "barrier_kind") (C_Enum 0) (toInterpValue ())
   | Barrier_LwSync -> V_ctor (Id_aux (Id "Barrier_LwSync") Unknown) (T_id "barrier_kind") (C_Enum 1) (toInterpValue ())
   | Barrier_Eieio -> V_ctor (Id_aux (Id "Barrier_Eieio") Unknown) (T_id "barrier_kind") (C_Enum 2) (toInterpValue ())
   | Barrier_Isync -> V_ctor (Id_aux (Id "Barrier_Isync") Unknown) (T_id "barrier_kind") (C_Enum 3) (toInterpValue ())
-  | Barrier_DMB (dom,typ) ->
-      V_ctor (Id_aux (Id "Barrier_DMB") Unknown) (T_id "barrier_kind") C_Union (toInterpValue (dom, typ))
-  | Barrier_DSB (dom,typ) ->
-      V_ctor (Id_aux (Id "Barrier_DSB") Unknown) (T_id "barrier_kind") C_Union (toInterpValue (dom, typ))
+  | Barrier_DMB -> V_ctor (Id_aux (Id "Barrier_DMB") Unknown) (T_id "barrier_kind") (C_Enum 4) (toInterpValue ())
+  | Barrier_DMB_ST -> V_ctor (Id_aux (Id "Barrier_DMB_ST") Unknown) (T_id "barrier_kind") (C_Enum 5) (toInterpValue ())
+  | Barrier_DMB_LD -> V_ctor (Id_aux (Id "Barrier_DMB_LD") Unknown) (T_id "barrier_kind") (C_Enum 6) (toInterpValue ())
+  | Barrier_DSB -> V_ctor (Id_aux (Id "Barrier_DSB") Unknown) (T_id "barrier_kind") (C_Enum 7) (toInterpValue ())
+  | Barrier_DSB_ST -> V_ctor (Id_aux (Id "Barrier_DSB_ST") Unknown) (T_id "barrier_kind") (C_Enum 8) (toInterpValue ())
+  | Barrier_DSB_LD -> V_ctor (Id_aux (Id "Barrier_DSB_LD") Unknown) (T_id "barrier_kind") (C_Enum 9) (toInterpValue ())
   | Barrier_ISB -> V_ctor (Id_aux (Id "Barrier_ISB") Unknown) (T_id "barrier_kind") (C_Enum 10) (toInterpValue ())
   | Barrier_TM_COMMIT -> V_ctor (Id_aux (Id "Barrier_TM_COMMIT") Unknown) (T_id "barrier_kind") (C_Enum 11) (toInterpValue ())
   | Barrier_MIPS_SYNC -> V_ctor (Id_aux (Id "Barrier_MIPS_SYNC") Unknown) (T_id "barrier_kind") (C_Enum 12) (toInterpValue ())
@@ -526,12 +482,12 @@ let rec barrier_kindFromInterpValue v = match v with
   | V_ctor (Id_aux (Id "Barrier_LwSync") _) _ _ v -> Barrier_LwSync
   | V_ctor (Id_aux (Id "Barrier_Eieio") _) _ _ v -> Barrier_Eieio
   | V_ctor (Id_aux (Id "Barrier_Isync") _) _ _ v -> Barrier_Isync
-  | V_ctor (Id_aux (Id "Barrier_DMB") _) _ _ v ->
-      let (dom, typ) = fromInterpValue v in
-      Barrier_DMB (dom,typ)
-  | V_ctor (Id_aux (Id "Barrier_DSB") _) _ _ v ->
-      let (dom, typ) = fromInterpValue v in
-      Barrier_DSB (dom,typ)
+  | V_ctor (Id_aux (Id "Barrier_DMB") _) _ _ v -> Barrier_DMB
+  | V_ctor (Id_aux (Id "Barrier_DMB_ST") _) _ _ v -> Barrier_DMB_ST
+  | V_ctor (Id_aux (Id "Barrier_DMB_LD") _) _ _ v -> Barrier_DMB_LD
+  | V_ctor (Id_aux (Id "Barrier_DSB") _) _ _ v -> Barrier_DSB
+  | V_ctor (Id_aux (Id "Barrier_DSB_ST") _) _ _ v -> Barrier_DSB_ST
+  | V_ctor (Id_aux (Id "Barrier_DSB_LD") _) _ _ v -> Barrier_DSB_LD
   | V_ctor (Id_aux (Id "Barrier_ISB") _) _ _ v -> Barrier_ISB
   | V_ctor (Id_aux (Id "Barrier_TM_COMMIT") _) _ _ v -> Barrier_TM_COMMIT
   | V_ctor (Id_aux (Id "Barrier_MIPS_SYNC") _) _ _ v -> Barrier_MIPS_SYNC
diff --git a/src/lem_interp/0.11/instruction_extractor.lem b/src/lem_interp/0.11/instruction_extractor.lem
new file mode 100644
index 00000000..11947c17
--- /dev/null
+++ b/src/lem_interp/0.11/instruction_extractor.lem
@@ -0,0 +1,163 @@
+(*========================================================================*)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(*========================================================================*)
+
+open import Interp_ast
+open import Interp_utilities
+open import Pervasives
+
+type instr_param_typ =
+| IBit
+| IBitvector of maybe nat
+| IRange of maybe nat
+| IEnum of string * nat
+| IOther
+
+type instruction_form =
+|  Instr_form of string * list (string * instr_param_typ) * list base_effect
+|  Skipped
+
+val extract_instructions : string -> defs tannot -> list instruction_form
+
+let rec extract_ityp t tag = match (t,tag) with
+(* AA: Hack
+  | (T_abbrev _ t,_) -> extract_ityp t tag
+  | (T_id "bit",_) -> IBit
+  | (T_id "bool",_) -> IBit
+  | (T_app "vector" (T_args [_; T_arg_nexp (Ne_const len); _; T_arg_typ (T_id "bit")]),_) ->
+    IBitvector (Just (natFromInteger len))
+  | (T_app "vector" (T_args [_;_;_;T_arg_typ (T_id "bit")]),_) -> IBitvector (Just 64)
+  | (T_app "atom" (T_args [T_arg_nexp (Ne_const num)]),_) ->
+    IRange (Just (natFromInteger num))
+  | (T_app "atom" _,_) -> IRange Nothing
+  | (T_app "range" (T_args [_;T_arg_nexp (Ne_const max)]),_) -> 
+    IRange (Just (natFromInteger max))
+  | (T_app "range" _,_) -> IRange Nothing
+  | (T_app i (T_args []),Tag_enum max) ->
+    IEnum i (natFromInteger max)
+  | (T_id i,Tag_enum max) ->
+    IEnum i (natFromInteger max)
+*)
+  | _ -> IOther
+end 
+
+let extract_parm (E_aux e (_,tannot)) =
+  match e with
+    | E_id (Id_aux (Id i) _) ->
+      match tannot with
+	| Just(t,tag,_,_,_) -> (i,(extract_ityp t tag))
+	| _ -> (i,IOther) end
+    | _ -> 
+      let i = "Unnamed" in
+      match tannot with
+	| Just(t,tag,_,_,_) -> (i,(extract_ityp t tag))
+	| _ -> (i,IOther) end
+end
+
+let rec extract_from_decode decoder = 
+  match decoder with
+    | [] -> []
+    | (FCL_aux (FCL_Funcl _ (Pat_aux pexp _)) _)::decoder ->
+      let exp = match pexp with Pat_exp _ exp -> exp | Pat_when _ _ exp -> exp end in
+      (match exp with
+	| E_aux (E_app (Id_aux(Id id) _) parms) (_,(Just (_,Tag_ctor,_,_,_))) ->
+	  Instr_form id (List.map extract_parm parms) []
+	| _ -> Skipped end)::(extract_from_decode decoder)
+end 
+
+let rec extract_effects_of_fcl id execute = match execute with
+  | [] -> []
+  | FCL_aux (FCL_Funcl _ (Pat_aux (Pat_exp (P_aux (P_app (Id_aux (Id i) _) _) _) _) _)) (_,(Just(_,_,_,Effect_aux(Effect_set efs) _,_))) :: executes ->
+    if i = id 
+    then efs
+    else extract_effects_of_fcl id executes
+  | _::executes -> extract_effects_of_fcl id executes
+end
+
+let rec extract_patt_parm (P_aux p (_,tannot)) = 
+  let t = match tannot with
+    | Just(t,tag,_,_,_) -> extract_ityp t tag
+    | _ -> IOther end in
+  match p with
+    | P_lit lit -> ("",t)
+    | P_wild -> ("Unnamed",t)
+    | P_as _ (Id_aux (Id id) _) -> (id,t)
+    | P_typ typ p -> extract_patt_parm p
+    | P_id (Id_aux (Id id) _) -> (id,t)
+    | P_app (Id_aux (Id id) _) [] -> (id,t)
+    | _ -> ("",t) end
+
+let rec extract_from_execute fcls = match fcls with
+  | [] -> []
+  | FCL_aux (FCL_Funcl _ (Pat_aux (Pat_exp (P_aux (P_app (Id_aux (Id i) _) parms) _) _) _)) (_,Just(_,_,_,Effect_aux(Effect_set efs) _,_))::fcls ->
+     (Instr_form i (List.map extract_patt_parm parms) efs)::extract_from_execute fcls
+  | _ :: fcls ->
+     (* AA: Find out what breaks this *)
+     extract_from_execute fcls
+end
+
+let rec extract_effects instrs execute = 
+  match instrs with
+    | [] -> []
+    | Skipped::instrs -> Skipped::(extract_effects instrs execute)
+    | (Instr_form id parms [])::instrs -> 
+      (Instr_form id parms (extract_effects_of_fcl id execute))::(extract_effects instrs execute)
+end
+
+let extract_instructions_old decode_name execute_name defs = 
+  let (Just decoder) = find_function defs (Id_aux (Id decode_name) Unknown) in
+  let (Just executer) = find_function defs (Id_aux (Id execute_name) Unknown) in
+  let instr_no_effects = extract_from_decode decoder in
+  let instructions = extract_effects instr_no_effects executer in
+  instructions
+
+let extract_instructions execute_name defs =
+  let (Just executer) = find_function defs (Id_aux (Id execute_name) Unknown) in
+  let instructions = extract_from_execute executer in
+  instructions
diff --git a/src/lem_interp/0.11/interp.lem b/src/lem_interp/0.11/interp.lem
new file mode 100644
index 00000000..431c1a08
--- /dev/null
+++ b/src/lem_interp/0.11/interp.lem
@@ -0,0 +1,3407 @@
+(*========================================================================*)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(*========================================================================*)
+
+open import Pervasives
+import Map
+import Map_extra (* For 'find' instead of using lookup and maybe types, as we know it cannot fail *)
+import Set_extra (* For 'to_list' because map only goes to set *)
+import List_extra (* For 'nth' and 'head' where we know that they cannot fail *)
+open import Show
+open import Show_extra (* for 'show' to convert nat to string) *)
+open import String_extra (* for chr *)
+import Assert_extra (*For failwith when partiality is known to be unreachable*)
+
+open import Sail_impl_base
+open import Interp_ast
+open import Interp_utilities
+open import Instruction_extractor
+
+(* TODO: upstream into Lem *)
+val stringFromTriple : forall 'a 'b 'c. ('a -> string) -> ('b -> string) -> ('c -> string) -> ('a * 'b * 'c) -> string
+let stringFromTriple showX showY showZ (x,y,z) =
+  "(" ^ showX x ^ ", " ^ showY y ^ ", " ^ showZ z ^ ")"
+
+instance forall 'a 'b 'c. Show 'a, Show 'b, Show 'c => (Show ('a * 'b * 'c))
+  let show = stringFromTriple show show show
+end
+
+val debug_print : string -> unit
+declare ocaml target_rep function debug_print s = `Printf.eprintf` "%s" s
+
+val intern_annot : tannot -> tannot
+let intern_annot annot =
+  match annot with
+    | Just (t,_,ncs,effect,rec_effect) ->
+      Just (t,Tag_empty,ncs,pure,rec_effect)
+    | Nothing -> Nothing
+  end
+
+let val_annot typ = Just(typ,Tag_empty,[],pure,pure)
+
+let ctor_annot typ = Just(typ,Tag_ctor,[],pure,pure)
+
+let enum_annot typ max = Just(typ,Tag_enum max,[],pure,pure)
+
+let non_det_annot annot maybe_id = match annot with
+  | Just(t,_,cs,ef,efr) -> Just(t,Tag_unknown maybe_id,cs,ef,efr)
+  | _ -> Nothing
+end
+
+let is_inc = function | IInc -> true | _ -> false end
+
+let id_of_string s = (Id_aux (Id s) Unknown)
+
+
+let rec {ocaml} string_of_reg_form r = match r with
+  | Form_Reg id _ _ -> get_id id
+  | Form_SubReg id reg_form _ -> (string_of_reg_form reg_form) ^ "." ^ (get_id id)
+end
+
+let rec {ocaml} string_of_value v = match v with
+  | V_boxref nat t -> "$#" ^ (show nat) ^ "$"
+  | V_lit (L_aux lit _) ->
+    (match lit with
+    | L_unit -> "()"
+    | L_zero -> "0"
+    | L_one  -> "1"
+    | L_true -> "true"
+    | L_false -> "false"
+    | L_num num -> show num
+    | L_hex hex -> "0x" ^ hex
+    | L_bin bin -> "0b" ^ bin
+    | L_undef -> "undefined"
+    | L_string str-> "\"" ^ str ^ "\"" end)
+  | V_tuple vals -> "(" ^ (list_to_string string_of_value "," vals) ^ ")"
+  | V_list vals -> "[||" ^ (list_to_string string_of_value "," vals) ^ "||]"
+  | V_vector i inc vals ->
+    let default_format _ = "[" ^ (list_to_string string_of_value "," vals) ^ "]" in
+    let to_bin () = (*"("^show i ^") "^ *)"0b" ^
+                    (List.foldr
+                       (fun v rst ->
+                          (match v with
+                           | V_lit (L_aux l _) ->
+                             (match l with | L_one -> "1" | L_zero -> "0" | L_undef -> "u"
+                                           | _ -> Assert_extra.failwith "to_bin called with non-bin lits" end)
+                           | V_unknown -> "?"
+                           | _ -> Assert_extra.failwith "to_bin called with non-bin values" end) ^rst) "" vals) in
+    match vals with
+      | [] -> default_format ()
+      | v::vs ->
+        match v with
+          | V_lit (L_aux L_zero _) -> to_bin()
+          | V_lit (L_aux L_one _) -> to_bin()
+          | _ -> default_format() end end
+  | V_vector_sparse start stop inc vals default ->
+    "[" ^ (list_to_string (fun (i,v) -> (show i) ^ " = " ^ (string_of_value v)) "," vals) ^ "]:" ^
+      show start ^ "-" ^show stop ^ "(default of " ^ (string_of_value default) ^ ")"
+  | V_record t vals ->
+    "{" ^ (list_to_string (fun (id,v) -> (get_id id) ^ "=" ^ (string_of_value v)) ";" vals) ^ "}"
+  | V_ctor id t _ value -> (get_id id) ^ " " ^ string_of_value value
+  | V_unknown -> "Unknown"
+  | V_register r -> string_of_reg_form r
+  | V_register_alias _ _ -> "register_as_alias"
+  | V_track v rs -> "tainted by {" ^ (list_to_string string_of_reg_form "," []) ^ "} --" ^ (string_of_value v)
+end
+let ~{ocaml} string_of_value _ = ""
+
+val debug_print_value_list : list string -> string
+let rec debug_print_value_list vs = match vs with
+  | [] -> ""
+  | [v] -> v
+  | v :: vs -> v ^ ";" ^ debug_print_value_list vs
+end
+val debug_print_value : value -> string
+let rec debug_print_value v = match v with
+  | V_boxref n t -> "V_boxref " ^ (show n) ^ " t"
+  | V_lit (L_aux lit _) ->
+     "V_lit " ^
+       (match lit with
+        | L_unit -> "L_unit"
+        | L_zero -> "L_zero"
+        | L_one  -> "L_one"
+        | L_true -> "L_true"
+        | L_false -> "L_false"
+        | L_num num -> "(Lnum " ^ (show num) ^ ")"
+        | L_hex hex -> "(L_hex " ^ hex ^ ")"
+        | L_bin bin -> "(L_bin " ^ bin ^ ")"
+        | L_undef -> "L_undef"
+        | L_string str-> "(L_string " ^ str ^ ")" end)
+  | V_tuple vals ->
+     "V_tuple [" ^ debug_print_value_list (List.map debug_print_value vals) ^ "]"
+  | V_list vals ->
+     "V_list [" ^ debug_print_value_list (List.map debug_print_value vals) ^ "]"
+  | V_vector i inc vals ->
+     "V_vector " ^ (show i) ^
+       " " ^ (if inc = IInc then "IInc" else "IDec") ^
+         " [" ^ debug_print_value_list (List.map debug_print_value vals) ^ "]"
+  | V_vector_sparse start stop inc vals default ->
+     let ppindexval (i,v) = (show i) ^ " = " ^ (debug_print_value v) in
+     let valspp = debug_print_value_list (List.map ppindexval vals) in
+     "V_vector " ^ (show start) ^ " " ^ (show stop) ^ " " ^
+       (if inc = IInc then "IInc" else "IDec") ^
+         " [" ^ valspp ^ "] (" ^ debug_print_value default ^ ")"
+  | V_record t vals ->
+     let ppidval (id,v) = "(" ^ (get_id id) ^ "," ^ debug_print_value v ^ ")" in
+     "V_record t [" ^ debug_print_value_list (List.map ppidval vals) ^ "]"
+  | V_ctor id t k v' ->
+     "V_ctor " ^ (get_id id) ^ " t " ^
+       (match k with | C_Enum n -> "(C_Enum " ^ show n ^ ")"
+                     | C_Union -> "C_Union" end) ^
+         "(" ^ debug_print_value v' ^ ")"
+  | V_unknown -> "V_unknown"
+  | V_register r -> "V_register (" ^ string_of_reg_form r ^ ")"
+  | V_register_alias _ _ -> "V_register_alias _ _"
+  | V_track v rs -> "V_track (" ^ debug_print_value v ^ ") _"
+  end
+
+instance (Show value)
+  let show v = debug_print_value v
+end
+
+let rec {coq;ocaml} id_value_eq strict (i, v) (i', v') = i = i' && value_eq strict v v'
+and value_eq strict left right =
+  match (left, right) with
+  | (V_lit l, V_lit l') -> lit_eq l l'
+  | (V_boxref n t, V_boxref m t') -> n = m && t = t'
+  | (V_tuple l, V_tuple l') -> listEqualBy (value_eq strict) l l'
+  | (V_list l, V_list l') -> listEqualBy (value_eq strict) l l'
+  | (V_vector n b l, V_vector m b' l') -> b = b' && listEqualBy (value_eq strict) l l'
+  | (V_vector_sparse n o b l v, V_vector_sparse m p b' l' v') ->
+    n=m && o=p && b=b' &&
+    listEqualBy (fun (i,v) (i',v') -> i=i' && (value_eq strict v v')) l l' && value_eq strict v v'
+  | (V_record t l, V_record t' l') ->
+      t = t' &&
+      listEqualBy (id_value_eq strict) l l'
+  | (V_ctor i t ckind v, V_ctor i' t' ckind' v') -> t = t' && ckind=ckind' && id_value_eq strict (i, v) (i', v')
+  | (V_ctor _ _ (C_Enum i) _,V_lit (L_aux (L_num j) _)) -> i = (natFromInteger j)
+  | (V_lit (L_aux (L_num j) _), V_ctor _ _ (C_Enum i) _) -> i = (natFromInteger j)
+  | (V_unknown,V_unknown) -> true
+  | (V_unknown,_) -> if strict then false else true
+  | (_,V_unknown) -> if strict then false else true
+  | (V_track v1 ts1, V_track v2 ts2) ->
+    if strict
+    then value_eq strict v1 v2 && ts1 = ts2
+    else value_eq strict v1 v2
+  | (V_track v _, v2) -> if strict then false else value_eq strict v v2
+  | (v,V_track v2 _)  -> if strict then false else value_eq strict v v2
+  | (_, _) -> false
+  end
+let {isabelle;hol} id_value_eq _ x y = unsafe_structural_equality x y
+let {isabelle;hol} value_eq _ x y = unsafe_structural_equality x y
+
+let {coq;ocaml} value_ineq n1 n2 = not (value_eq false n1 n2)
+let {isabelle;hol} value_ineq = unsafe_structural_inequality
+
+instance (Eq value)
+  let (=)  = value_eq false
+  let (<>) = value_ineq
+end
+
+let reg_start_pos reg =
+  match reg with
+    | Form_Reg _ (Just(typ,_,_,_,_)) _ ->
+      let start_from_vec targs = match targs with
+        | [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant s) _)) _;_;_;_] -> natFromInteger s
+        | [Typ_arg_aux (Typ_arg_nexp _) _; Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant s) _)) _; Typ_arg_aux (Typ_arg_order Odec) _; _] -> (natFromInteger s) - 1
+        | [_; _; Typ_arg_aux (Typ_arg_order Oinc) _; _] -> 0
+        | _ -> Assert_extra.failwith "vector type not well formed"
+      end in
+      let start_from_reg targs = match targs with
+        | [Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_app (Id_aux (Id "vector") _) targs) _)) _] -> start_from_vec targs
+        | _ -> Assert_extra.failwith "register not of type vector"
+      end in
+      match typ with
+        | Typ_aux (Typ_app id targs) _ ->
+           if get_id id = "vector" then start_from_vec targs
+           else if get_id id = "register" then start_from_reg targs
+           else Assert_extra.failwith "register abbrev not register or vector"
+        | _ -> Assert_extra.failwith "register abbrev not register or vector"
+      end
+   | _ -> Assert_extra.failwith "reg_start_pos found unexpected sub reg, or reg without a type"
+end
+
+let reg_size reg =
+  match reg with
+    | Form_Reg _ (Just(typ,_,_,_,_)) _ ->
+      let end_from_vec targs = match targs with
+        | [_;Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant s) _)) _;_;_] -> natFromInteger s
+        | _ -> Assert_extra.failwith "register vector type not well formed"
+      end in
+      let end_from_reg targs = match targs with
+        | [Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_app (Id_aux (Id "vector") _) targs) _)) _] -> end_from_vec targs
+        | _ -> Assert_extra.failwith "register does not contain vector"
+      end in
+      match typ with
+        | Typ_aux (Typ_app id targs) _ ->
+           if get_id id = "vector" then end_from_vec targs
+           else if get_id id = "register" then end_from_reg targs
+           else Assert_extra.failwith "register type is none of vector, register, or abbrev"
+        | _ -> Assert_extra.failwith "register type is none of vector, register, or abbrev"
+      end
+   | _ -> Assert_extra.failwith "reg_size given unexpected sub reg or reg without a type"
+end
+
+(*Constant unit value, for use in interpreter *)
+let unit_ty = Typ_aux (Typ_id (Id_aux (Id "unit") Unknown)) Unknown
+let unitv = V_lit (L_aux L_unit Unknown)
+let unit_e = E_aux (E_lit (L_aux L_unit Unknown)) (Unknown, val_annot unit_ty)
+
+(* Store for local memory of ref cells, string stores the name of the function the memory is being created for*)
+type lmem = LMem of string * nat * map nat value * set nat
+
+(* Environment for bindings *)
+type env = map string value
+(* Environment for lexical bindings, nat is a counter to build new unique variables when necessary *)
+type lenv = LEnv of nat * env
+
+let emem name = LMem name 1 Map.empty Set.empty
+let eenv = LEnv 1 Map.empty
+
+let rec list_to_string sep format = function
+  | [] -> ""
+  | [i] -> format i
+  | i::ls -> (format i) ^ sep ^ list_to_string sep format ls
+end
+
+let env_to_string (LEnv c env) =
+  "(LEnv " ^ show c ^ " [" ^
+  (list_to_string ", " (fun (k,v) -> k ^ " -> " ^ (string_of_value v)) (Map_extra.toList env)) ^
+    "])"
+
+instance (Show lenv)
+  let show env = env_to_string env
+end
+
+let mem_to_string (LMem f c mem _) =
+  "(LMem " ^ f ^ " " ^ show c ^
+  " [" ^ (list_to_string ", " (fun (k,v) -> show k ^ " -> " ^ (string_of_value v)) (Map_extra.toList mem)) ^ "])"
+
+instance (Show lmem)
+  let show mem = mem_to_string mem
+end
+
+type sub_reg_map = map string index_range
+
+(*top_level is a tuple of
+  (function definitions environment,
+   all extracted instructions (where possible),
+   default direction
+   letbound and enum values,
+   register values,
+   Typedef union constructors,
+   sub register mappings, and register aliases) *)
+type top_level =
+  | Env of map string (list (funcl tannot)) (*function definitions environment*)
+        * list instruction_form (* extracted instructions (where extractable) *)
+        * i_direction (*default direction*)
+        * env (*letbound and enum values*)
+        * env (*register values*)
+        * map string typ (*typedef union constructors *)
+        * map string sub_reg_map (*sub register mappings*)
+        * map string (alias_spec tannot) (*register aliases*)
+        * bool (* debug? *)
+
+type action =
+ | Read_reg of reg_form * maybe (nat * nat)
+ | Write_reg of reg_form * maybe (nat * nat) * value
+ | Read_mem of id * value * maybe (nat * nat)
+ | Read_mem_tagged of id * value * maybe (nat * nat)
+ | Write_mem of id * value * maybe (nat * nat) * value
+ | Write_ea of id * value
+ | Write_memv of id * value * value
+ | Excl_res of id
+ | Write_memv_tagged of id * value * value * value
+ | Barrier of id * value
+ | Footprint of id * value
+ | Nondet of list (exp tannot) * tag
+ | Call_extern of string * value
+ | Return of value
+ | Exit of (exp tannot)
+ (* For the error case of a failed assert, carries up an optional error message*)
+ | Fail of value
+ (* For stepper, no action needed. String is function called, value is parameter where applicable *)
+ | Step of l * maybe string * maybe value
+
+(* Inverted call stack, where the frame with a Top stack waits for an action to resolve and
+   all other frames for their inner stack *)
+type stack =
+ | Top
+ | Hole_frame of id * exp tannot * top_level * lenv * lmem * stack (* Stack frame waiting for a value *)
+ | Thunk_frame of exp tannot * top_level * lenv * lmem * stack     (* Paused stack frame *)
+
+(*Internal representation of outcomes from running the interpreter.
+  Actions request an external party to resolve a request *)
+type outcome =
+ | Value of value
+ | Action of action * stack
+ | Error of l * string
+
+let string_of_id id' =
+  (match id' with
+   | Id_aux id _ ->
+      (match id with
+       | Id s -> s
+       | DeIid s -> s
+       end)
+   end)
+
+instance (Show id)
+  let show = string_of_id
+end
+
+let string_of_kid kid' =
+  (match kid' with
+   | Kid_aux kid _ ->
+     (match kid with
+      | Var s -> s
+      end)
+   end)
+
+instance (Show kid)
+  let show = string_of_kid
+end
+
+let string_of_reg_id (RI_aux (RI_id id ) _) = string_of_id id
+
+instance forall 'a. (Show reg_id 'a)
+  let show = string_of_reg_id
+end
+
+let rec string_of_typ typ' =
+  (match typ' with
+   | Typ_aux typ _ ->
+      (match typ with
+       | Typ_wild -> "(Typ_wild)"
+       | Typ_id id -> "(Typ_id " ^ (string_of_id id) ^ ")"
+       | Typ_var kid -> "(Typ_var " ^ (string_of_kid kid) ^ ")"
+       | Typ_fn typ1 typ2 eff -> "(Typ_fn _ _ _)"
+       | Typ_tup typs -> "(Typ_tup [" ^ String.concat "; " (List.map string_of_typ typs) ^ "])"
+       | Typ_app id args -> "(Typ_app " ^ string_of_id id ^ " _)"
+       end)
+   end)
+
+instance (Show typ)
+  let show = string_of_typ
+end
+
+let rec string_of_lexp l' =
+  (match l' with
+   | LEXP_aux l _ ->
+      (match l with
+       | LEXP_id id -> "(LEXP_id " ^ string_of_id id ^ ")"
+       | LEXP_memory id exps -> "(LEXP_memory " ^ string_of_id id ^ " _)"
+       | LEXP_cast typ id -> "(LEXP_cast " ^ string_of_typ typ ^ " " ^ string_of_id id ^ ")"
+       | LEXP_tup lexps -> "(LEXP_tup [" ^ String.concat "; " (List.map string_of_lexp lexps) ^ "])"
+       | LEXP_vector lexps exps -> "(LEXP_vector _ _)"
+       | LEXP_vector_range lexp exp1 exp2 -> "(LEXP_vector_range _ _ _)"
+       | LEXP_field lexp id -> "(LEXP_field " ^ string_of_lexp lexp ^ "." ^ string_of_id id ^ ")"
+       end)
+   end)
+
+instance forall 'a. (Show lexp 'a)
+  let show = string_of_lexp
+end
+
+let string_of_lit l' =
+  (match l' with
+   | L_aux l _ ->
+      (match l with
+       | L_unit -> "()"
+       | L_zero -> "0"
+       | L_one -> "1"
+       | L_true -> "true"
+       | L_false -> "false"
+       | L_num n -> "0d" ^ (show n)
+       | L_hex s -> "0x" ^ s
+       | L_bin s -> "0b" ^ s
+       | L_undef -> "undef"
+       | L_string s -> "\"" ^ s ^ "\""
+       end)
+   end)
+
+instance (Show lit)
+  let show = string_of_lit
+end
+
+let string_of_order o' =
+  (match o' with
+   | Ord_aux o _ ->
+      (match o with
+       | Ord_var kid -> string_of_kid kid
+       | Ord_inc -> "inc"
+       | Ord_dec -> "dec"
+       end)
+   end)
+
+instance (Show order)
+  let show = string_of_order
+end
+
+let rec string_of_exp e' =
+  (match e' with
+   | E_aux e _ ->
+      (match e with
+       | E_block exps -> "(E_block [" ^ String.concat "; " (List.map string_of_exp exps) ^ "])"
+       | E_nondet exps -> "(E_nondet [" ^ String.concat "; " (List.map string_of_exp exps) ^ "])"
+       | E_id id -> "(E_id \"" ^ string_of_id id ^ "\")"
+       | E_lit lit -> "(E_lit " ^ string_of_lit lit ^ ")"
+       | E_cast typ exp -> "(E_cast " ^ string_of_typ typ ^ " " ^ string_of_exp exp ^ ")"
+       | E_app id exps -> "(E_app " ^ string_of_id id ^ " [" ^ String.concat "; " (List.map string_of_exp exps) ^ "])"
+       | E_app_infix exp1 id exp2 -> "(E_app_infix " ^ string_of_exp exp1 ^ " " ^ string_of_id id ^ " " ^ string_of_exp exp2 ^ ")"
+       | E_tuple exps -> "(E_tuple [" ^ String.concat "; " (List.map string_of_exp exps) ^ "])"
+       | E_if cond thn els -> "(E_if " ^ (string_of_exp cond) ^ " ? " ^ (string_of_exp thn) ^ " : " ^ (string_of_exp els) ^ ")"
+       | E_for id from to_ by order exp -> "(E_for " ^ string_of_id id ^ " " ^ string_of_exp from ^ " " ^ string_of_exp to_ ^ " " ^ string_of_exp by ^ " " ^ string_of_order order ^ " " ^ string_of_exp exp ^ ")"
+       | E_vector exps -> "(E_vector [" ^ String.concat "; " (List.map string_of_exp exps) ^ "])"
+       | E_vector_access exp1 exp2 -> "(E_vector_access " ^ string_of_exp exp1 ^ " " ^ string_of_exp exp2 ^ ")"
+       | E_vector_subrange exp1 exp2 exp3 -> "(E_vector_subrange " ^ string_of_exp exp1 ^ " " ^ string_of_exp exp2 ^ " " ^ string_of_exp exp3 ^ ")"
+       | E_vector_update _ _ _ -> "(E_vector_update)"
+       | E_vector_update_subrange _ _ _ _ -> "(E_vector_update_subrange)"
+       | E_vector_append exp1 exp2 -> "(E_vector_append " ^ string_of_exp exp1 ^ " " ^ string_of_exp exp2 ^ ")"
+       | E_list exps -> "(E_list [" ^ String.concat "; " (List.map string_of_exp exps) ^ "])"
+       | E_cons exp1 exp2 -> "(E_cons " ^ string_of_exp exp1 ^ " :: " ^ string_of_exp exp2 ^ ")"
+       | E_record _ -> "(E_record)"
+       | E_record_update _ _ -> "(E_record_update)"
+       | E_field _ _ -> "(E_field)"
+       | E_case _ _ -> "(E_case)"
+       | E_let _ _ -> "(E_let)"
+       | E_assign lexp exp -> "(E_assign " ^ string_of_lexp lexp ^ " := " ^ string_of_exp exp ^ ")"
+       | E_sizeof _ -> "(E_sizeof _)"
+       | E_exit exp -> "(E_exit " ^ string_of_exp exp ^ ")"
+       | E_return exp -> "(E_return " ^ string_of_exp exp ^ ")"
+       | E_assert cond msg -> "(E_assert " ^ string_of_exp cond ^ " " ^ string_of_exp msg ^ ")"
+       | E_internal_cast _ _ -> "(E_internal_cast _ _)"
+       | E_internal_exp _ -> "(E_internal_exp _)"
+       | E_sizeof_internal _ -> "(E_size _)"
+       | E_internal_exp_user _ _ -> "(E_internal_exp_user _ _)"
+       | E_comment _ -> "(E_comment _)"
+       | E_comment_struc _ -> "(E_comment_struc _)"
+       | E_internal_let _ _ _ -> "(E_internal_let _ _ _)"
+       | E_internal_plet _ _ _ -> "(E_internal_plet _ _ _)"
+       | E_internal_return _ -> "(E_internal_return _)"
+       | E_internal_value value -> "(E_internal_value " ^ debug_print_value value ^ ")"
+       end)
+   end)
+
+instance forall 'a. (Show (exp 'a))
+  let show = string_of_exp
+end
+
+let string_of_alias_spec (AL_aux _as _) =
+  (match _as with
+   | AL_subreg reg_id id -> "(AL_subreg " ^ (show reg_id) ^ " " ^ (show id) ^ ")"
+   | AL_bit reg_id exp -> "(AL_bit " ^ (show reg_id) ^ " " ^ (show exp) ^ ")"
+   | AL_slice reg_id exp1 exp2 -> "(AL_slice " ^ (show reg_id) ^ " " ^ (show exp1) ^ " " ^ (show exp2) ^ ")"
+   | AL_concat reg_id1 reg_id2 -> "(AL_concat " ^ (show reg_id1) ^ " " ^ (show reg_id2) ^ ")"
+   end)
+
+instance forall 'a. (Show alias_spec 'a)
+  let show = string_of_alias_spec
+end
+
+let string_of_quant_item (QI_aux qi _) =
+  (match qi with
+   | QI_id kinded_id -> "(QI_id _)"
+   | QI_const nc -> "(QI_const _)"
+   end)
+
+instance (Show quant_item)
+  let show = string_of_quant_item
+end
+
+let string_of_typquant (TypQ_aux tq _) =
+  (match tq with
+   | TypQ_tq qis -> "(TypQ_tq [" ^ (String.concat "; " (List.map show qis)) ^ "]"
+   | TypQ_no_forall -> "TypQ_no_forall"
+   end)
+
+instance (Show typquant)
+  let show = string_of_typquant
+end
+
+let string_of_typschm (TypSchm_aux (TypSchm_ts typquant typ) _) =
+  "(TypSchm " ^ (show typquant) ^ " " ^ (show typ) ^ ")"
+
+instance (Show typschm)
+  let show = string_of_typschm
+end
+
+let rec string_of_pat (P_aux pat _) =
+  (match pat with
+   | P_lit lit -> "(P_lit " ^ show lit ^ ")"
+   | P_wild -> "P_wild"
+   | P_as pat' id -> "(P_as " ^ string_of_pat pat' ^ " " ^ show id ^ ")"
+   | P_typ typ pat' -> "(P_typ" ^ show typ ^ " " ^ string_of_pat pat' ^ ")"
+   | P_id id -> "(P_id " ^ show id ^ ")"
+   | P_app id pats -> "(P_app " ^ show id ^ " [" ^ String.concat "; " (List.map string_of_pat pats) ^ "])"
+   | P_record _ _ -> "(P_record _ _)"
+   | P_vector pats -> "(P_vector [" ^ String.concat "; " (List.map string_of_pat pats) ^ "])"
+   | P_vector_concat pats -> "(P_vector_concat [" ^ String.concat "; " (List.map string_of_pat pats) ^ "])"
+   | P_tup pats -> "(P_tup [" ^ String.concat "; " (List.map string_of_pat pats) ^ "])"
+   | P_list pats -> "(P_list [" ^ String.concat "; " (List.map string_of_pat pats) ^ "])"
+   end)
+
+instance forall 'a. (Show pat 'a)
+  let show = string_of_pat
+end
+
+let string_of_letbind (LB_aux lb _) =
+  (match lb with
+   | LB_val pat exp -> "(LB_val " ^ (show pat) ^ " " ^ (show exp) ^ ")"
+   end)
+
+instance forall 'a. (Show letbind 'a)
+  let show = string_of_letbind
+end
+
+type interp_mode = <| eager_eval : bool; track_values : bool; track_lmem : bool; debug : bool; debug_indent : string |>
+
+let indent_mode mode = if mode.debug then <| mode with debug_indent = "  " ^ mode.debug_indent |> else mode
+
+val debug_fun_enter : interp_mode -> string -> list string -> unit
+let debug_fun_enter mode name args =
+  if mode.debug then
+    debug_print (mode.debug_indent ^ ":: " ^ name ^ " args: [" ^ (String.concat "; " args) ^ "]\n")
+  else
+    ()
+
+val debug_fun_exit : forall 'a. Show 'a => interp_mode -> string -> 'a -> unit
+let debug_fun_exit mode name retval =
+  if mode.debug then
+    debug_print (mode.debug_indent ^ "=> " ^ name ^ " returns: " ^ (show retval) ^ "\n")
+  else
+    ()
+
+(* Evaluates global let binds and prepares the context for individual expression evaluation in the current model *)
+val to_top_env : bool -> (i_direction -> outcome -> maybe value) -> defs tannot -> (maybe outcome * top_level)
+val get_default_direction : top_level -> i_direction
+
+(* interprets the exp sequentially in the presence of a set of top level definitions and returns a value, a memory request, or other external action *)
+val interp :interp_mode -> (i_direction -> outcome -> maybe value) -> defs tannot -> exp tannot -> (outcome * lmem * lenv)
+
+(* Takes a paused partially evaluated expression, puts the value into the environment, and runs again *)
+val resume : interp_mode -> stack -> maybe value -> (outcome * lmem * lenv)
+
+(* Internal definitions to setup top_level *)
+val to_fdefs : defs tannot -> map string (list (funcl tannot))
+let rec to_fdefs (Defs defs) =
+  match defs with
+    | [] -> Map.empty
+    | def::defs ->
+      match def with
+        | DEF_fundef f -> (match f with
+            | FD_aux (FD_function _ _ _ fcls) _ ->
+              match fcls with
+                | [] -> to_fdefs (Defs defs)
+                | (FCL_aux (FCL_Funcl name _) _)::_  ->
+                  Map.insert (get_id name) fcls (to_fdefs (Defs defs)) end end)
+        | _ -> to_fdefs (Defs defs) end end
+
+val to_register_fields : defs tannot -> map string (map string index_range)
+let rec to_register_fields (Defs defs) =
+  match defs with
+  | [ ] -> Map.empty
+  | def::defs ->
+    match def with
+    | DEF_type (TD_aux (TD_register id n1 n2 indexes) l') ->
+      Map.insert (get_id id)
+                 (List.foldr (fun (a,b) imap -> Map.insert (get_id b) a imap) Map.empty indexes)
+                 (to_register_fields (Defs defs))
+    | _ -> to_register_fields (Defs defs)
+    end
+  end
+
+val to_registers : i_direction -> defs tannot -> env
+let rec to_registers dd (Defs defs) =
+  match defs with
+  | [ ] -> Map.empty
+  | def::defs ->
+    match def with
+    | DEF_reg_dec (DEC_aux (DEC_reg typ id) (l,tannot)) ->
+      let dir =  match tannot with
+        | Nothing -> dd
+        | Just(t, _, _, _,_) -> dd (*TODO, lets pull the direction out properly*)
+      end in
+      Map.insert (get_id id) (V_register(Form_Reg id tannot dir)) (to_registers dd (Defs defs))
+    | DEF_reg_dec (DEC_aux (DEC_alias id aspec) (l,tannot)) ->
+      Map.insert (get_id id) (V_register_alias aspec tannot) (to_registers dd (Defs defs))
+    | _ -> to_registers dd (Defs defs)
+    end
+  end
+
+val to_aliases : defs tannot -> map string (alias_spec tannot)
+let rec to_aliases (Defs defs) =
+  match defs with
+    | [] -> Map.empty
+    | def::defs ->
+      match def with
+        | DEF_reg_dec (DEC_aux (DEC_alias id aspec) _) ->
+          Map.insert (get_id id) aspec (to_aliases (Defs defs))
+        | DEF_reg_dec (DEC_aux (DEC_typ_alias typ id aspec) _) ->
+          Map.insert (get_id id) aspec (to_aliases (Defs defs))
+        | _ -> to_aliases (Defs defs)
+      end
+    end
+
+val to_data_constructors : defs tannot -> map string typ
+let rec to_data_constructors (Defs defs) =
+  match defs with
+  | [] ->
+    (*Prime environment with built-in constructors*)
+    Map.insert "Some" (Typ_aux (Typ_var (Kid_aux (Var "a") Unknown)) Unknown)
+      (Map.insert "None" unit_t Map.empty)
+  | def :: defs ->
+    match def with
+    | DEF_type (TD_aux t _)->
+      match t with
+      | TD_variant id _ tq tid_list _ ->
+        (List.foldr
+           (fun (Tu_aux t _) map ->
+             match t with
+               | (Tu_ty_id x y) -> Map.insert (get_id y) x map
+               | Tu_id x -> Map.insert (get_id x) unit_t map end)
+           (to_data_constructors (Defs defs))) tid_list
+      | _ -> to_data_constructors (Defs defs) end
+    | _ -> to_data_constructors (Defs defs) end
+   end
+
+(*Memory and environment helper functions*)
+val env_from_list : list (id * value) -> env
+let env_from_list ls = List.foldr (fun (id,v) env -> Map.insert (get_id id) v env) Map.empty ls
+
+val in_env :forall 'a. map string 'a -> string -> maybe 'a
+let in_env env id = Map.lookup id env
+
+val in_lenv : lenv -> id -> value
+let in_lenv (LEnv _ env) id =
+  match in_env env (get_id id) with
+  | Nothing -> V_unknown
+  | Just v  -> v
+end
+
+(*Prefer entries in the first when in conflict*)
+val union_env : lenv -> lenv -> lenv
+let union_env (LEnv i1 env1) (LEnv i2 env2) =
+  let l = if i1 < i2 then i2 else i1 in
+  LEnv l (Map.(union) env2 env1)
+
+val fresh_var : lenv -> (id * lenv)
+let fresh_var (LEnv i env) =
+  let lenv = (LEnv (i+1) env) in
+  ((Id_aux (Id ((show i) ^ "var")) Interp_ast.Unknown), lenv)
+
+val add_to_env : (id * value) -> lenv -> lenv
+let add_to_env (id, entry) (LEnv i env) = (LEnv i (Map.insert (get_id id) entry env))
+
+val in_mem : lmem -> nat -> value
+let in_mem (LMem _ _ m _) n =
+  Map_extra.find n m
+  (* Map.lookup n m *)
+
+val update_mem : bool -> lmem -> nat -> value -> lmem
+let update_mem track (LMem owner c m s) loc value =
+  let m' = Map.delete loc m in
+  let m' = Map.insert loc value m' in
+  let s' = if track then Set.insert loc s else s in
+  LMem owner c m' s'
+
+val clear_updates : lmem -> lmem
+let clear_updates (LMem owner c m _) = LMem owner c m Set.empty
+
+(*Value helper functions*)
+
+val is_lit_vector : lit -> bool
+let is_lit_vector (L_aux l _) =
+  match l with
+  | L_bin _ -> true
+  | L_hex _ -> true
+  | _ -> false
+end
+
+val litV_to_vec : lit -> i_direction -> value
+let litV_to_vec (L_aux lit l) (dir: i_direction) =
+  match lit with
+  | L_hex s ->
+    let to_v b = V_lit (L_aux b l) in
+    let hexes = List.map to_v
+                 (List.concat
+                    (List.map
+                       (fun s -> match s with
+                         | #'0' -> [L_zero;L_zero;L_zero;L_zero]
+                         | #'1' -> [L_zero;L_zero;L_zero;L_one ]
+                         | #'2' -> [L_zero;L_zero;L_one ;L_zero]
+                         | #'3' -> [L_zero;L_zero;L_one ;L_one ]
+                         | #'4' -> [L_zero;L_one ;L_zero;L_zero]
+                         | #'5' -> [L_zero;L_one ;L_zero;L_one ]
+                         | #'6' -> [L_zero;L_one ;L_one ;L_zero]
+                         | #'7' -> [L_zero;L_one ;L_one ;L_one ]
+                         | #'8' -> [L_one ;L_zero;L_zero;L_zero]
+                         | #'9' -> [L_one ;L_zero;L_zero;L_one ]
+                         | #'A' -> [L_one ;L_zero;L_one ;L_zero]
+                         | #'B' -> [L_one ;L_zero;L_one ;L_one ]
+                         | #'C' -> [L_one ;L_one ;L_zero;L_zero]
+                         | #'D' -> [L_one ;L_one ;L_zero;L_one ]
+                         | #'E' -> [L_one ;L_one ;L_one ;L_zero]
+                         | #'F' -> [L_one ;L_one ;L_one ;L_one ]
+                         | #'a' -> [L_one ;L_zero;L_one ;L_zero]
+                         | #'b' -> [L_one ;L_zero;L_one ;L_one ]
+                         | #'c' -> [L_one ;L_one ;L_zero;L_zero]
+                         | #'d' -> [L_one ;L_one ;L_zero;L_one ]
+                         | #'e' -> [L_one ;L_one ;L_one ;L_zero]
+                         | #'f' -> [L_one ;L_one ;L_one ;L_one ]
+                         | _ -> Assert_extra.failwith "Lexer did not restrict to valid hex" end)
+                       (String.toCharList s))) in
+    V_vector (if is_inc(dir) then 0 else ((List.length hexes) - 1)) dir hexes
+  | L_bin s ->
+    let bits = List.map
+      (fun s -> match s with
+        | #'0' -> (V_lit (L_aux L_zero l))
+        | #'1' -> (V_lit (L_aux L_one l))
+        | _ -> Assert_extra.failwith "Lexer did not restrict to valid bin"
+        end) (String.toCharList s) in
+    V_vector (if is_inc(dir) then 0 else ((List.length bits) -1)) dir bits
+  | _ -> Assert_extra.failwith "litV predicate did not restrict to literal vectors"
+end
+
+val list_nth : forall 'a . list 'a -> nat -> 'a
+let list_nth l n = List_extra.nth l n
+
+val list_length : forall 'a . list 'a -> integer
+let list_length l = integerFromNat (List.length l)
+
+val taint: value -> set reg_form -> value
+let rec taint value regs =
+  if Set.null regs
+  then value
+  else match value with
+    | V_track value rs -> taint value (regs union rs)
+    | V_tuple vals -> V_tuple (List.map (fun v -> taint v regs) vals)
+    | _ -> V_track value regs
+end
+
+val retaint: value -> value -> value
+let retaint orig updated =
+  match orig with
+    | V_track _ rs -> taint updated rs
+    | _ -> updated
+end
+
+val detaint: value -> value
+let rec detaint value =
+  match value with
+    | V_track value _ -> detaint value
+    | v -> v
+end
+
+(* the inner lambda is to make Isabelle happier about overlapping patterns *)
+let rec binary_taint thunk = fun vall valr ->
+ match (vall,valr) with
+   | (V_track vl rl,V_track vr rr) -> taint (binary_taint thunk vl vr) (rl union rr)
+   | (V_track vl rl,vr) -> taint (binary_taint thunk vl vr) rl
+   | (vl,V_track vr rr) -> taint (binary_taint thunk vl vr) rr
+   | (vl,vr) -> thunk vl vr
+end
+
+let rec merge_values v1 v2 =
+  if value_eq true v1 v2
+  then v1
+  else match (v1,v2) with
+  | (V_lit l, V_lit l') -> if lit_eq l l' then v1 else V_unknown
+  | (V_boxref n t, V_boxref m t') ->
+    (*Changes to memory handled by merge_mem*)
+    if n = m then v1 else V_unknown
+  | (V_tuple l, V_tuple l') ->
+    V_tuple (map2 merge_values l l')
+  | (V_list l, V_list l') ->
+    if (List.length l = List.length l')
+    then V_list (map2 merge_values l l')
+    else V_unknown
+  | (V_vector n b l, V_vector m b' l') ->
+    if b = b' && (List.length l = List.length l')
+    then V_vector n b (map2 merge_values l l')
+    else V_unknown
+  | (V_vector_sparse n o b l v, V_vector_sparse m p b' l' v') ->
+    if (n=m && o=p && b=b' && listEqualBy (fun (i,_) (i',_) -> i=i') l l')
+    then V_vector_sparse n o b (map2 (fun (i,v1) (i',v2) -> (i, merge_values v1 v2)) l l') (merge_values v v')
+    else V_unknown
+  | (V_record t l, V_record t' l') ->
+    (*assumes canonical order for fields in a record*)
+    if t = t' && List.length l = length l'
+    then V_record t (map2 (fun (i,v1) (_,v2) -> (i, merge_values v1 v2)) l l')
+    else V_unknown
+  | (V_ctor i t (C_Enum j) v, V_ctor i' t' (C_Enum j') v') ->
+    if i = i' then v1 else V_unknown
+  | (V_ctor _ _ (C_Enum i) _,V_lit (L_aux (L_num j) _)) -> if i = (natFromInteger j) then v1 else V_unknown
+  | (V_lit (L_aux (L_num j) _), V_ctor _ _ (C_Enum i) _) -> if i = (natFromInteger j) then v2 else V_unknown
+  | (V_ctor i t ckind v, V_ctor i' t' _ v') ->
+    if t = t' && i = i'
+    then (V_ctor i t ckind (merge_values v v'))
+    else V_unknown
+  | (V_unknown,V_unknown) -> V_unknown
+  | (V_track v1 ts1, V_track v2 ts2) ->
+    taint (merge_values v1 v2) (ts1 union ts2)
+  | (V_track v1 ts, v2) -> taint (merge_values v1 v2) ts
+  | (v1,V_track v2 ts)  -> taint (merge_values v1 v2) ts
+  | (_, _) -> V_unknown
+end
+
+val merge_lmems : lmem -> lmem -> lmem
+let merge_lmems ((LMem owner1 c1 mem1 set1) as lmem1) ((LMem owner2 c2 mem2 set2) as lmem2) =
+  let diff1 = Set_extra.toList (set1 \ set2) in
+  let diff2 = Set_extra.toList (set2 \ set1) in
+  let inters = Set_extra.toList (set1 inter set2) in
+  let c = max c1 c2 in
+  let mem = LMem owner1 c (if c1 >= c2 then mem1 else mem2) Set.empty in
+  let diff_mem1 =
+    List.foldr
+      (fun i mem -> update_mem false mem i
+        (match Map.lookup i mem2 with
+          | Nothing -> V_unknown
+          | Just v -> merge_values (in_mem lmem1 i) v end)) mem diff1 in
+  let diff_mem2 =
+    List.foldr
+      (fun i mem -> update_mem false mem i
+        (match Map.lookup i mem1 with
+          | Nothing -> V_unknown
+          | Just v -> merge_values (in_mem lmem2 i) v end)) diff_mem1 diff2 in
+  List.foldr
+    (fun i mem -> update_mem false mem i (merge_values (in_mem lmem1 i) (in_mem lmem2 i)))
+    diff_mem2 inters
+
+let vector_length v = match (detaint v) with
+  | V_vector n inc vals -> List.length vals
+  | V_vector_sparse n m inc vals def -> m
+  | V_lit _ -> 1
+  | _ -> 0
+end
+
+val access_vector : value -> nat -> value
+let access_vector v n =
+  retaint v (match (detaint v) with
+    | V_unknown -> V_unknown
+    | V_lit (L_aux L_undef _) -> v
+    | V_lit (L_aux L_zero _) -> v
+    | V_lit (L_aux L_one _ ) -> v
+    | V_vector m dir vs ->
+      list_nth vs (if is_inc(dir) then (n - m) else (m - n))
+    | V_vector_sparse _ _ _ vs d ->
+      match (List.lookup n vs) with
+        | Nothing -> d
+        | Just v  -> v end
+    | _ -> Assert_extra.failwith ("access_vector given unexpected " ^ string_of_value v)
+  end )
+
+val from_n_to_n :forall 'a. nat -> nat  -> list 'a -> list 'a
+let from_n_to_n from to_ ls = take (to_ - from + 1) (drop from ls)
+
+val slice_sparse_list : (nat -> nat -> bool) -> (nat -> nat) -> list (nat * value) -> nat -> nat -> ((list (nat * value)) * bool)
+let rec slice_sparse_list compare update_n vals n1 n2 =
+  let sl = slice_sparse_list compare update_n in
+  if (n1 = n2) && (vals = [])
+  then ([],true)
+  else if (n1=n2)
+  then ([],false)
+  else match vals with
+    | [] -> ([],true)
+    | (i,v)::vals ->
+      if n1 = i
+      then let (rest,still_sparse) = (sl vals (update_n n1) n2) in ((i,v)::rest,still_sparse)
+      else if (compare n1 i)
+      then  (sl vals (update_n n1) n2)
+      else let (rest,_) = (sl vals (update_n i) n2) in ((i,v)::rest,true)
+  end
+
+val slice_vector : value -> nat -> nat -> value
+let slice_vector v n1 n2 =
+  retaint v (match detaint v with
+    | V_vector m dir vs ->
+      if is_inc(dir)
+      then V_vector n1 dir (from_n_to_n (n1 - m) (n2 - m) vs)
+      else V_vector n1 dir (from_n_to_n (m - n1) (m - n2) vs)
+    | V_vector_sparse m n dir vs d ->
+      let (slice, still_sparse) =
+        if is_inc(dir)
+        then slice_sparse_list (>) (fun i -> i + 1) vs n1 n2
+        else slice_sparse_list (<) (fun i -> i - 1) vs n1 n2 in
+      if still_sparse && is_inc(dir)
+      then V_vector_sparse n1 (n2 - n1) dir slice d
+      else if is_inc(dir) then V_vector 0 dir (List.map snd slice)
+      else if still_sparse then V_vector_sparse n1 (n1 - n2) dir slice d
+      else V_vector n1 dir (List.map snd slice)
+    | _ -> Assert_extra.failwith ("slice_vector given unexpected " ^ string_of_value v)
+  end )
+
+val update_field_list : list (id * value) -> env -> list (id * value)
+let rec update_field_list base updates =
+  match base with
+  | [] -> []
+  | (id,v)::bs -> match in_env updates (get_id id) with
+    | Just v -> (id,v)::(update_field_list bs updates)
+    | Nothing -> (id,v)::(update_field_list bs updates) end
+end
+
+val fupdate_record : value -> value -> value
+let fupdate_record base updates =
+  let fupdate_record_helper base updates =
+      (match (base,updates) with
+        | (V_record t bs,V_record _ us) -> V_record t (update_field_list bs (env_from_list us))
+        | _ ->
+          Assert_extra.failwith ("fupdate_record given unexpected " ^
+                                 string_of_value base ^ " and " ^ (string_of_value updates))
+       end) in
+  binary_taint fupdate_record_helper base updates
+
+val fupdate_sparse : (nat -> nat -> bool) -> list (nat*value) -> nat -> value -> list (nat*value)
+let rec fupdate_sparse comes_after vs n vexp =
+  match vs with
+    | [] -> [(n,vexp)]
+    | (i,v)::vs ->
+      if i = n then (i,vexp)::vs
+      else if (comes_after i n) then (n,vexp)::(i,v)::vs
+      else (i,v)::(fupdate_sparse comes_after vs n vexp)
+end
+
+val fupdate_vec : value -> nat -> value -> value
+let fupdate_vec v n vexp =
+  let tainted = binary_taint (fun v _ -> v) v vexp in
+  retaint tainted
+    (match detaint v with
+      | V_vector m dir vals ->
+        V_vector m dir (List.update vals (if is_inc(dir) then (n-m) else (m-n)) vexp)
+      | V_vector_sparse m o dir vals d ->
+        V_vector_sparse m o dir (fupdate_sparse (if is_inc(dir) then (>) else (<)) vals n vexp) d
+      | _ -> Assert_extra.failwith ("fupdate_vec given unexpected " ^ string_of_value v)
+    end)
+
+val replace_is : forall 'a. list 'a -> list 'a -> nat -> nat -> nat -> list 'a
+let rec replace_is ls vs base start stop =
+  match (ls,vs) with
+  | ([],_) -> []
+  | (ls,[]) -> ls
+  | (l::ls,v::vs) ->
+    if base >= start then
+      if start >= stop then v::ls
+      else v::(replace_is ls vs (base + 1) (start + 1) stop)
+    else l::(replace_is ls (v::vs) (base+1) start stop)
+  end
+
+val replace_sparse : (nat -> nat -> bool) -> list (nat * value) -> list (nat * value) -> list (nat * value)
+let rec replace_sparse compare vals reps =
+  match (vals,reps) with
+    | ([],rs) -> rs
+    | (vs,[]) -> vs
+    | ((i1,v)::vs,(i2,r)::rs) ->
+      if i1 = i2 then (i2,r)::(replace_sparse compare vs rs)
+      else if (compare i1 i2)
+      then (i1,v)::(replace_sparse compare vs ((i2,r)::rs))
+      else (i2,r)::(replace_sparse compare ((i1,v)::vs) rs)
+end
+
+val fupdate_vector_slice : value -> value -> nat -> nat -> value
+let fupdate_vector_slice vec replace start stop =
+  let fupdate_vec_help vec replace =
+    (match (vec,replace) with
+     | (V_vector m dir vals,V_vector r_m dir' reps) ->
+      V_vector m dir
+        (replace_is vals
+           (if dir=dir' then reps else (List.reverse reps))
+           0 (if is_inc(dir) then (start-m) else (m-start)) (if is_inc(dir) then (stop-m) else (m-stop)))
+    | (V_vector m dir vals, V_unknown) ->
+      V_vector m dir
+        (replace_is vals
+           (List.replicate (if is_inc(dir) then (stop-start) else (start-stop)) V_unknown)
+           0 (if is_inc(dir) then (start-m) else (m-start)) (if is_inc(dir) then (stop-m) else (m-stop)))
+    | (V_vector_sparse m n dir vals d,V_vector _ _ reps) ->
+      let (_,repsi) = List.foldl (fun (i,rs) r -> ((if is_inc(dir) then i+1 else i-1), (i,r)::rs)) (start,[]) reps in
+      (V_vector_sparse m n dir (replace_sparse (if is_inc(dir) then (<) else (>)) vals (List.reverse repsi)) d)
+    | (V_vector_sparse m n dir vals d, V_unknown) ->
+      let (_,repsi) = List.foldl (fun (i,rs) r -> ((if is_inc(dir) then i+1 else i-1), (i,r)::rs)) (start,[])
+        (List.replicate (if is_inc(dir) then (stop-start) else (start-stop)) V_unknown) in
+      (V_vector_sparse m n dir (replace_sparse (if is_inc(dir) then (<) else (>)) vals (List.reverse repsi)) d)
+    | (V_unknown,_) -> V_unknown
+    | _ -> Assert_extra.failwith ("fupdate vector slice given " ^ (string_of_value vec)
+                                  ^ " and " ^ (string_of_value replace))
+     end) in
+  binary_taint fupdate_vec_help vec replace
+
+val update_vector_slice : bool -> value -> value -> nat -> nat -> lmem -> lmem
+let update_vector_slice track vector value start stop mem =
+  match (detaint vector,detaint value) with
+  | ((V_boxref n t), v) ->
+    update_mem track mem n (fupdate_vector_slice (in_mem mem n) (retaint value v) start stop)
+  | ((V_vector m _ vs),(V_vector n _ vals)) ->
+    let (V_vector m' _ vs') = slice_vector vector start stop in
+    foldr2 (fun vbox v mem -> match vbox with
+      | V_boxref n t -> update_mem track mem n v end)
+      mem vs' vals
+  | ((V_vector m dir vs),(V_vector_sparse n o _ vals d)) ->
+    let (m',vs') = match slice_vector vector start stop with
+      | (V_vector m' _ vs') -> (m',vs')
+      | _ -> Assert_extra.failwith "slice_vector did not return vector" end in
+    let (_,mem) = foldr (fun vbox (i,mem) ->
+                          match vbox with
+                            | V_boxref n t ->
+                              (if is_inc(dir) then i+1 else i-1,
+                                update_mem track mem n (match List.lookup i vals with
+                                  | Nothing -> d
+                                  | Just v  -> v end))
+                           | _ -> Assert_extra.failwith "Internal error: update_vector_slice not of boxes"
+                          end) (m,mem) vs' in
+    mem
+  | ((V_vector m _ vs),v) ->
+    let (m',vs') = match slice_vector vector start stop with
+      | (V_vector m' _ vs') -> (m',vs')
+      | _ -> Assert_extra.failwith "slice vector didn't return vector" end in
+    List.foldr (fun vbox mem -> match vbox with
+        | V_boxref n t -> update_mem track mem n v
+        | _ -> Assert_extra.failwith "update_vector_slice not of boxes" end)
+      mem vs'
+  | _ -> Assert_extra.failwith ("update_vector_slice given unexpected " ^ string_of_value vector
+                                 ^ " and " ^ string_of_value value)
+end
+
+let update_vector_start default_dir new_start expected_size v =
+  retaint v
+    (match detaint v with
+      | V_lit (L_aux L_zero _) -> V_vector new_start default_dir [v]
+      | V_lit (L_aux L_one _) -> V_vector new_start default_dir [v]
+      | V_vector m inc vs -> V_vector new_start inc vs (*Note, may need to shrink and check if still sparse *)
+      | V_vector_sparse m n dir vals d -> V_vector_sparse new_start n dir vals d
+      | V_unknown -> V_vector new_start default_dir (List.replicate expected_size V_unknown)
+      | V_lit (L_aux L_undef _) -> V_vector new_start default_dir (List.replicate expected_size v)
+      | _ -> Assert_extra.failwith ("update_vector_start given unexpected " ^ string_of_value v)
+     end)
+
+val in_ctors : list (id * typ) -> id -> maybe typ
+let rec in_ctors ctors id =
+  match ctors with
+  | [] -> Nothing
+  | (cid,typ)::ctors -> if (get_id cid) = (get_id id) then Just typ else in_ctors ctors id
+end
+
+(*Stack manipulation functions *)
+(*Extends expression and context of 'top' stack frame *)
+let add_to_top_frame e_builder stack =
+  match stack with
+  | Top -> Top
+  | Hole_frame id e t_level env mem stack ->
+    let (e',env') = (e_builder e env) in Hole_frame id e' t_level env' mem stack
+  | Thunk_frame e t_level env mem stack ->
+    let (e',env') = (e_builder e env) in Thunk_frame e' t_level env' mem stack
+  end
+
+(*Is this the innermost hole*)
+let top_hole stack : bool =
+  match stack with
+  | Hole_frame _ (E_aux (E_id (Id_aux (Id "0") _)) _) _ _ _ Top -> true
+  | _ -> false
+end
+
+let redex_id = id_of_string "0"
+let mk_hole l annot t_level l_env l_mem =
+  Hole_frame redex_id (E_aux (E_id redex_id) (l,(intern_annot annot))) t_level l_env l_mem Top
+let mk_thunk l annot t_level l_env l_mem =
+  Thunk_frame  (E_aux (E_lit (L_aux L_unit l)) (l,(intern_annot annot))) t_level l_env l_mem Top
+
+(*Converts a Hole_frame into a Thunk_frame, pushing to the top of the stack to insert the value at the innermost context *)
+val add_answer_to_stack : stack -> value -> stack
+let rec add_answer_to_stack stack v =
+  match stack with
+  | Top -> Top
+  | Hole_frame id e t_level env mem Top -> Thunk_frame e t_level (add_to_env (id,v) env) mem Top
+  | Thunk_frame e t_level env mem Top -> Thunk_frame e t_level env mem Top
+  | Hole_frame id e t_level env mem stack -> Hole_frame id e t_level env mem (add_answer_to_stack stack v)
+  | Thunk_frame e t_level env mem stack -> Thunk_frame e t_level env mem (add_answer_to_stack stack v)
+end
+
+(*Throws away all but the environment and local memory of the top stack frame, putting given expression in this context *)
+val set_in_context : stack -> exp tannot -> stack
+let rec set_in_context stack e =
+  match stack with
+    | Top -> Top
+    | Hole_frame id oe t_level env mem Top -> Thunk_frame e t_level env mem Top
+    | Thunk_frame oe t_level env mem Top -> Thunk_frame e t_level env mem Top
+    | Hole_frame _ _ _ _ _ s -> set_in_context s e
+    | Thunk_frame _ _ _ _ s -> set_in_context s e
+end
+
+let get_stack_state stack =
+  match stack with
+    | Top -> Assert_extra.failwith "Top reached in extracting stack state"
+    | Hole_frame id exp top_level lenv lmem stack -> (lenv,lmem)
+    | Thunk_frame exp top_level lenv lmem stack -> (lenv,lmem)
+end
+
+let rec update_stack_state stack ((LMem name c mem _) as lmem) =
+  match stack with
+    | Top -> Top
+    | Hole_frame id oe t_level env (LMem _ _ _ s) Top ->
+      (match Map.lookup (0 : nat) mem with
+        | Nothing -> Thunk_frame oe t_level (add_to_env (id,V_unknown) env) (LMem name c mem s) Top
+        | Just v  -> Thunk_frame oe t_level (add_to_env (id, v) env) (LMem name c (Map.delete (0 : nat) mem) s) Top end)
+    | Thunk_frame e t_level env _ Top -> Thunk_frame e t_level env lmem Top
+    | Hole_frame id e t_level env mem s -> Hole_frame id e t_level env mem (update_stack_state s lmem)
+    | Thunk_frame e t_level env mem s -> Thunk_frame e t_level env mem (update_stack_state s lmem)
+end
+
+let rec clear_stack_state stack =
+  match stack with
+    | Top -> Top
+    | Hole_frame id e t_level env lmem Top -> Hole_frame id e t_level env (clear_updates lmem) Top
+    | Thunk_frame e t_level env lmem Top -> Thunk_frame e t_level env (clear_updates lmem) Top
+    | Hole_frame id e t_level env lmem s -> Hole_frame id e t_level env lmem (clear_stack_state s)
+    | Thunk_frame e t_level env lmem s -> Thunk_frame e t_level env lmem (clear_stack_state s)
+end
+
+let rec remove_top_stack_frame stack =
+  match stack with
+  | Top -> Top
+  | Hole_frame _ _ _ _ _ Top -> Top
+  | Thunk_frame _ _ _ _ Top -> Top
+  | Hole_frame id e t_level env lmem stack -> Hole_frame id e t_level env lmem (remove_top_stack_frame stack)
+  | Thunk_frame e t_level env lmem stack -> Thunk_frame e t_level env lmem (remove_top_stack_frame stack)
+end
+
+(*functions for converting in progress evaluation back into expression for building current continuation*)
+let rec combine_typs ts =
+  match ts with
+  | [] -> mk_typ_var "fresh"
+  | [t] -> t
+  | t::ts ->
+    let t' = combine_typs ts in
+    match (t,t') with
+      | (_,Typ_aux (Typ_var _) _) -> t
+      | ((Typ_aux (Typ_app (Id_aux (Id "range") _)
+           [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant bot1) _)) _; Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant top1) _)) _]) _),
+         (Typ_aux (Typ_app (Id_aux (Id "range") _)
+           [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant bot2) _)) _; Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant top2) _)) _]) _)) ->
+        let (smallest,largest) =
+          if bot1 <= bot2
+          then if top1 <= top2 then (bot1, top2) else (bot1, top1)
+          else if top1 <= top2 then (bot2, top2) else (bot2, top1) in
+        mk_typ_app "range" [Typ_arg_nexp (nconstant smallest); Typ_arg_nexp (nconstant largest)]
+      | ((Typ_aux (Typ_app (Id_aux (Id "atom") _) [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant a1) _)) _]) _),
+         (Typ_aux (Typ_app (Id_aux (Id "atom") _) [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant a2) _)) _]) _)) ->
+        if a1 = a2
+        then t
+        else
+          let (smaller,larger) = if a1 < a2 then (a1,a2) else (a2,a1) in
+          mk_typ_app "range" [Typ_arg_nexp (nconstant smaller); Typ_arg_nexp (nconstant larger)]
+      | (Typ_aux (Typ_app (Id_aux (Id "range") _) [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant bot) _)) _;
+                                                   Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant top) _)) _]) _,
+         Typ_aux (Typ_app (Id_aux (Id "atom") _) [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant a) _)) _]) _) ->
+        if bot <= a && a <= top
+        then t
+        else if bot <= a && top <= a
+        then mk_typ_app "range" [Typ_arg_nexp (nconstant bot); Typ_arg_nexp (nconstant a)]
+        else mk_typ_app "range" [Typ_arg_nexp (nconstant a); Typ_arg_nexp (nconstant top)]
+      | (Typ_aux (Typ_app (Id_aux (Id "atom") _) [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant a) _)) _]) _,
+         Typ_aux (Typ_app (Id_aux (Id "range") _) [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant bot) _)) _;
+                                                   Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant top) _)) _]) _) ->
+        if bot <= a && a <= top
+        then t
+        else if bot <= a && top <= a
+        then mk_typ_app "range" [Typ_arg_nexp (nconstant bot); Typ_arg_nexp (nconstant a)]
+        else mk_typ_app "range" [Typ_arg_nexp (nconstant a); Typ_arg_nexp (nconstant top)]
+      | (Typ_aux (Typ_app (Id_aux (Id "vector") _) [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant b1) _)) _;
+                                                    Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant r1) _)) _;
+                                                    Typ_arg_aux (Typ_arg_order (Ord_aux o1 _)) _;
+                                                    Typ_arg_aux (Typ_arg_typ t1) _]) _,
+         Typ_aux (Typ_app (Id_aux (Id "vector") _) [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant b2) _)) _;
+                                                    Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant r2) _)) _;
+                                                    Typ_arg_aux (Typ_arg_order (Ord_aux o2 _)) _;
+                                                    Typ_arg_aux (Typ_arg_typ t2) _]) _) ->
+         let t = combine_typs [t1;t2] in
+        match (o1,o2) with
+          | (Ord_inc,Ord_inc) ->
+            let larger_start = if b1 < b2 then b2 else b1 in
+            let smaller_rise = if r1 < r2 then r1 else r2 in
+            mk_typ_app "vector" [Typ_arg_nexp (nconstant larger_start); Typ_arg_nexp (nconstant smaller_rise);
+                                 Typ_arg_order (Ord_aux o1 Unknown); Typ_arg_typ t]
+          | (Ord_dec,Ord_dec) ->
+            let smaller_start = if b1 < b2 then b1 else b2 in
+            let smaller_fall = if r1 < r2 then r2 else r2 in
+            mk_typ_app "vector" [Typ_arg_nexp (nconstant smaller_start); Typ_arg_nexp (nconstant smaller_fall);
+                                 Typ_arg_order (Ord_aux o1 Unknown); Typ_arg_typ t]
+          | _ -> mk_typ_var "fresh"
+         end
+      | _ -> t'
+     end
+   end
+
+let reg_to_t r =
+  match r with
+    | Form_Reg _ (Just (t,_,_,_,_)) _ -> t
+    | _ -> mk_typ_var "fresh"
+ end
+
+let rec val_typ v =
+  match v with
+    | V_boxref n t -> mk_typ_app "reg" [Typ_arg_typ t]
+    | V_lit (L_aux lit _) ->
+      match lit with
+        | L_unit -> mk_typ_id "unit"
+        | L_true -> mk_typ_id "bit"
+        | L_false -> mk_typ_id "bit"
+        | L_one -> mk_typ_id "bit"
+        | L_zero -> mk_typ_id "bit"
+        | L_string _ -> mk_typ_id "string"
+        | L_num n -> mk_typ_app "atom" [Typ_arg_nexp (nconstant n)]
+        | L_undef -> mk_typ_var "fresh"
+        | L_hex _ -> Assert_extra.failwith "literal hex not removed"
+        | L_bin _ -> Assert_extra.failwith "literal bin not removed"
+      end
+    | V_tuple vals -> mk_typ_tup (List.map val_typ vals)
+    | V_vector n dir vals ->
+      let ts = List.map val_typ vals in
+      let t = combine_typs ts in
+      mk_typ_app "vector" [Typ_arg_nexp (nconstant (integerFromNat n)); Typ_arg_nexp (nconstant (list_length vals));
+                           Typ_arg_order (Ord_aux (if is_inc dir then Ord_inc else Ord_dec) Unknown);
+                           Typ_arg_typ t]
+    | V_vector_sparse n m dir vals d ->
+      let ts = List.map val_typ (d::(List.map snd vals)) in
+      let t = combine_typs ts in
+      mk_typ_app "vector" [Typ_arg_nexp (nconstant (integerFromNat n)); Typ_arg_nexp (nconstant (integerFromNat m));
+                           Typ_arg_order (Ord_aux (if is_inc dir then Ord_inc else Ord_dec) Unknown);
+                           Typ_arg_typ t]
+    | V_record t ivals -> t
+    | V_list vals ->
+      let ts = List.map val_typ vals in
+      let t = combine_typs ts in
+      mk_typ_app "list" [Typ_arg_typ t]
+    | V_ctor id t _ vals -> t
+    | V_register reg -> reg_to_t reg
+    | V_track v _ -> val_typ v
+    | V_unknown -> mk_typ_var "fresh"
+    | V_register_alias _ _ -> mk_typ_var "fresh"
+  end
+
+let rec to_exp mode env v : (exp tannot * lenv) =
+  ((E_aux (E_internal_value v) (Interp_ast.Unknown, (val_annot (val_typ v)))), env)
+
+val env_to_let : interp_mode -> lenv -> (exp tannot) -> lenv -> ((exp tannot) * lenv)
+let rec env_to_let_help mode env taint_env = match env with
+  | [] -> ([],taint_env)
+  | (i,v)::env ->
+    let t = (val_typ v) in
+    let tan = (val_annot t) in
+    let (e,taint_env) = to_exp mode taint_env v in
+    let (rest,taint_env) = env_to_let_help mode env taint_env in
+    ((((P_aux (P_id (id_of_string i)) (Unknown,tan)),e),t)::rest, taint_env)
+end
+
+let env_to_let mode (LEnv _ env) (E_aux e annot) taint_env =
+  match env_to_let_help mode (Set_extra.toList (Map.toSet env)) taint_env with
+    | ([],taint_env) -> (E_aux e annot,taint_env)
+    | ([((p,e),t)],tain_env) ->
+      (E_aux (E_let (LB_aux (LB_val p e) (Unknown,(val_annot t))) e) annot,taint_env)
+    | (pts,taint_env) ->
+      let ts = List.map snd pts in
+      let pes = List.map fst pts in
+      let ps = List.map fst pes in
+      let es = List.map snd pes in
+      let t = mk_typ_tup ts in
+      let tan = val_annot t in
+      (E_aux (E_let (LB_aux (LB_val (P_aux (P_tup ps) (Unknown,tan))
+                               (E_aux (E_tuple es) (Unknown,tan))) (Unknown,tan))
+                    (E_aux e annot))
+        annot, taint_env)
+end
+
+let fix_up_nondet typ branches annot =
+  match typ with
+    | Typ_aux (Typ_id (Id_aux (Id "unit") _)) _ -> (branches, Nothing)
+    | _ -> ((List.map
+      (fun e -> E_aux (E_assign (LEXP_aux (LEXP_id redex_id) annot) e) annot) branches), Just "0")
+end
+
+(* match_pattern returns a tuple of (pattern_matches? , pattern_passed_due_to_unknown?, env_of_pattern *)
+val match_pattern : top_level -> pat tannot -> value -> bool * bool * lenv
+let rec match_pattern t_level (P_aux p (_, annot)) value_whole =
+  let (Env fdefs instrs default_dir lets regs ctors subregs aliases debug) = t_level in
+  let (t,tag,cs) = match annot with
+    | Just(t,tag,cs,e,_) -> (t,tag,cs)
+    | Nothing -> (mk_typ_var "fresh",Tag_empty,[]) end in
+  let value = detaint value_whole in
+  let taint_pat v = binary_taint (fun v _ -> v) v value_whole in
+  match p with
+    | P_lit(lit) ->
+    if is_lit_vector lit then
+      let (n, inc, bits) = match litV_to_vec lit default_dir
+        with | V_vector n inc bits -> (n, inc, bits)
+             | _ -> Assert_extra.failwith "litV_to_vec failed" end in
+      match value with
+      | V_lit litv ->
+        if is_lit_vector litv then
+          let (n', inc', bits') = match litV_to_vec litv default_dir with
+            | V_vector n' inc' bits' -> (n', inc', bits')
+            | _ -> Assert_extra.failwith "litV_to_vec failed" end in
+          if n=n' && inc = inc' then (foldr2 (fun l r rest -> (l = r) && rest) true bits bits',false, eenv)
+          else (false,false,eenv)
+        else (false,false,eenv)
+      | V_vector n' inc' bits' ->
+        (foldr2 (fun l r rest -> (l=r) && rest) true bits bits',false,eenv)
+      | V_unknown -> (true,true,eenv)
+      | _ -> (false,false,eenv) end
+    else
+     match value with
+     | V_lit(litv) -> (lit = litv, false,eenv)
+     | V_vector _ _ [V_lit(litv)] -> (lit = litv,false,eenv)
+     | V_unknown -> (true,true,eenv)
+     | _ -> (false,false,eenv)
+     end
+ | P_wild -> (true,false,eenv)
+ | P_as pat id ->
+   let (matched_p,used_unknown,bounds) = match_pattern t_level pat value in
+   if matched_p then
+     (matched_p,used_unknown,(add_to_env (id,value_whole) bounds))
+   else (false,false,eenv)
+ | P_typ typ pat -> match_pattern t_level pat value_whole
+ | P_id id -> (true, false, (LEnv 0 (Map.fromList [((get_id id),value_whole)])))
+ | P_app (Id_aux id _) pats ->
+   match value with
+   | V_ctor (Id_aux cid _) t ckind (V_tuple vals) ->
+     if (id = cid && ((List.length pats) = (List.length vals)))
+     then foldr2
+          (fun pat value (matched_p,used_unknown,bounds) ->
+            if matched_p then
+              let (matched_p,used_unknown',new_bounds) = match_pattern t_level pat (taint_pat value) in
+              (matched_p, (used_unknown || used_unknown'), (union_env new_bounds bounds))
+            else (false,false,eenv)) (true,false,eenv) pats vals
+     else (false,false,eenv)
+   | V_ctor (Id_aux cid _) t ckind (V_track (V_tuple vals) r) ->
+     if (id = cid && ((List.length pats) = (List.length vals)))
+     then foldr2
+          (fun pat value (matched_p,used_unknown,bounds) ->
+            if matched_p then
+              let (matched_p,used_unknown',new_bounds) = match_pattern t_level pat (taint value r) in
+              (matched_p, (used_unknown || used_unknown'), (union_env new_bounds bounds))
+            else (false,false,eenv)) (true,false,eenv) pats vals
+     else (false,false,eenv)
+   | V_ctor (Id_aux cid _) t ckind v ->
+     if id = cid
+     then (match (pats,detaint v) with
+     | ([],(V_lit (L_aux L_unit _))) -> (true,false,eenv)
+     | ([P_aux (P_lit (L_aux L_unit _)) _],(V_lit (L_aux L_unit _))) -> (true,false,eenv)
+     | ([p],_) -> match_pattern t_level p v
+     | _ -> (false,false,eenv) end)
+     else (false,false,eenv)
+   | V_lit (L_aux (L_num i) _) ->
+     match tag with
+       | Tag_enum _ ->
+         match Map.lookup (get_id (Id_aux id Unknown)) lets with
+           | Just(V_ctor _ t (C_Enum j) _) ->
+             if i = (integerFromNat j) then (true,false,eenv)
+             else (false,false,eenv)
+           | _ -> (false,false,eenv) end
+       | _ -> (false,false,eenv) end
+   | V_unknown -> (true,true,eenv)
+   | _ -> (false,false,eenv) end
+ | P_record fpats _ ->
+   match value with
+   | V_record t fvals ->
+     let fvals_env = env_from_list fvals in
+     List.foldr
+       (fun (FP_aux (FP_Fpat id pat) _) (matched_p,used_unknown,bounds) ->
+         if matched_p then
+           let (matched_p,used_unknown',new_bounds) = match in_env fvals_env (get_id id) with
+                                       | Nothing -> (false,false,eenv)
+                                       | Just v -> match_pattern t_level pat v end in
+           (matched_p, (used_unknown || used_unknown'), (union_env new_bounds bounds))
+         else (false,false,eenv)) (true,false,eenv) fpats
+   | V_unknown -> (true,true,eenv)
+   | _ -> (false,false,eenv)
+   end
+ | P_vector pats ->
+   match value with
+   | V_vector n dir vals ->
+     if ((List.length vals) = (List.length pats))
+     then foldr2
+       (fun pat value (matched_p,used_unknown,bounds) ->
+         if matched_p then
+           let (matched_p,used_unknown',new_bounds) = match_pattern t_level pat (taint_pat value) in
+           (matched_p, (used_unknown||used_unknown'), (union_env new_bounds bounds))
+         else (false,false,eenv))
+       (true,false,eenv) pats vals
+     else (false,false,eenv)
+   | V_vector_sparse n m dir vals d ->
+     if (m = (List.length pats))
+     then let (_,matched_p,used_unknown,bounds) =
+            foldr
+              (fun pat (i,matched_p,used_unknown,bounds) ->
+                if matched_p
+                then let (matched_p,used_unknown',new_bounds) =
+                       match_pattern t_level pat (match List.lookup i vals with
+                         | Nothing -> d
+                         | Just v  -> (taint_pat v) end) in
+                     ((if is_inc(dir) then i+1 else i-1),
+                      matched_p,used_unknown||used_unknown',(union_env new_bounds bounds))
+                else (i,false,false,eenv)) (n,true,false,eenv) pats in
+          (matched_p,used_unknown,bounds)
+     else (false,false,eenv)
+   | V_unknown -> (true,true,eenv)
+   | _ -> (false,false,eenv)
+     end
+ | P_vector_concat pats ->
+   match value with
+   | V_vector n dir vals ->
+     let (matched_p,used_unknown,bounds,remaining_vals) = vec_concat_match_top t_level pats vals dir in
+       (*List.foldl
+         (fun (matched_p,used_unknown,bounds,r_vals) (P_aux pat (l,Just(t,_,_,_))) ->
+           let (matched_p,used_unknown',bounds',matcheds,r_vals) = vec_concat_match_plev t_level pat r_vals inc l t in
+           (matched_p,(used_unknown || used_unknown'),(union_env bounds' bounds),r_vals)) (true,false,eenv,vals) pats in*)
+     if matched_p && ([] = remaining_vals) then (matched_p,used_unknown,bounds) else (false,false,eenv)
+   | V_unknown -> (true,true,eenv)
+   | _ -> (false,false, eenv)
+   end
+ | P_tup(pats) ->
+   match value with
+   | V_tuple(vals) ->
+     if ((List.length pats)= (List.length vals))
+     then foldr2
+       (fun pat v (matched_p,used_unknown,bounds) -> if matched_p then
+           let (matched_p,used_unknown',new_bounds) = match_pattern t_level pat (taint_pat v) in
+           (matched_p,used_unknown ||used_unknown', (union_env new_bounds bounds))
+         else (false,false,eenv))
+       (true,false,eenv) pats vals
+     else (false,false,eenv)
+   | V_unknown -> (true,true,eenv)
+   | _ -> (false,false,eenv)
+     end
+ | P_list(pats) ->
+   match value with
+   | V_list(vals) ->
+     if ((List.length pats)= (List.length vals))
+     then foldr2
+       (fun pat v (matched_p,used_unknown,bounds) -> if matched_p then
+           let (matched_p,used_unknown',new_bounds) = match_pattern t_level pat (taint_pat v) in
+           (matched_p,used_unknown|| used_unknown', (union_env new_bounds bounds))
+         else (false,false,eenv))
+       (true,false,eenv) pats vals
+     else (false,false,eenv)
+   | V_unknown -> (true,true,eenv)
+   | _ -> (false,false,eenv) end
+ end
+
+and vec_concat_match_top t_level pats r_vals dir : ((*matched_p*) bool * (*used_unknown*) bool * lenv * (list value)) =
+  match pats with
+    | [] -> (true,false,eenv,r_vals)
+    | [(P_aux p (l,Just(t,_,_,_,_)))] ->
+      let (matched_p,used_unknown,bounds,_,r_vals) = vec_concat_match_plev t_level p r_vals dir l true t in
+      (matched_p,used_unknown,bounds,r_vals)
+    | (P_aux p (l,Just(t,_,_,_,_)))::pats ->
+      let (matched_p,used_unknown,bounds,matcheds,r_vals) = vec_concat_match_plev t_level p r_vals dir l false t in
+      if matched_p then
+        let (matched_p',used_unknown',bounds',r_vals) = vec_concat_match_top t_level pats r_vals dir in
+        (matched_p',(used_unknown || used_unknown'),union_env bounds' bounds, r_vals)
+      else (false,false,eenv,r_vals)
+    | _ -> Assert_extra.failwith "Type annotation illformed"
+end
+
+and vec_concat_match_plev t_level pat r_vals dir l last_pat t =
+    match pat with
+      | P_lit (L_aux (L_bin bin_string) l') ->
+        let bin_chars = toCharList bin_string in
+        let binpats = List.map
+          (fun b -> P_aux (match b with
+                | #'0' -> P_lit (L_aux L_zero l')
+                | #'1' -> P_lit (L_aux L_one l')
+                | _ -> Assert_extra.failwith "bin not 0 or 1" end) (l',Nothing)) bin_chars in
+        vec_concat_match t_level binpats r_vals
+      | P_vector pats -> vec_concat_match t_level pats r_vals
+      | P_id id ->
+      (match t with
+       | Typ_aux (Typ_app (Id_aux (Id "vector") _) [_;Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant i) _)) _;_;_]) _ ->
+         let wilds = List.genlist (fun _ -> P_aux P_wild (l,Nothing)) (natFromInteger i) in
+         let (matched_p,used_unknown,bounds,matcheds,r_vals) = vec_concat_match t_level wilds r_vals in
+         if matched_p
+         then (matched_p, used_unknown,
+                   (add_to_env (id,(V_vector (if is_inc(dir) then 0 else ((List.length matcheds) - 1)) dir matcheds))
+                              bounds),
+                  matcheds,r_vals)
+         else (false,false,eenv,[],[])
+       | Typ_aux (Typ_app (Id_aux (Id "vector") _) [_;Typ_arg_aux (Typ_arg_nexp nc) _;_;_]) _ ->
+          if last_pat
+          then
+            (true,false,
+             (add_to_env (id,(V_vector (if is_inc(dir) then 0 else ((List.length r_vals) - 1)) dir r_vals)) eenv),
+             r_vals,[])
+          else (false,false,eenv,[],[]) (*TODO use some constraint bounds here*)
+       | _ ->
+          if last_pat
+          then
+            (true,false,
+             (add_to_env (id,(V_vector (if is_inc(dir) then 0 else ((List.length r_vals) -1 )) dir r_vals)) eenv),
+             r_vals,[])
+          else (false,false,eenv,[],[]) end)
+      | P_wild -> (match t with
+          | Typ_aux (Typ_app (Id_aux (Id "vector") _) [_;Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant i) _)) _;_;_]) _ ->
+            let wilds = List.genlist (fun _ -> P_aux P_wild (l,Nothing)) (natFromInteger i) in
+            vec_concat_match t_level wilds r_vals
+          | Typ_aux (Typ_app (Id_aux (Id "vector") _) [_;Typ_arg_aux (Typ_arg_nexp nc) _;_;_]) _ ->
+            if last_pat
+            then
+              (true,false,eenv,r_vals,[])
+            else (false,false,eenv,[],[]) (*TODO use some constraint bounds here*)
+          | _ ->
+            if last_pat
+            then
+              (true,false,eenv,r_vals,[])
+            else (false,false,eenv,[],[]) end)
+      | P_as (P_aux pat (l',Just(t',_,_,_,_))) id ->
+        let (matched_p, used_unknown, bounds,matcheds,r_vals) =
+             vec_concat_match_plev t_level pat r_vals dir l last_pat t' in
+        if matched_p
+        then (matched_p, used_unknown,
+              (add_to_env (id,V_vector (if is_inc(dir) then 0 else (List.length matcheds)) dir matcheds) bounds),
+              matcheds,r_vals)
+        else (false,false,eenv,[],[])
+      | P_typ _ (P_aux p (l',Just(t',_,_,_,_))) -> vec_concat_match_plev t_level p r_vals dir l last_pat t
+      | _ -> (false,false,eenv,[],[]) end
+      (*TODO Need to support indexed here, skipping intermediate numbers but consumming r_vals, and as *)
+
+and vec_concat_match t_level pats r_vals =
+    match pats with
+    | [] -> (true,false,eenv,[],r_vals)
+    | pat::pats -> match r_vals with
+      | [] -> (false,false,eenv,[],[])
+      | r::r_vals ->
+        let (matched_p,used_unknown,new_bounds) = match_pattern t_level pat r in
+        if matched_p then
+          let (matched_p,used_unknown',bounds,matcheds,r_vals) = vec_concat_match  t_level pats r_vals in
+          (matched_p, used_unknown||used_unknown',(union_env new_bounds bounds),r :: matcheds,r_vals)
+        else (false,false,eenv,[],[]) end
+    end
+
+
+(* Returns all matches using Unknown until either there are no more matches or a pattern matches with no Unknowns used *)
+val find_funcl : top_level -> list (funcl tannot) -> value -> list (lenv * bool * (exp tannot))
+let rec find_funcl t_level funcls value =
+  match funcls with
+  | [] -> []
+  | (FCL_aux (FCL_Funcl id (Pat_aux (Pat_exp pat exp) _)) _)::funcls ->
+    let (is_matching,used_unknown,env) = match_pattern t_level pat value in
+    if (is_matching && used_unknown)
+    then (env,used_unknown,exp)::(find_funcl t_level funcls value)
+    else if is_matching then [(env,used_unknown,exp)]
+    else find_funcl t_level funcls value
+  end
+
+(*see above comment*)
+val find_case : top_level -> list (pexp tannot) -> value -> list (lenv * bool * (exp tannot))
+let rec find_case t_level pexps value =
+  match pexps with
+  | [] -> []
+  | (Pat_aux (Pat_exp p e) _)::pexps ->
+    let (is_matching,used_unknown,env) = match_pattern t_level p value in
+    if (is_matching && used_unknown)
+    then (env,used_unknown,e)::find_case t_level pexps value
+    else if is_matching then [(env,used_unknown,e)]
+    else find_case t_level pexps value
+  end
+
+val interp_main : interp_mode -> top_level -> lenv -> lmem -> (exp tannot) -> (outcome * lmem * lenv)
+val exp_list : interp_mode -> top_level -> ((list (exp tannot)) -> lenv -> ((exp tannot) * lenv)) -> (list value -> value) -> lenv -> lmem -> list value -> list (exp tannot) -> (outcome * lmem * lenv)
+val interp_lbind : interp_mode -> top_level -> lenv -> lmem -> (letbind tannot) -> ((outcome * lmem * lenv) * (maybe ((exp tannot) -> (letbind tannot))))
+val interp_alias_read : interp_mode -> top_level -> lenv -> lmem -> (alias_spec tannot) -> (outcome * lmem * lenv)
+
+let resolve_outcome to_match value_thunk action_thunk =
+  match to_match with
+    | (Value v,lm,le) -> value_thunk v lm le
+    | (Action action stack,lm,le) -> (action_thunk (Action action stack), lm,le)
+    | (Error l s,lm,le) -> (Error l s,lm,le)
+end
+
+let string_of_action a =
+  (match a with
+  | Read_reg r _ -> "(Read_reg " ^ string_of_reg_form r ^ " _)"
+  | Write_reg r _ _ -> "(Write_reg " ^ string_of_reg_form r ^ " _ _)"
+  | Read_mem id v _ -> "(Read_mem " ^ string_of_id id ^ " " ^ debug_print_value v ^ " _)"
+  | Read_mem_tagged id v _ -> "(Read_mem_tagged " ^ string_of_id id ^ " " ^ debug_print_value v ^ " _)"
+  | Write_mem _ _ _ _ -> "(Write_mem _ _ _ _)"
+  | Write_ea id v -> "(Write_ea " ^ string_of_id id ^ " " ^ debug_print_value v ^ " _)"
+  | Write_memv _ _ _ -> "(Write_memv _ _ _)"
+  | Excl_res id -> "(Excl_res " ^ string_of_id id ^ ")"
+  | Write_memv_tagged _ _ _ _ -> "(Write_memv_tagged _ _ _ _)"
+  | Barrier id v -> "(Barrier " ^ string_of_id id ^ " " ^ debug_print_value v ^ ")"
+  | Footprint id v -> "(Footprint " ^ string_of_id id ^ " " ^ debug_print_value v ^ ")"
+  | Nondet exps _ -> "(Nondet [" ^ String.concat "; " (List.map string_of_exp exps) ^ "] _)"
+  | Call_extern s v -> "(Call_extern \"" ^ s ^ "\" " ^ debug_print_value v ^ ")"
+  | Return v -> "(Return " ^ debug_print_value v ^ ")"
+  | Exit exp -> "(Exit " ^ string_of_exp exp ^ ")"
+  | Fail v -> "(Fail " ^ debug_print_value v ^ ")"
+  | Step _ _ _ -> "(Step _ _ _)"
+  end)
+
+instance (Show action)
+  let show action = string_of_action action
+end
+
+let string_of_outcome outcome =
+  (match outcome with
+  | Value v -> "(Value " ^ debug_print_value v ^ ")"
+  | Action a _ -> "(Action " ^ string_of_action a ^ " _)"
+  | Error _ s -> "(Error _ \"" ^ s ^ "\")"
+  end)
+
+instance (Show outcome)
+  let show outcome = string_of_outcome outcome
+end
+
+let update_stack o fn = match o  with
+  | Action act stack -> Action act (fn stack)
+  | _ -> o
+end
+
+let debug_out fn value e tl lm le =
+  (Action (Step (get_exp_l e) fn value) (Thunk_frame e tl le lm Top),lm,le)
+
+let to_exps mode env vals =
+  List.foldr (fun v (es,env) -> let (e,env') = to_exp mode env v in (e::es, union_env env' env)) ([],env) vals
+
+let get_num v = match v with
+  | V_lit (L_aux (L_num n) _) -> n
+  | _ -> 0 end
+
+(*Interpret a list of expressions, tracking local state but evaluating in the same scope (i.e. not tracking env) *)
+let rec __exp_list mode t_level build_e build_v l_env l_mem vals exps =
+  match exps with
+  | [ ] -> (Value (build_v vals), l_mem, l_env)
+  | e::exps ->
+    resolve_outcome (interp_main mode t_level l_env l_mem e)
+                    (fun value lm le -> exp_list mode t_level build_e build_v l_env lm (vals++[value]) exps)
+                    (fun a -> update_stack a (add_to_top_frame
+                                                (fun e env ->
+                                                  let (es,env') = to_exps mode env vals in
+                                                  let (e,env'') = build_e (es++(e::exps)) env' in
+                                                  (e,env''))))
+  end
+
+and exp_list mode t_level build_e build_v l_env l_mem vals exps =
+  let _ = debug_fun_enter mode "exp_list" [show vals; show exps] in
+  let retval = __exp_list (indent_mode mode) t_level build_e build_v l_env l_mem vals exps in
+  let _ = debug_fun_exit mode "exp_list" retval in
+  retval
+
+and __interp_main mode t_level l_env l_mem (E_aux exp (l,annot)) =
+  let (Env fdefs instrs default_dir lets regs ctors subregs aliases debug) = t_level in
+  let (typ,tag,ncs,effect,reffect) = match annot with
+    | Nothing ->
+      (mk_typ_var "fresh_v", Tag_empty,[],(Effect_aux (Effect_set []) Unknown),(Effect_aux (Effect_set []) Unknown))
+    | Just(t, tag, ncs, ef,efr) -> (t,tag,ncs,ef,efr) end in
+  match exp with
+    | E_internal_value v -> (Value v, l_mem, l_env)
+    | E_lit lit ->
+      if is_lit_vector lit
+      then let is_inc = (match typ with
+        | Typ_aux (Typ_app (Id_aux (Id "vector") _) [_;_;Typ_arg_aux (Typ_arg_order (Ord_aux Ord_inc _)) _;_]) _ -> IInc | _ -> IDec end) in
+           (Value (litV_to_vec lit is_inc),l_mem,l_env)
+      else (Value (V_lit (match lit with
+                        | L_aux L_false loc -> L_aux L_zero loc
+                        | L_aux L_true loc -> L_aux L_one loc
+                        | _ -> lit end)), l_mem,l_env)
+    | E_comment _ -> (Value unitv, l_mem,l_env)
+    | E_comment_struc _ -> (Value unitv, l_mem, l_env)
+    | E_cast ((Typ_aux typ _) as ctyp) exp ->
+      (*Cast is either a no-op, a signal to read a register, or a signal to change the start of a vector *)
+      resolve_outcome
+        (interp_main mode t_level l_env l_mem exp)
+        (fun v lm le ->
+          (* Potentially use cast to change vector start position *)
+          let conditional_update_vstart () =
+            match typ with
+              | Typ_app (Id_aux (Id "vector") _) [Typ_arg_aux (Typ_arg_nexp(Nexp_aux (Nexp_constant i) _)) _;_;_;_] ->
+                let i = natFromInteger i in
+                match (detaint v) with
+                  | V_vector start dir vs ->
+                    if start = i then (Value v,lm,le) else (Value (update_vector_start dir i 1 v),lm,le)
+                  | _ -> (Value v,lm,le) end
+              | (Typ_var (Kid_aux (Var "length") _))->
+                match (detaint v) with
+                  | V_vector start dir vs ->
+                    let i = (List.length vs) - 1 in
+                    if start = i then (Value v,lm,le) else (Value (update_vector_start dir i 1 v),lm,le)
+                  | _ -> (Value v,lm,le) end
+              | _ -> (Value v,lm,le) end in
+          (match (tag,detaint v) with
+            (*Cast is telling us to read a register*)
+            | (Tag_extern _, V_register regform) ->
+              (Action (Read_reg regform Nothing) (mk_hole l (val_annot (reg_to_t regform)) t_level le lm), lm,le)
+            (*Cast is changing vector start position, potentially*)
+            | (_,v) -> conditional_update_vstart () end))
+        (fun a -> update_stack a (add_to_top_frame (fun e env -> (E_aux (E_cast ctyp e) (l,annot), env))))
+    | E_id id ->
+      let name = get_id id in
+      match tag with
+        | Tag_empty ->
+          match in_lenv l_env id with
+          | V_boxref n t -> (Value (in_mem l_mem n),l_mem,l_env)
+          | value -> (Value value,l_mem,l_env) end
+        | Tag_global ->
+          match in_env lets name with
+            | Just(value) -> (Value value, l_mem,l_env)
+            | Nothing ->
+              (match in_env regs name with
+                | Just(value) -> (Value value, l_mem,l_env)
+                | Nothing -> (Error l ("Internal error: " ^ name ^ " unbound on Tag_global"),l_mem,l_env) end) end
+        | Tag_enum _ ->
+          match in_env lets name with
+            | Just(value) -> (Value value,l_mem,l_env)
+            | Nothing -> (Error l ("Internal error: " ^ name ^ " unbound on Tag_enum "), l_mem,l_env)
+            end
+        | Tag_extern _ -> (* update with id here when it's never just "register" *)
+          let regf = match in_lenv l_env id with (* Check for local treatment of a register as a value *)
+            | V_register regform -> regform
+            | _ ->
+              match in_env regs name with (* Register isn't a local value, so pull from global environment *)
+                | Just(V_register regform) -> regform
+                | _ -> Form_Reg id annot default_dir end end in
+          (Action (Read_reg regf Nothing) (mk_hole l annot t_level l_env l_mem), l_mem, l_env)
+        | Tag_alias ->
+          match in_env aliases name with
+            | Just aspec -> interp_alias_read mode t_level l_env l_mem aspec
+            | _ -> (Error l ("Internal error: alias not found"), l_mem,l_env) end
+        | _ ->
+          (Error l
+             ("Internal error: tag " ^ (string_of_tag tag) ^ " expected empty,enum,alias,or extern for " ^ name),
+           l_mem,l_env)
+        end
+    | E_if cond thn els ->
+      resolve_outcome
+        (interp_main mode t_level l_env l_mem cond)
+        (fun value_whole lm le ->
+          let value = detaint value_whole in
+          match (value,mode.eager_eval) with
+            (*TODO remove booleans here when fully removed elsewhere *)
+            | (V_lit(L_aux L_one _),true) -> interp_main mode t_level l_env lm thn
+            | (V_lit(L_aux L_one _),false) -> debug_out Nothing Nothing thn t_level lm l_env
+            | (V_vector _ _ [(V_lit(L_aux L_one _))],true) -> interp_main mode t_level l_env lm thn
+            | (V_vector _ _ [(V_lit(L_aux L_one _))],false) -> debug_out Nothing Nothing thn t_level lm l_env
+            | (V_unknown,_) ->
+              let (branches,maybe_id) = fix_up_nondet typ [thn;els] (l,annot) in
+              interp_main mode t_level l_env lm (E_aux (E_nondet branches) (l,non_det_annot annot maybe_id))
+            | (_,true) -> interp_main mode t_level l_env lm els
+            | (_,false) -> debug_out Nothing Nothing els t_level lm l_env end)
+        (fun a -> update_stack a (add_to_top_frame (fun c env -> (E_aux (E_if c thn els) (l,annot), env))))
+    | E_for id from to_ by ((Ord_aux o _) as order) exp ->
+      let is_inc = match o with | Ord_inc -> true | _ -> false end in
+      resolve_outcome
+        (interp_main mode t_level l_env l_mem from)
+        (fun from_val_whole lm le ->
+          let from_val = detaint from_val_whole in
+          let (from_e,env) = to_exp mode le from_val_whole in
+          match from_val with
+            | V_lit(L_aux(L_num from_num) fl) ->
+              resolve_outcome
+                (interp_main mode t_level env lm to_)
+                (fun to_val_whole lm le ->
+                  let to_val = detaint to_val_whole in
+                  let (to_e,env) = to_exp mode le to_val_whole in
+                  match to_val with
+                    | V_lit(L_aux (L_num to_num) tl) ->
+                      resolve_outcome
+                        (interp_main mode t_level env lm by)
+                        (fun by_val_whole lm le ->
+                          let by_val = detaint by_val_whole in
+                          let (by_e,env) = to_exp mode le by_val_whole in
+                          match by_val with
+                            | V_lit (L_aux (L_num by_num) bl) ->
+                              if ((is_inc && (from_num > to_num)) || (not(is_inc) && (from_num < to_num)))
+                              then (Value(V_lit (L_aux L_unit l)),lm,le)
+                              else
+                                let (ftyp,ttyp,btyp) = (val_typ from_val,val_typ to_val,val_typ by_val) in
+                                let augment_annot = (fl, val_annot (combine_typs [ftyp;ttyp])) in
+                                let diff = L_aux (L_num (if is_inc then from_num+by_num else from_num - by_num)) fl in
+                                let (augment_e,env) = match (from_val_whole,by_val_whole) with
+                                  | (V_lit _, V_lit _) -> ((E_aux (E_lit diff) augment_annot), env)
+                                  | (V_track _ rs, V_lit _) -> to_exp mode env (taint (V_lit diff) rs)
+                                  | (V_lit _, V_track _ rs) -> to_exp mode env (taint (V_lit diff) rs)
+                                  | (V_track _ r1, V_track _ r2) ->
+                                    (to_exp mode env (taint (V_lit diff) (r1 union r2)))
+                                  | _ -> Assert_extra.failwith "For loop from and by values not range" end in
+                                let  e =
+                                  (E_aux
+                                     (E_block
+                                        [(E_aux
+                                            (E_let
+                                               (LB_aux (LB_val (P_aux (P_id id) (fl,val_annot ftyp)) from_e)
+                                                  (Unknown,val_annot ftyp))
+                                               exp) (l,annot));
+                                         (E_aux (E_for id augment_e to_e by_e order exp) (l,annot))])
+                                     (l,annot)) in
+                                if mode.eager_eval
+                                then interp_main mode t_level env lm e
+                                else debug_out Nothing Nothing e t_level lm env
+                            | V_unknown ->
+                              let e =
+                                (E_aux
+                                   (E_let
+                                      (LB_aux
+                                         (LB_val (P_aux (P_id id) (fl, val_annot (val_typ from_val))) from_e)
+                                         (fl, val_annot (val_typ from_val)))
+                                      exp) (l,annot)) in
+                              interp_main mode t_level env lm e
+                            | _ -> (Error l "internal error: by must be a number",lm,le) end)
+                        (fun a -> update_stack a
+                          (add_to_top_frame (fun b env -> (E_aux (E_for id from_e to_e b order exp) (l,annot), env))))
+                    | V_unknown ->
+                      let e =
+                        (E_aux
+                           (E_let (LB_aux
+                                     (LB_val (P_aux (P_id id) (fl, val_annot (val_typ from_val))) from_e)
+                                     (fl, val_annot (val_typ from_val))) exp) (l,annot)) in
+                      interp_main mode t_level env lm e
+                    | _ -> (Error l "internal error: to must be a number",lm,env) end)
+                (fun a -> update_stack a
+                  (add_to_top_frame (fun t env ->
+                    (E_aux (E_for id from_e t by order exp) (l,annot), env))))
+            | V_unknown ->
+              let e =
+                (E_aux
+                   (E_let (LB_aux (LB_val (P_aux (P_id id) (Unknown, val_annot (val_typ from_val))) from_e)
+                             (Unknown, val_annot (val_typ from_val))) exp) (l,annot)) in
+              interp_main mode t_level env lm e
+            | _ -> (Error l "internal error: from must be a number",lm,le) end)
+          (fun a -> update_stack a
+              (add_to_top_frame (fun f env -> (E_aux (E_for id f to_ by order exp) (l,annot), env))))
+    | E_case exp pats ->
+      resolve_outcome
+        (interp_main mode t_level l_env l_mem exp)
+        (fun v lm le ->
+          match find_case t_level pats v with
+            | [] -> (Error l ("No matching patterns in case for value " ^ (string_of_value v)),lm,le)
+            | [(env,_,exp)] ->
+              if mode.eager_eval
+              then interp_main mode t_level (union_env env l_env) lm exp
+              else debug_out Nothing Nothing exp t_level lm (union_env env l_env)
+            | multi_matches ->
+              let (lets,taint_env) =
+                List.foldr (fun (env,_,exp) (rst,taint_env) ->
+                  let (e,t_e) = env_to_let mode env exp taint_env in (e::rst,t_e)) ([],l_env) multi_matches in
+              let (branches,maybe_id) = fix_up_nondet typ lets (l,annot) in
+              interp_main mode t_level taint_env lm (E_aux (E_nondet branches) (l,(non_det_annot annot maybe_id)))
+         end)
+        (fun a -> update_stack a (add_to_top_frame (fun e env -> (E_aux (E_case e pats) (l,annot), env))))
+    | E_record(FES_aux (FES_Fexps fexps _) fes_annot) ->
+      let (fields,exps) = List.unzip (List.map (fun (FE_aux (FE_Fexp id exp) _) -> (id,exp)) fexps) in
+      exp_list mode t_level
+        (fun es env' ->
+          ((E_aux
+              (E_record
+                 (FES_aux (FES_Fexps
+                             (map2 (fun id exp -> (FE_aux (FE_Fexp id exp) (Unknown,Nothing))) fields es)
+                             false) fes_annot))
+                  (l,annot)), env'))
+        (fun vs -> (V_record typ (List.zip fields vs))) l_env l_mem [] exps
+    | E_record_update exp (FES_aux (FES_Fexps fexps _) fes_annot) ->
+      resolve_outcome
+        (interp_main mode t_level l_env l_mem exp)
+        (fun rv lm le -> match rv with
+          | V_record t fvs ->
+            let (fields,exps) = List.unzip (List.map (fun (FE_aux (FE_Fexp id exp) _) -> (id,exp)) fexps) in
+            resolve_outcome
+              (exp_list mode t_level
+                        (fun es env'->
+                          let (e,env'') = (to_exp mode env' rv) in
+                          ((E_aux (E_record_update e
+                                    (FES_aux (FES_Fexps
+                                                (map2 (fun id exp -> (FE_aux (FE_Fexp id exp) (Unknown,Nothing)))
+                                                   fields es) false) fes_annot))
+                             (l,annot)), env''))
+                        (fun vs -> (V_record t (List.zip fields vs))) l_env l_mem [] exps)
+              (fun vs lm le -> (Value (fupdate_record rv vs), lm, le))
+              (fun a -> a) (*Due to exp_list this won't happen, but we want to functionaly update on Value *)
+          | V_unknown -> (Value V_unknown, lm, le)
+          | _ -> (Error l "internal error: record update requires record",lm,le) end)
+        (fun a -> update_stack a
+          (add_to_top_frame
+             (fun e env -> (E_aux(E_record_update e (FES_aux(FES_Fexps fexps false) fes_annot)) (l,annot), env))))
+    | E_list(exps) ->
+      exp_list mode t_level (fun exps env' -> (E_aux (E_list exps) (l,annot),env')) V_list l_env l_mem [] exps
+    | E_cons hd tl ->
+      resolve_outcome
+        (interp_main mode t_level l_env l_mem hd)
+        (fun hdv lm le ->
+          resolve_outcome
+            (interp_main mode t_level l_env lm tl)
+            (fun tlv lm le -> match detaint tlv with
+              | V_list t -> (Value (retaint tlv (V_list (hdv::t))),lm,le)
+              | V_unknown -> (Value (retaint tlv V_unknown),lm,le)
+              | _ -> (Error l ("Internal error '::' of non-list value " ^ (string_of_value tlv)),lm,le) end)
+            (fun a -> update_stack a
+              (add_to_top_frame
+                 (fun t env -> let (hde,env') = to_exp mode env hdv in (E_aux (E_cons hde t) (l,annot),env')))))
+        (fun a -> update_stack a (add_to_top_frame (fun h env -> (E_aux (E_cons h tl) (l,annot), env))))
+    | E_field exp id ->
+      resolve_outcome
+        (interp_main mode t_level l_env l_mem exp)
+        (fun value_whole lm le ->
+          match detaint value_whole with
+            | V_record t fexps ->
+              (match in_env (env_from_list fexps) (get_id id) with
+                | Just v -> (Value (retaint value_whole v),lm,l_env)
+                | Nothing -> (Error l "Internal_error: Field not found in record",lm,le) end)
+            | V_register ((Form_Reg _ annot _) as reg_form) ->
+              let id' = match annot with
+                | Just((Typ_aux (Typ_id (Id_aux (Id id') _)) _),_,_,_,_) -> id'
+                | _ -> Assert_extra.failwith "annotation not well formed for field access"
+              end in
+              (match in_env subregs id' with
+                | Just(indexes) ->
+                  (match in_env indexes (get_id id) with
+                    | Just ir ->
+                      let sub_reg = Form_SubReg id reg_form ir in
+                      (Action (Read_reg sub_reg Nothing)
+                              (mk_hole l (val_annot (reg_to_t sub_reg)) t_level le lm),lm,le)
+                    | _ -> (Error l "Internal error: unrecognized read, no id",lm,le) end)
+                | Nothing -> (Error l "Internal error: subregs indexes not found", lm, le) end)
+            | V_unknown -> (Value (retaint value_whole V_unknown),lm,l_env)
+            | _ ->
+              (Error l ("Internal error: neither register nor record at field access "
+                        ^ (string_of_value value_whole)),lm,le) end)
+        (fun a ->
+          match (exp,a) with
+            | (E_aux _ (l,Just(_,Tag_extern _,_,_,_)),
+               (Action (Read_reg ((Form_Reg _ (Just((Typ_aux (Typ_id (Id_aux (Id id') _)) _),_,_,_,_)) _) as regf) Nothing) s)) ->
+              match in_env subregs id' with
+                | Just(indexes) ->
+                  (match in_env indexes (get_id id) with
+                    | Just ir ->
+                      (Action (Read_reg (Form_SubReg id regf ir) Nothing) s)
+                    | _ -> Error l "Internal error, unrecognized read, no id"
+                   end)
+                | Nothing -> Error l "Internal error, unrecognized read, no reg" end
+            | _ -> update_stack a (add_to_top_frame (fun e env -> (E_aux(E_field e id) (l,annot),env))) end)
+    | E_vector_access vec i ->
+       resolve_outcome
+         (interp_main mode t_level l_env l_mem vec)
+         (fun vvec lm le ->
+           resolve_outcome
+             (interp_main mode t_level l_env lm i)
+             (fun iv lm le ->
+               (match detaint iv with
+                | V_unknown -> (Value iv,lm,le)
+                | V_lit (L_aux (L_num n) ln) ->
+                   let n = natFromInteger n in
+                   let v_access vvec num =
+                     (match (detaint vvec, detaint num) with
+                      | (V_vector _ _ _,V_lit _) -> Value (access_vector vvec n)
+                      | (V_vector_sparse _ _ _ _ _,V_lit _) -> Value (access_vector vvec n)
+                      | (V_register reg, V_lit _) ->
+                         Action (Read_reg reg (Just (n,n))) (mk_hole l annot t_level l_env lm)
+                      | (V_unknown,_) -> Value V_unknown
+                      | _ -> Assert_extra.failwith
+                               ("Vector access error: " ^ (string_of_value vvec) ^ "[" ^ (show n) ^ "]")
+                      end)
+                   in
+                   (v_access (retaint iv vvec) iv,lm,le)
+                | _ -> (Error l "Vector access not given a number for index",lm,l_env)
+                end))
+                 (fun a -> update_stack a (add_to_top_frame(fun i' env ->
+                                               let (vec_e, env') = to_exp mode env vvec in
+                                               (E_aux (E_vector_access vec_e i') (l,annot), env')))))
+             (fun a ->
+               update_stack a (add_to_top_frame (fun vec' env ->
+                                   (E_aux (E_vector_access vec' i) (l,annot), env))))
+         | E_vector_subrange vec i1 i2 ->
+            resolve_outcome
+              (interp_main mode t_level l_env l_mem vec)
+              (fun vvec lm le ->
+                resolve_outcome
+                  (interp_main mode t_level l_env lm i1)
+                  (fun i1v lm le ->
+                    resolve_outcome
+                      (interp_main mode t_level l_env lm i2)
+                      (fun i2v lm le ->
+                        match detaint i1v with
+                        | V_unknown -> (Value i1v,lm,le)
+                        | V_lit (L_aux (L_num n1) nl1) ->
+                           match detaint i2v with
+                           | V_unknown -> (Value i2v,lm,le)
+                           | V_lit (L_aux (L_num n2) nl2) ->
+                              let slice = binary_taint (fun v1 v2 -> V_tuple[v1;v2]) i1v i2v in
+                              let take_slice vvec =
+                                let (n1,n2) = (natFromInteger n1,natFromInteger n2) in
+                                (match detaint vvec with
+                                 | V_vector _ _ _ -> Value (slice_vector vvec n1 n2)
+                                 | V_vector_sparse _ _ _ _ _ -> Value (slice_vector vvec n1 n2)
+                                 | V_unknown ->
+                                    let inc = n1 < n2 in
+                                    Value (retaint vvec (V_vector n1 (if inc then IInc else IDec)
+                                                                  (List.replicate ((if inc then n1-n2 else n2-n1)+1) V_unknown)))
+                                 | V_register reg ->
+                                    Action (Read_reg reg (Just (n1,n2))) (mk_hole l annot t_level le lm)
+                                 | _ -> (Error l ("Vector slice of non-vector " ^ (string_of_value vvec))) end) in
+                              ((take_slice (retaint slice vvec)), lm,le)
+                           | _ -> (Error l "vector subrange did not receive a range value", l_mem, l_env)
+                       end
+                      | _ -> (Error l "vector subrange did not receive a range value", l_mem, l_env)
+                       end)
+                      (fun a -> update_stack a (add_to_top_frame (fun i2' env ->
+                                                    let (vec_e, env') = to_exp mode env vvec in
+                                                    let (i1_e, env'') = to_exp mode env' i1v in
+                                                    (E_aux (E_vector_subrange vec_e i1_e i2') (l,annot), env'')))))
+                  (fun a ->
+                    update_stack a (add_to_top_frame (fun i1' env ->
+                                        let (vec_e, env') = to_exp mode env vvec in
+                                        (E_aux (E_vector_subrange vec_e i1' i2) (l,annot), env')))))
+              (fun a ->
+                update_stack a (add_to_top_frame (fun vec' env ->
+                                    (E_aux (E_vector_subrange vec' i1 i2) (l,annot), env))))
+         | E_vector_update vec i exp ->
+            resolve_outcome
+              (interp_main mode t_level l_env l_mem vec)
+              (fun vvec lm le ->
+                resolve_outcome
+                  (interp_main mode t_level l_env lm i)
+                  (fun vi lm le ->
+                    resolve_outcome
+                      (interp_main mode t_level l_env lm exp)
+                      (fun vup lm le ->
+                        (match (detaint vi) with
+                         | V_lit (L_aux (L_num n1) ln1) ->
+                            let fvup vi vvec =
+                              (match vvec with
+                               | V_vector _ _ _ -> fupdate_vec vvec (natFromInteger n1) vup
+                               | V_vector_sparse _ _ _ _ _ -> fupdate_vec vvec (natFromInteger n1) vup
+                               | V_unknown -> V_unknown
+                               | _ -> Assert_extra.failwith "Update of vector given non-vector"
+                               end)
+                            in
+                            (Value (binary_taint fvup vi vvec),lm,le)
+                         | V_unknown -> (Value vi,lm,le)
+                         | _ -> Assert_extra.failwith "Update of vector requires number for access"
+                         end))
+                      (fun a -> update_stack a (add_to_top_frame (fun exp' env ->
+                                                    let (vec_e, env') = to_exp mode env vvec in
+                                                    let (i_e, env'') = to_exp mode env' vi in
+                                                    (E_aux (E_vector_update vec_e i_e exp') (l,annot), env'')))))
+                  (fun a -> update_stack a (add_to_top_frame (fun i' env ->
+                                                let (vec_e, env') = to_exp mode env vvec in
+                                                (E_aux (E_vector_update vec_e i' exp) (l,annot), env')))))
+              (fun a -> update_stack a (add_to_top_frame (fun vec' env ->
+                                            (E_aux (E_vector_update vec' i exp) (l,annot), env))))
+         | E_vector_update_subrange vec i1 i2 exp ->
+            resolve_outcome
+              (interp_main mode t_level l_env l_mem vec)
+              (fun vvec lm le ->
+                resolve_outcome
+                  (interp_main mode t_level l_env lm i1)
+                  (fun vi1 lm le ->
+                    resolve_outcome
+                      (interp_main mode t_level l_env lm i2)
+                      (fun vi2 lm le ->
+                        resolve_outcome
+                          (interp_main mode t_level l_env lm exp)
+                          (fun v_rep lm le ->
+                            (match detaint vi1 with
+                             | V_unknown -> (Value vi1,lm,le)
+                             | V_lit (L_aux (L_num n1) ln1) ->
+                                (match detaint vi2 with
+                                 | V_unknown -> (Value vi2,lm,le)
+                                 | V_lit (L_aux (L_num n2) ln2) ->
+                                    let slice = binary_taint (fun v1 v2 -> V_tuple[v1;v2]) vi1 vi2 in
+                                    let fup_v_slice v1 vvec =
+                                      (match vvec with
+                                       | V_vector _ _ _ ->
+                                          fupdate_vector_slice vvec v_rep (natFromInteger n1) (natFromInteger n2)
+                                       | V_vector_sparse _ _ _ _ _ ->
+                                          fupdate_vector_slice vvec v_rep (natFromInteger n1) (natFromInteger n2)
+                                       | V_unknown -> V_unknown
+                                       | _ -> Assert_extra.failwith "Vector update requires vector"
+                                       end) in
+                                    (Value (binary_taint fup_v_slice slice vvec),lm,le)
+                                 | _ -> Assert_extra.failwith "vector update requires number"
+                                 end)
+                             | _ -> Assert_extra.failwith "vector update requires number"
+                             end))
+                          (fun a -> update_stack a (add_to_top_frame (fun exp' env ->
+                                                        let (vec_e, env') = to_exp mode env vvec  in
+                                                        let (i1_e, env'') = to_exp mode env' vi1  in
+                                                        let (i2_e, env''') = to_exp mode env'' vi1  in
+                                                        (E_aux (E_vector_update_subrange vec_e i1_e i2_e exp') (l,annot), env''')))))
+                      (fun a -> update_stack a (add_to_top_frame (fun i2' env ->
+                                                    let (vec_e, env') = to_exp mode env vvec  in
+                                                    let (i1_e, env'') = to_exp mode env' vi1  in
+                                                    (E_aux (E_vector_update_subrange vec_e i1_e i2' exp) (l,annot), env'')))))
+                  (fun a -> update_stack a (add_to_top_frame (fun i1' env ->
+                                                let (vec_e, env') = to_exp mode env vvec  in
+                                                (E_aux (E_vector_update_subrange vec_e i1' i2 exp) (l,annot), env')))))
+              (fun a -> update_stack a (add_to_top_frame (fun vec' env ->
+                                            (E_aux (E_vector_update_subrange vec' i1 i2 exp) (l,annot), env))))
+         | E_vector_append e1 e2 ->
+            resolve_outcome
+              (interp_main mode t_level l_env l_mem e1)
+              (fun v1 lm le ->
+                resolve_outcome
+                  (interp_main mode t_level l_env lm e2)
+                  (fun v2 lm le ->
+                    (match detaint v1 with
+                     | V_unknown -> (Value v1,lm,le)
+                     | _ ->
+                        let append v1 v2 =
+                          (match (v1,v2) with
+                           | (V_vector _ dir vals1, V_vector _ _ vals2) ->
+                              let vals = vals1++vals2 in
+                              let len = List.length vals in
+                              if is_inc(dir)
+                              then V_vector 0 dir vals
+                              else V_vector (len-1) dir vals
+                           | (V_vector m dir vals1, V_vector_sparse _ len _ vals2 d) ->
+                              let original_len = List.length vals1 in
+                              let (_,sparse_vals) = List.foldr (fun v (i,vals) -> (i+1,(i,v)::vals)) (m,[]) vals1 in
+                              let sparse_update = List.map (fun (i,v) -> (i+m+original_len,v)) vals2 in
+                              V_vector_sparse m (len+original_len) dir (sparse_vals ++ sparse_update) d
+                           | (V_vector_sparse m len dir vals1 d, V_vector _ _ vals2) ->
+                              let new_len = List.length vals2 in
+                              let (_,sparse_vals) = List.foldr (fun v (i,vals) -> (i+1,(i,v)::vals)) (len,[]) vals2 in
+                              V_vector_sparse m (len+new_len) dir (vals1++sparse_vals) d
+                           | (V_vector_sparse m len dir vals1 d, V_vector_sparse _ new_len _ vals2 _) ->
+                              let sparse_update = List.map (fun (i,v) -> (i+len,v)) vals2 in
+                              V_vector_sparse m (len+new_len) dir (vals1 ++ sparse_update) d
+                           | (V_unknown,_) -> V_unknown (*update to get length from type*)
+                           | (_,V_unknown) -> V_unknown (*see above*)
+                           | _ -> Assert_extra.failwith ("vector concat requires two vectors but given "
+                                                         ^ (string_of_value v1) ^ " " ^ (string_of_value v2))
+                           end)
+                        in
+                        (Value (binary_taint append v1 v2),lm,le)
+                     end))
+                  (fun a -> update_stack a (add_to_top_frame (fun e2' env ->
+                                                let (e1_e, env') = to_exp mode env v1  in
+                                                (E_aux (E_vector_append e1_e e2') (l,annot), env')))))
+              (fun a -> update_stack a (add_to_top_frame (fun e1' env ->
+                                            (E_aux (E_vector_append e1' e2) (l,annot), env))))
+    | E_tuple(exps) ->
+      exp_list mode t_level (fun exps env' -> (E_aux (E_tuple exps) (l,annot), env')) V_tuple l_env l_mem [] exps
+    | E_vector(exps) ->
+      let (is_inc,dir) = (match typ with
+        | Typ_aux (Typ_app (Id_aux (Id "vector") _) [ _; _; Typ_arg_aux (Typ_arg_order (Ord_aux Ord_inc _)) _; _]) _ -> (true,IInc)
+        | _ -> (false,IDec) end) in
+      let base = (if is_inc then 0 else (List.length exps) - 1) in
+      exp_list mode t_level
+        (fun exps env' -> (E_aux (E_vector exps) (l,annot),env'))
+        (fun vals -> V_vector base dir vals) l_env l_mem [] exps
+    | E_block exps -> interp_block mode t_level l_env l_env l_mem l annot exps
+    | E_nondet exps ->
+      (Action (Nondet exps tag)
+              (match tag with
+                | Tag_unknown (Just id) -> mk_hole l annot t_level l_env l_mem
+                | _ -> mk_thunk l annot t_level l_env l_mem end),
+       l_mem, l_env)
+    | E_app f args ->
+      (match (exp_list mode t_level
+                (fun es env -> (E_aux (E_app f es) (l,annot),env))
+                (fun vs -> match vs with | [] -> V_lit (L_aux L_unit l) | [v] -> v | vs -> V_tuple vs end)
+                l_env l_mem [] args) with
+      | (Value v,lm,le) ->
+        let name = get_id f in
+        (match tag with
+        | Tag_global ->
+          (match Map.lookup name fdefs with
+            | Just(funcls) ->
+              (match find_funcl t_level funcls v with
+                | [] ->
+                  (Error l ("No matching pattern for function " ^ name ^
+                               " on value " ^ (string_of_value v)),l_mem,l_env)
+                | [(env,_,exp)] ->
+                  resolve_outcome
+                    (if mode.eager_eval
+                     then (interp_main mode t_level env (emem name) exp)
+                     else (debug_out (Just name) (Just v) exp t_level (emem name) env))
+                    (fun ret lm le -> (Value ret, l_mem,l_env))
+                    (fun a -> update_stack a
+                      (fun stack -> (Hole_frame redex_id (E_aux (E_id redex_id) (l,(intern_annot annot)))
+                                       t_level l_env l_mem stack)))
+                | multi_matches ->
+                  let (lets,taint_env) =
+                    List.foldr (fun (env,_,exp) (rst,taint_env) ->
+                      let (e,t_e) = env_to_let mode env exp taint_env in (e::rst,t_e)) ([],l_env) multi_matches in
+                  let (branches,maybe_id) = fix_up_nondet typ lets (l,annot) in
+                  let exp = E_aux (E_nondet branches) (l,(non_det_annot annot maybe_id)) in
+                  interp_main mode t_level taint_env lm exp
+               end)
+            | Nothing ->
+              (Error l ("Internal error: function with tag global unfound " ^ name),lm,le) end)
+        | Tag_empty ->
+          (match Map.lookup name fdefs with
+          | Just(funcls) ->
+            (match find_funcl t_level funcls v with
+            | [] ->
+              (Error l ("No matching pattern for function " ^ name ^ " on value " ^ (string_of_value v)),l_mem,l_env)
+            | [(env,used_unknown,exp)] ->
+              resolve_outcome
+                (if mode.eager_eval
+                 then (interp_main mode t_level env (emem name) exp)
+                 else (debug_out (Just name) (Just v) exp t_level (emem name) env))
+                (fun ret lm le -> (Value ret, l_mem,l_env))
+                (fun a -> update_stack a
+                  (fun stack -> (Hole_frame redex_id (E_aux (E_id redex_id) (l,(intern_annot annot)))
+                                   t_level l_env l_mem stack)))
+            | _ -> (Error l ("Internal error: multiple pattern matches found for " ^ name), l_mem, l_env)
+             end)
+          | Nothing ->
+            (Error l ("Internal error: function with local tag unfound " ^ name),lm,le) end)
+        | Tag_spec ->
+          (match Map.lookup name fdefs with
+          | Just(funcls) ->
+            (match find_funcl t_level funcls v with
+            | [] ->
+              (Error l ("No matching pattern for function " ^ name ^ " on value " ^ (string_of_value v)),l_mem,l_env)
+            | [(env,used_unknown,exp)] ->
+              resolve_outcome
+                (if mode.eager_eval
+                 then (interp_main mode t_level env (emem name) exp)
+                 else (debug_out (Just name) (Just v) exp t_level (emem name) env))
+                (fun ret lm le -> (Value ret, l_mem,l_env))
+                (fun a -> update_stack a
+                  (fun stack ->
+                    (Hole_frame redex_id
+                       (E_aux (E_id redex_id) (l,(intern_annot annot))) t_level l_env l_mem stack)))
+            | _ -> (Error l ("Internal error: multiple pattern matches for " ^ name), l_mem, l_env)
+             end)
+          | Nothing ->
+            (Error l (String.stringAppend "Specified function must be defined before executing " name),lm,le) end)
+        | Tag_ctor ->
+          (match Map.lookup name ctors with
+          | Just(_) -> (Value (V_ctor f typ C_Union v), lm, le)
+          | Nothing -> (Error l (String.stringAppend "Internal error: function with ctor tag unfound " name),lm,le)
+           end)
+        | Tag_extern opt_name ->
+          let effects = (match effect with | Effect_aux(Effect_set es) _ -> es | _ -> [] end) in
+          let name_ext = match opt_name with | Just s -> s | Nothing -> name end in
+          let mk_hole_frame act = (Action act (mk_hole l annot t_level le lm), lm, le) in
+          let mk_thunk_frame act = (Action act (mk_thunk l annot t_level le lm), lm, le) in
+          if has_rmem_effect effects
+          then mk_hole_frame (Read_mem (id_of_string name_ext) v Nothing)
+          else if has_rmemt_effect effects
+          then mk_hole_frame (Read_mem_tagged (id_of_string name_ext) v Nothing)
+          else if has_barr_effect effects
+          then mk_thunk_frame (Barrier (id_of_string name_ext) v)
+          else if has_depend_effect effects
+          then mk_thunk_frame (Footprint (id_of_string name_ext) v)
+          else if has_wmem_effect effects
+          then let (wv,v) =
+                 match v with
+                   | V_tuple [p;v] -> (v,p)
+                   | V_tuple params_list ->
+                     let reved = List.reverse params_list in
+                     (List_extra.head reved,V_tuple (List.reverse (List_extra.tail reved)))
+                   | _ -> Assert_extra.failwith ("Expected tuple found " ^ (string_of_value v)) end in
+                mk_hole_frame (Write_mem (id_of_string name_ext) v Nothing wv)
+          else if has_eamem_effect effects
+          then mk_thunk_frame (Write_ea (id_of_string name_ext) v)
+          else if has_exmem_effect effects
+          then mk_hole_frame (Excl_res (id_of_string name_ext))
+          else if has_wmv_effect effects
+          then let (wv,v) =
+                 match v with
+                 | V_tuple [p;v] -> (v,p)
+                 | V_tuple params_list ->
+                   let reved= List.reverse params_list in
+                   (List_extra.head reved,V_tuple (List.reverse (List_extra.tail reved)))
+                 | _ -> (v,unitv) end in
+               mk_hole_frame (Write_memv (id_of_string name_ext) v wv)
+          else if has_wmvt_effect effects
+          then match v with
+               | V_tuple [addr; size; tag; data] ->
+                  mk_hole_frame (Write_memv_tagged (id_of_string name_ext) (V_tuple([addr; size])) tag data)
+               | _ -> Assert_extra.failwith("wmvt: expected tuple of four elements") end
+          else mk_hole_frame (Call_extern name_ext v)
+        | _ ->
+          (Error l (String.stringAppend "Tag not empty, spec, ctor, or extern on function call " name),lm,le) end)
+      | out -> out end)
+    | E_app_infix lft op r ->
+       let op = match op with
+       | Id_aux (Id x) il -> Id_aux (DeIid x) il
+       | _ -> op
+       end in
+      let name = get_id op in
+      resolve_outcome
+        (interp_main mode t_level l_env l_mem lft)
+        (fun lv lm le ->
+          resolve_outcome
+            (interp_main mode t_level l_env lm r)
+            (fun rv lm le ->
+              match tag with
+                | Tag_global ->
+                  (match Map.lookup name fdefs with
+                    | Nothing -> (Error l ("Internal error: no function def for " ^ name),lm,le)
+                    | Just (funcls) ->
+                      (match find_funcl t_level funcls (V_tuple [lv;rv]) with
+                        | [] -> (Error l ("No matching pattern for function " ^ name),lm,l_env)
+                        | [(env,used_unknown,exp)] ->
+                          resolve_outcome
+                            (if mode.eager_eval
+                             then (interp_main mode t_level env (emem name) exp)
+                             else (debug_out (Just name) (Just (V_tuple [lv;rv])) exp t_level (emem name) env))
+                            (fun ret lm le -> (Value ret,l_mem,l_env))
+                            (fun a -> update_stack a
+                              (fun stack ->
+                                (Hole_frame redex_id (E_aux (E_id redex_id) (l,(intern_annot annot)))
+                                   t_level l_env l_mem stack)))
+                        | _ -> (Error l ("Internal error: multiple pattern matches for " ^ name),lm,le)
+                                                end)end)
+                | Tag_empty ->
+                  (match Map.lookup name fdefs with
+                    | Nothing -> (Error l ("Internal error: no function def for " ^ name),lm,le)
+                    | Just (funcls) ->
+                      (match find_funcl t_level funcls (V_tuple [lv;rv]) with
+                        | [] -> (Error l ("No matching pattern for function " ^ name),lm,l_env)
+                        | [(env,used_unknown,exp)] ->
+                          resolve_outcome
+                            (if mode.eager_eval
+                             then (interp_main mode t_level env (emem name) exp)
+                             else (debug_out (Just name) (Just (V_tuple [lv;rv])) exp t_level (emem name) env))
+                            (fun ret lm le -> (Value ret,l_mem,l_env))
+                            (fun a -> update_stack a
+                              (fun stack -> (Hole_frame redex_id (E_aux (E_id redex_id) (l,annot))
+                                               t_level l_env l_mem stack)))
+                        | _ -> (Error l ("Internal error: multiple pattern matches for " ^ name),lm,le)
+                       end)end)
+                | Tag_spec ->
+                  (match Map.lookup name fdefs with
+                    | Nothing -> (Error l ("Internal error: No function definition found for " ^ name),lm,le)
+                    | Just (funcls) ->
+                      (match find_funcl t_level funcls (V_tuple [lv;rv]) with
+                        | [] -> (Error l ("No matching pattern for function " ^ name),lm,l_env)
+                        | [(env,used_unknown,exp)] ->
+                          resolve_outcome
+                            (if mode.eager_eval
+                             then (interp_main mode t_level env (emem name) exp)
+                             else (debug_out (Just name) (Just (V_tuple [lv;rv])) exp t_level (emem name) env))
+                            (fun ret lm le -> (Value ret,l_mem,l_env))
+                            (fun a -> update_stack a
+                              (fun stack -> (Hole_frame redex_id
+                                               (E_aux (E_id redex_id) (l,(intern_annot annot)))
+                                               t_level l_env l_mem stack)))
+                        | _ -> (Error l ("Internal error: multiple pattern matches for " ^ name), lm, le)
+                       end)end)
+                | Tag_extern ext_name ->
+                  let ext_name = match ext_name with Just s -> s | Nothing -> name end in
+                  (Action (Call_extern ext_name (V_tuple [lv;rv]))
+                          (Hole_frame redex_id
+                             (E_aux (E_id redex_id) (l,intern_annot annot)) t_level le lm Top),lm,le)
+                | _ -> (Error l "Internal error: unexpected tag for app_infix", l_mem, l_env) end)
+            (fun a -> update_stack a
+              (add_to_top_frame
+                 (fun r env -> let (el,env') = to_exp mode env lv in (E_aux (E_app_infix el op r) (l,annot), env')))))
+        (fun a -> update_stack a (add_to_top_frame (fun lft env -> (E_aux (E_app_infix lft op r) (l,annot), env))))
+  | E_exit exp ->
+    (Action (Exit exp) (mk_thunk l annot t_level l_env l_mem),l_mem, l_env)
+  | E_return exp ->
+    resolve_outcome
+      (interp_main mode t_level l_env l_mem exp)
+      (fun v lm le -> (Action (Return v) Top, l_mem, l_env))
+      (fun a -> update_stack a (add_to_top_frame (fun e env -> (E_aux (E_return e) (l,annot), env))))
+  | E_assert cond msg ->
+    resolve_outcome
+      (interp_main mode t_level l_env l_mem msg)
+      (fun v lm le ->
+         resolve_outcome
+           (interp_main mode t_level l_env lm cond)
+           (fun c lm le ->
+              (match detaint c with
+               | V_lit (L_aux L_one _) -> (Value unitv,lm,l_env)
+               | V_lit (L_aux L_true _) -> (Value unitv,lm,l_env)
+               | V_lit (L_aux L_zero _) -> (Action (Fail v) (mk_thunk l annot t_level l_env l_mem), lm,le)
+               | V_lit (L_aux L_false _) -> (Action (Fail v) (mk_thunk l annot t_level l_env l_mem), lm,le)
+               | V_unknown ->
+                 let (branches,maybe_id) =
+                        fix_up_nondet typ [unit_e;
+                                           E_aux (E_assert (E_aux (E_lit (L_aux L_zero l))
+                                                              (l,val_annot (mk_typ_id "bit"))) msg) (l,annot)]
+                                                  (l,annot) in
+                 interp_main mode t_level l_env lm (E_aux (E_nondet branches) (l,non_det_annot annot maybe_id))
+               | _ -> (Error l ("assert given unexpected " ^ (string_of_value c)),l_mem,l_env)
+               end))
+            (fun a -> update_stack a (add_to_top_frame (fun c env -> (E_aux (E_assert c msg) (l,annot), env)))))
+      (fun a -> update_stack a (add_to_top_frame (fun m env -> (E_aux (E_assert cond m) (l,annot), env))))
+  | E_let (lbind : letbind tannot) exp ->
+    match (interp_letbind mode t_level l_env l_mem lbind) with
+    | ((Value v,lm,le),_) ->
+      if mode.eager_eval
+      then interp_main mode t_level le lm exp
+      else debug_out Nothing Nothing exp t_level lm le
+    | (((Action a s as o),lm,le),Just lbuild) ->
+      ((update_stack o (add_to_top_frame (fun e env -> (E_aux (E_let (lbuild e) exp) (l,annot), env)))),lm,le)
+    | (e,_) -> e end
+  | E_assign lexp exp ->
+    resolve_outcome
+      (interp_main mode t_level l_env l_mem exp)
+      (fun v lm le ->
+        (match create_write_message_or_update mode t_level v l_env lm true lexp with
+          | (outcome,Nothing,_) -> outcome
+          | (outcome,Just lexp_builder,Nothing) ->
+            resolve_outcome outcome
+              (fun v lm le -> (Value v,lm,le))
+              (fun a ->
+                (match a with
+                  | (Action (Write_reg regf range value) stack) -> a
+                  | (Action (Write_mem id a_ range value) stack) -> a
+                  | (Action (Write_memv _ _ _) stack) -> a
+                  | (Action (Write_memv_tagged _ _ _ _) stack) -> a
+                  | _ -> update_stack a (add_to_top_frame
+                                           (fun e env ->
+                                             let (ev,env') = (to_exp mode env v) in
+                                             let (lexp,env') = (lexp_builder e env') in
+                                             (E_aux (E_assign lexp ev) (l,annot),env'))) end))
+          | (outcome,Just lexp_builder, Just v) ->
+            resolve_outcome outcome
+              (fun v lm le -> (Value v,lm,le))
+              (fun a -> update_stack a (add_to_top_frame
+                                          (fun e env ->
+                                             let (ev,env') = to_exp mode env v in
+                                             let (lexp,env') = (lexp_builder e env') in
+                                             (E_aux (E_assign lexp ev) (l,annot),env'))))
+         end))
+      (fun a -> update_stack a (add_to_top_frame (fun v env -> (E_aux (E_assign lexp v) (l,annot), env))))
+  | _ -> (Error l "Internal expression escaped to interpreter", l_mem, l_env)
+  end
+
+and interp_main mode t_level l_env l_mem exp =
+  let _ = debug_fun_enter mode "interp_main" [show exp] in
+  let retval = __interp_main (indent_mode mode) t_level l_env l_mem exp in
+  let _ = debug_fun_exit mode "interp_main" retval in
+  retval
+
+(*TODO shrink location information on recursive calls *)
+and __interp_block mode t_level init_env local_env local_mem l tannot exps =
+   match exps with
+    | [] -> (Value (V_lit (L_aux (L_unit) Unknown)), local_mem, init_env)
+    | [exp] ->
+      if mode.eager_eval
+      then interp_main mode t_level local_env local_mem exp
+      else debug_out Nothing Nothing exp t_level local_mem local_env
+    | exp:: exps ->
+      resolve_outcome (interp_main mode t_level local_env local_mem exp)
+                      (fun _ lm le ->
+                        if mode.eager_eval
+                        then interp_block mode t_level init_env le lm l tannot exps
+                        else debug_out Nothing Nothing (E_aux (E_block exps) (l,tannot)) t_level lm le)
+                      (fun a -> update_stack a
+                        (add_to_top_frame (fun e env-> (E_aux (E_block(e::exps)) (l,tannot), env))))
+   end
+
+and interp_block mode t_level init_env local_env local_mem l tannot exps =
+  let _ = debug_fun_enter mode "interp_block" [show exps] in
+  let retval = __interp_block (indent_mode mode) t_level init_env local_env local_mem l tannot exps in
+  let _ = debug_fun_exit mode "interp_block" retval in
+  retval
+
+and __create_write_message_or_update mode t_level value l_env l_mem is_top_level
+    ((LEXP_aux lexp (l,annot)):lexp tannot)
+    : ((outcome * lmem * lenv) * maybe ((exp tannot) -> lenv -> ((lexp tannot) * lenv)) * maybe value) =
+   let (Env fdefs instrs default_dir lets regs ctors subregs aliases debug) = t_level in
+   let (typ,tag,ncs,ef,efr) = match annot with
+     | Nothing -> (mk_typ_var "fresh_v", Tag_empty, [],
+                   (Effect_aux (Effect_set []) Unknown),(Effect_aux (Effect_set []) Unknown))
+     | Just(t, tag, ncs, ef,efr) -> (t,tag,ncs,ef,efr) end in
+   let recenter_val (Typ_aux typ _) value = match typ with
+     | Typ_app (Id_aux (Id "reg") _) [Typ_arg_aux (Typ_arg_typ (Typ_aux (Typ_app (Id_aux (Id "vector") _)
+          [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant start) _)) _; Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant size) _)) _;_;_]) _)) _] ->
+        update_vector_start default_dir (natFromInteger start) (natFromInteger size) value
+     | _ -> value end in
+   match lexp with
+    | LEXP_id id ->
+      let name = get_id id in
+      match tag with
+      | Tag_intro ->
+        match detaint (in_lenv l_env id) with
+        | V_unknown ->
+          if is_top_level then
+            if name = "0" then
+              ((Value (V_lit (L_aux L_unit l)), update_mem true l_mem 0 value, l_env), Nothing, Nothing)
+            else
+              let (LMem owner c m s) = l_mem in
+              let l_mem = (LMem owner (c+1) m s) in
+              ((Value (V_lit (L_aux L_unit l)),
+                update_mem mode.track_lmem l_mem c value,
+                (add_to_env (id,(V_boxref c typ)) l_env)),Nothing, Nothing)
+          else ((Error l ("Unknown local id " ^ (get_id id)),l_mem,l_env),Nothing,Nothing)
+        | v ->
+          if is_top_level
+          then
+            if name = "0" then
+              ((Value (V_lit (L_aux L_unit l)), update_mem true l_mem 0 value, l_env), Nothing,Nothing)
+            else
+              ((Error l ("Writes must be to reg values given " ^ (string_of_value v)),l_mem,l_env),
+               Nothing, Nothing)
+          else ((Value v,l_mem,l_env),Just (fun e env -> (LEXP_aux(LEXP_id id) (l,annot), env)), Nothing)
+        end
+      | Tag_set ->
+        match detaint (in_lenv l_env id) with
+        | ((V_boxref n t) as v) ->
+          if is_top_level
+          then ((Value (V_lit (L_aux L_unit l)),
+                 update_mem mode.track_lmem l_mem n (recenter_val t value), l_env),Nothing, Nothing)
+          else ((Value v, l_mem, l_env),Just (fun e env -> (LEXP_aux (LEXP_id id) (l,annot), env)), Nothing)
+        | V_unknown ->
+          if is_top_level then
+            if name = "0" then
+              ((Value (V_lit (L_aux L_unit l)), update_mem true l_mem 0 value, l_env), Nothing, Nothing)
+            else
+              let (LMem owner c m s) = l_mem in
+              let l_mem = (LMem owner (c+1) m s) in
+              ((Value (V_lit (L_aux L_unit l)),
+                update_mem mode.track_lmem l_mem c value,
+                (add_to_env (id,(V_boxref c typ)) l_env)),Nothing,Nothing)
+          else ((Error l ("Unknown local id " ^ (get_id id)),l_mem,l_env),Nothing, Nothing)
+        | v ->
+          if is_top_level
+          then
+            if name = "0" then
+              ((Value (V_lit (L_aux L_unit l)), update_mem true l_mem 0 value, l_env), Nothing, Nothing)
+            else
+              ((Error l ("Writes must be to reg values given " ^ (string_of_value v)),l_mem,l_env),
+               Nothing, Nothing)
+          else ((Value v,l_mem,l_env),Just (fun e env -> (LEXP_aux(LEXP_id id) (l,annot), env)), Nothing)
+         end
+      | Tag_empty ->
+        match detaint (in_lenv l_env id) with
+        | ((V_boxref n t) as v) ->
+          if is_top_level
+          then ((Value (V_lit (L_aux L_unit l)),
+                 update_mem mode.track_lmem l_mem n (recenter_val t value), l_env),Nothing, Nothing)
+          else ((Value v, l_mem, l_env),Just (fun e env -> (LEXP_aux (LEXP_id id) (l,annot), env)), Nothing)
+        | V_unknown ->
+          if is_top_level then
+            if name = "0" then
+              ((Value (V_lit (L_aux L_unit l)), update_mem true l_mem 0 value, l_env), Nothing, Nothing)
+            else
+              let (LMem owner c m s) = l_mem in
+              let l_mem = (LMem owner (c+1) m s) in
+              ((Value (V_lit (L_aux L_unit l)),
+                update_mem mode.track_lmem l_mem c value,
+                (add_to_env (id,(V_boxref c typ)) l_env)),Nothing, Nothing)
+          else ((Error l ("Unknown local id " ^ (get_id id)),l_mem,l_env),Nothing,Nothing)
+        | v ->
+          if is_top_level
+          then
+            if name = "0" then
+              ((Value (V_lit (L_aux L_unit l)), update_mem true l_mem 0 value, l_env), Nothing, Nothing)
+            else
+              ((Error l ("Writes must be to reg values given " ^ (string_of_value v)),l_mem,l_env),
+               Nothing, Nothing)
+          else ((Value v,l_mem,l_env),Just (fun e env -> (LEXP_aux(LEXP_id id) (l,annot), env)), Nothing)
+          end
+      | Tag_global ->
+        (match in_env lets name with
+         | Just v ->
+           if is_top_level then ((Error l "Writes must be to reg or registers",l_mem,l_env),Nothing,Nothing)
+           else ((Value v,l_mem,l_env),Just (fun e env -> (LEXP_aux(LEXP_id id) (l,annot), env)), Nothing)
+         | Nothing ->
+           let regf =
+             match in_env regs name with (*pull the regform with the most specific type annotation from env *)
+             | Just(V_register regform) -> regform
+             | _ -> Assert_extra.failwith "Register not known in regenv" end in
+           let start_pos = reg_start_pos regf in
+           let reg_size = reg_size regf in
+           let request =
+             (Action (Write_reg regf Nothing
+                        (if is_top_level then (update_vector_start default_dir start_pos reg_size value) else value))
+                (Thunk_frame (E_aux (E_lit (L_aux L_unit l)) (l,intern_annot annot)) t_level l_env l_mem Top),
+              l_mem,l_env) in
+           if is_top_level then (request,Nothing,Nothing)
+           else (request,Just (fun e env -> (LEXP_aux (LEXP_id id) (l,annot), env)), Nothing) end)
+      | Tag_extern _ ->
+        let regf =
+          match in_env regs name with (*pull the regform with the most specific type annotation from env *)
+          | Just(V_register regform) -> regform
+          | _ -> Assert_extra.failwith "Register not known in regenv" end in
+        let start_pos = reg_start_pos regf in
+        let reg_size = reg_size regf in
+        let request =
+          (Action (Write_reg regf Nothing
+                     (if is_top_level then (update_vector_start default_dir start_pos reg_size value) else value))
+             (Thunk_frame (E_aux (E_lit (L_aux L_unit l)) (l,intern_annot annot)) t_level l_env l_mem Top),
+           l_mem,l_env) in
+        if is_top_level then (request,Nothing,Nothing)
+        else (request,Just (fun e env -> (LEXP_aux (LEXP_id id) (l,annot), env)),Nothing)
+      | Tag_alias ->
+        let request =
+          (match in_env aliases name with
+           | Just (AL_aux aspec (l,_)) ->
+             (match aspec with
+              | AL_subreg (RI_aux (RI_id reg)  (li, ((Just((Typ_aux (Typ_id (Id_aux (Id id) _)) _),_,_,_,_)) as annot'))) subreg ->
+                (match in_env subregs id with
+                 | Just indexes ->
+                   (match in_env indexes (get_id subreg) with
+                    | Just ir ->
+                      (Action
+                         (Write_reg (Form_SubReg subreg (Form_Reg reg annot' default_dir) ir) Nothing
+                            (update_vector_start default_dir (get_first_index_range ir)
+                               (get_index_range_size ir) value))
+                         (Thunk_frame (E_aux (E_lit (L_aux L_unit l)) (l, intern_annot annot))
+                            t_level l_env l_mem Top), l_mem, l_env)
+                    | _ -> (Error l "Internal error, alias spec has unknown field", l_mem, l_env) end)
+                  | _ ->
+                    (Error l ("Internal error: alias spec has unknown register type " ^ id), l_mem, l_env) end)
+              | AL_bit (RI_aux (RI_id reg) (_,annot')) e ->
+                resolve_outcome (interp_main mode t_level l_env l_mem e)
+                  (fun v le lm -> match v with
+                     | V_lit (L_aux (L_num i) _) ->
+                       let i = natFromInteger i in
+                       (Action (Write_reg (Form_Reg reg annot' default_dir) (Just (i,i))
+                                  (update_vector_start default_dir i 1 value))
+                          (Thunk_frame (E_aux (E_lit (L_aux L_unit l)) (l, intern_annot annot))
+                             t_level l_env l_mem Top), l_mem, l_env)
+                     | _ -> (Error l "Internal error: alias bit has non number", l_mem, l_env) end)
+                  (fun a -> a)
+              | AL_slice (RI_aux (RI_id reg) (_,annot')) start stop ->
+                resolve_outcome (interp_main mode t_level l_env l_mem start)
+                  (fun v lm le ->
+                     match detaint v with
+                     | V_lit (L_aux (L_num start) _) ->
+                       (resolve_outcome (interp_main mode t_level l_env lm stop)
+                          (fun v le lm ->
+                             (match detaint v with
+                              | V_lit (L_aux (L_num stop) _) ->
+                                let (start,stop) = (natFromInteger start,natFromInteger stop) in
+                                let size = if start < stop then stop - start +1 else start -stop +1 in
+                                (Action (Write_reg (Form_Reg reg annot' default_dir) (Just (start,stop))
+                                           (update_vector_start default_dir start size value))
+                                   (Thunk_frame (E_aux (E_lit (L_aux L_unit l)) (l, intern_annot annot))
+                                      t_level l_env l_mem Top),
+                                 l_mem, l_env)
+                              | _ -> (Error l "Alias slice has non number",l_mem, l_env) end))
+                           (fun a -> a))
+                       | _ -> (Error l "Alias slice has non number",l_mem,l_env) end)
+                   (fun a -> a)
+               | AL_concat (RI_aux (RI_id reg1) (l1,annot1)) (RI_aux (RI_id reg2) annot2) ->
+                 let val_typ (Typ_aux t _) = match t with
+                   | Typ_app (Id_aux (Id "register") _) [Typ_arg_aux (Typ_arg_typ t) _] -> t
+                   | _ -> Assert_extra.failwith "alias type ill formed" end in
+                 let (t1,t2) = match (annot1,annot2) with
+                   | (Just (t1,_,_,_,_), (_,(Just (t2,_,_,_,_)))) -> (val_typ t1,val_typ t2)
+                   | _ -> Assert_extra.failwith "type annotations ill formed" end in
+                 (match (t1,t2) with
+                  | (Typ_aux (Typ_app (Id_aux (Id "vector") _) [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant b1) _)) _;
+                                                                Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant r1) _)) _; _;_]) _,
+                     Typ_aux (Typ_app (Id_aux (Id "vector") _) [Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant b2) _)) _;
+                                                                Typ_arg_aux (Typ_arg_nexp (Nexp_aux (Nexp_constant r2) _)) _; _;_]) _) ->
+                    (Action
+                       (Write_reg (Form_Reg reg1 annot1 default_dir) Nothing
+                          (slice_vector value (natFromInteger b1) (natFromInteger r1)))
+                       (Thunk_frame
+                          (E_aux (E_assign (LEXP_aux (LEXP_id reg2) annot2)
+                                    (fst (to_exp <| mode with track_values =false|> eenv
+                                    (slice_vector value (natFromInteger (r1+1)) (natFromInteger r2)))))
+                                 annot2)
+                         t_level l_env l_mem Top), l_mem,l_env)
+                  | _ -> (Error l "Internal error: alias vector types ill formed", l_mem, l_env) end)
+              | _ -> (Error l "Internal error: alias spec ill formed", l_mem, l_env) end)
+         | _ -> (Error l ("Internal error: alias not found for id " ^(get_id id)),l_mem,l_env) end) in
+          (request,Nothing,Nothing)
+      | _ ->
+        ((Error l ("Internal error: writing to id with tag other than extern, empty, or alias " ^ (get_id id)),
+          l_mem,l_env),Nothing,Nothing)
+      end
+    | LEXP_memory id exps ->
+      match (exp_list mode t_level (fun exps env -> (E_aux (E_tuple exps) (Unknown,Nothing),env))
+               (fun vs ->
+                  match vs with | [] -> V_lit (L_aux L_unit Unknown) | [v] -> v | vs -> V_tuple vs end)
+                      l_env l_mem [] exps) with
+      | (Value v,lm,le) ->
+        (match tag with
+         | Tag_extern _ ->
+           let request =
+             let effects = (match ef with | Effect_aux(Effect_set es) _ -> es | _ -> [] end) in
+             let act = if has_wmem_effect effects then (Write_mem id v Nothing value)
+                       else if has_wmv_effect effects then (Write_memv id v value)
+                       else Assert_extra.failwith "LEXP_memory with neither wmem or wmv event" in
+            (Action act
+               (Thunk_frame (E_aux (E_lit (L_aux L_unit l)) (l,intern_annot annot)) t_level l_env lm Top),
+             lm,l_env) in
+          if is_top_level then (request,Nothing,Nothing)
+          else
+            (request,
+             Just (fun e env->
+               let (parms,env) = (to_exps mode env (match v with | V_tuple vs -> vs | v -> [v] end)) in
+               (LEXP_aux (LEXP_memory id parms) (l,annot), env)), Nothing)
+        | Tag_global ->
+          let name = get_id id in
+          (match Map.lookup name fdefs with
+            | Just(funcls) ->
+              let new_vals = match v with
+                | V_tuple vs -> V_tuple (vs ++ [value])
+                | V_lit (L_aux L_unit _) -> V_tuple [v;value] (*hmmm may be wrong in some code*)
+                | v -> V_tuple [v;value] end in
+              (match find_funcl t_level funcls new_vals with
+                | [] -> ((Error l ("No matching pattern for function " ^ name ^
+                                      " on value " ^ (string_of_value new_vals)),l_mem,l_env),Nothing, Nothing)
+                | [(env,used_unknown,exp)] ->
+                  (match (if mode.eager_eval
+                          then (interp_main mode t_level env (emem name) exp)
+                          else (debug_out (Just name) (Just new_vals) exp t_level (emem name) env)) with
+                    | (Value ret, _,_) -> ((Value ret, l_mem,l_env),Nothing, Nothing)
+                    | (Action action stack,lm,le) ->
+                      (((update_stack (Action action stack)
+                          (fun stack -> (Hole_frame redex_id (E_aux (E_id redex_id) (l,(intern_annot annot)))
+                                           t_level l_env l_mem stack))), l_mem,l_env), Nothing, Nothing)
+                    | (e,lm,le) -> ((e,lm,le),Nothing,Nothing) end)
+                | multi_matches ->
+                  let (lets,taint_env) =
+                    List.foldr (fun (env,_,exp) (rst,taint_env) ->
+                      let (e,t_e) = env_to_let mode env exp taint_env in (e::rst,t_e)) ([],l_env) multi_matches in
+                  let (branches,maybe_id) = fix_up_nondet typ lets (l,annot) in
+                  (interp_main mode t_level taint_env lm (E_aux (E_nondet branches)
+                                                            (l,non_det_annot annot maybe_id)),
+                   Nothing, Nothing)
+               end)
+            | Nothing ->
+              ((Error l ("Internal error: function unfound " ^ name),lm,le),Nothing,Nothing) end)
+        | Tag_spec ->
+          let name = get_id id in
+          (match Map.lookup name fdefs with
+            | Just(funcls) ->
+              let new_vals = match v with
+                | V_tuple vs -> V_tuple (vs ++ [value])
+                | V_lit (L_aux L_unit _) -> V_tuple [v;value] (*hmmm may be wrong in some code*)
+                | v -> V_tuple [v;value] end in
+              (match find_funcl t_level funcls new_vals with
+                | [] -> ((Error l ("No matching pattern for function " ^ name ^
+                                      " on value " ^ (string_of_value new_vals)),l_mem,l_env),Nothing,Nothing)
+                | [(env,used_unknown,exp)] ->
+                  (match (if mode.eager_eval
+                          then (interp_main mode t_level env (emem name) exp)
+                          else (debug_out (Just name) (Just new_vals) exp t_level (emem name) env)) with
+                    | (Value ret, _,_) -> ((Value ret, l_mem,l_env),Nothing,Nothing)
+                    | (Action action stack,lm,le) ->
+                      (((update_stack (Action action stack)
+                          (fun stack -> (Hole_frame redex_id (E_aux (E_id redex_id) (l,(intern_annot annot)))
+                                           t_level l_env l_mem stack))), l_mem,l_env), Nothing, Nothing)
+                    | (e,lm,le) -> ((e,lm,le),Nothing,Nothing) end)
+                | multi_matches ->
+                  let (lets,taint_env) =
+                    List.foldr (fun (env,_,exp) (rst,taint_env) ->
+                      let (e,t_e) = env_to_let mode env exp taint_env in (e::rst,t_e)) ([],l_env) multi_matches in
+                  let (branches,maybe_id) = fix_up_nondet typ lets (l,annot) in
+                  (interp_main mode t_level taint_env lm (E_aux (E_nondet branches)
+                                                            (l,non_det_annot annot maybe_id)),
+                   Nothing,Nothing)
+               end)
+            | Nothing ->
+              ((Error l ("Internal error: function unfound " ^ name),lm,le),Nothing,Nothing) end)
+         | _ -> ((Error l "Internal error: unexpected tag for memory or register write", lm,le),Nothing,Nothing)
+        end)
+      | (Action a s,lm, le) ->
+        ((Action a s,lm,le),
+         Just (fun (E_aux e _) env ->
+                (match e with | E_tuple es -> (LEXP_aux (LEXP_memory id es) (l,annot), env)
+                              | _ -> Assert_extra.failwith "Lexp builder not well formed" end)), Nothing)
+      | e -> (e,Nothing,Nothing) end
+    | LEXP_cast typc id ->
+      let name = get_id id in
+      match tag with
+      | Tag_intro ->
+          match detaint (in_lenv l_env id) with
+            | V_unknown ->
+              if is_top_level
+              then begin
+                let (LMem owner c m s) = l_mem in
+                let l_mem = (LMem owner (c+1) m s) in
+                ((Value (V_lit (L_aux L_unit l)), update_mem mode.track_lmem l_mem c value,
+                  (add_to_env (id,(V_boxref c typ)) l_env)),Nothing, Nothing)
+              end
+              else ((Error l ("LEXP:cast1: Undefined id " ^ (get_id id)),l_mem,l_env),Nothing, Nothing)
+            | v ->
+              if is_top_level then ((Error l "Writes must be to reg values",l_mem,l_env),Nothing, Nothing)
+              else ((Value v,l_mem,l_env),Just (fun e env -> (LEXP_aux(LEXP_cast typc id) (l,annot), env)), Nothing)
+          end
+       | Tag_set ->
+          match detaint (in_lenv l_env id) with
+            | ((V_boxref n t) as v) ->
+              if is_top_level
+              then ((Value (V_lit (L_aux L_unit l)),
+                     update_mem mode.track_lmem l_mem n (recenter_val t value), l_env),Nothing,Nothing)
+              else ((Value v, l_mem, l_env),
+                    Just (fun e env -> (LEXP_aux (LEXP_cast typc id) (l,annot), env)), Nothing)
+            | V_unknown ->
+              if is_top_level
+              then begin
+                let (LMem owner c m s) = l_mem in
+                let l_mem = (LMem owner (c+1) m s) in
+                ((Value (V_lit (L_aux L_unit l)), update_mem mode.track_lmem l_mem c value,
+                  (add_to_env (id,(V_boxref c typ)) l_env)),Nothing,Nothing)
+              end
+              else ((Error l ("LEXP:cast2: Undefined id " ^ (get_id id)),l_mem,l_env),Nothing,Nothing)
+            | v ->
+              if is_top_level then ((Error l "Writes must be to reg values",l_mem,l_env),Nothing,Nothing)
+              else ((Value v,l_mem,l_env),
+                    Just (fun e env -> (LEXP_aux(LEXP_cast typc id) (l,annot), env)),Nothing)
+          end
+        | Tag_empty ->
+          match detaint (in_lenv l_env id) with
+            | ((V_boxref n t) as v) ->
+              if is_top_level
+              then ((Value (V_lit (L_aux L_unit l)),
+                     update_mem mode.track_lmem l_mem n (recenter_val t value), l_env),Nothing,Nothing)
+              else ((Value v, l_mem, l_env),
+                    Just (fun e env -> (LEXP_aux (LEXP_cast typc id) (l,annot), env)), Nothing)
+            | V_unknown ->
+              if is_top_level
+              then begin
+                let (LMem owner c m s) = l_mem in
+                let l_mem = (LMem owner (c+1) m s) in
+                ((Value (V_lit (L_aux L_unit l)), update_mem mode.track_lmem l_mem c value,
+                  (add_to_env (id,(V_boxref c typ)) l_env)),Nothing,Nothing)
+              end
+              else ((Error l ("LEXP:cast3: Undefined id " ^ (get_id id)),l_mem,l_env),Nothing,Nothing)
+            | v ->
+              if is_top_level then ((Error l "Writes must be to reg values",l_mem,l_env),Nothing,Nothing)
+              else ((Value v,l_mem,l_env),Just (fun e env -> (LEXP_aux(LEXP_cast typc id) (l,annot), env)),Nothing)
+          end
+        | Tag_extern _ ->
+           let regf =
+            match in_env regs name with (*pull the regform with the most specific type annotation from env *)
+              | Just(V_register regform) -> regform
+              | _ -> Assert_extra.failwith "Register not known in regenv" end in
+          let start_pos = reg_start_pos regf in
+          let reg_size = reg_size regf in
+          let request =
+            (Action (Write_reg regf Nothing
+                       (if is_top_level
+                        then (update_vector_start default_dir start_pos reg_size value)
+                        else value))
+               (Thunk_frame (E_aux (E_lit (L_aux L_unit l)) (l,intern_annot annot)) t_level l_env l_mem Top),
+             l_mem,l_env) in
+          if is_top_level then (request,Nothing,Nothing)
+          else (request,Just (fun e env -> (LEXP_aux (LEXP_cast typc id) (l,annot), env)),Nothing)
+        | _ ->
+          ((Error l ("Internal error: writing to id not extern or empty " ^(get_id id)),l_mem,l_env),
+           Nothing,Nothing)
+        end
+    | LEXP_tup ltups ->
+      match (ltups,value) with
+      | ([],_) ->
+        ((Error l "Internal error: found an empty tuple of assignments as an lexp", l_mem, l_env), Nothing,Nothing)
+      | ([le],V_tuple[v]) -> create_write_message_or_update mode t_level v l_env l_mem true le
+      | (le::ltups,V_tuple (v::vs)) ->
+        let new_v = V_tuple vs in
+        (match (create_write_message_or_update mode t_level v l_env l_mem true le) with
+         | ((Value v_whole,lm,le),Nothing,Nothing) ->
+           create_write_message_or_update mode t_level new_v le lm true (LEXP_aux (LEXP_tup ltups) (l,annot))
+         | ((Action act stack,lm,le),Nothing,Nothing) ->
+           ((Action act stack,lm,le), Just (fun e env -> (LEXP_aux (LEXP_tup ltups) (l,annot),env)), Just new_v)
+         | ((Action act stack,lm,le), Just le_builder, Nothing) ->
+           ((Action act stack,lm,le),
+            Just (fun e env ->
+                let (lexp,env) = le_builder e env in
+                (LEXP_aux (LEXP_tup (lexp::ltups)) (l,annot),env)), Just value)
+         | ((Action act stack, lm,le), Just le_builder, Just v) ->
+           ((Action act stack, lm, le),
+            Just (fun e env ->
+                let (lexp,env) = le_builder e env in
+                (LEXP_aux (LEXP_tup (lexp::ltups)) (l,annot),env)), Just (V_tuple (v::vs)))
+         | ((Error l msg,lm,le),_,_) -> ((Error l msg,lm,le),Nothing,Nothing)
+         | _ ->
+           ((Error l "Internal error: Unexpected pattern match failure in LEXP_tup",l_mem,l_env),Nothing,Nothing)
+        end)
+      end
+    | LEXP_vector lexp exp ->
+      match (interp_main mode t_level l_env l_mem exp) with
+      | (Value i,lm,le) ->
+        (match detaint i with
+        | V_unknown -> ((Value i,lm,le),Nothing,Nothing)
+        | V_lit (L_aux (L_num n) ln) ->
+          let next_builder le_builder =
+            (fun e env ->
+              let (lexp,env) = le_builder e env in
+              let (ie,env) = to_exp mode env i in
+              (LEXP_aux (LEXP_vector lexp ie) (l,annot), env)) in
+          let n = natFromInteger n in
+          (match (create_write_message_or_update mode t_level value l_env lm false lexp) with
+          | ((Value v_whole,lm,le),maybe_builder,maybe_value) ->
+            let v = detaint v_whole in
+            let nth _ = detaint (access_vector v n) in
+            (match v with
+              | V_unknown -> ((Value v_whole,lm,le),Nothing,Nothing)
+              | V_boxref i _ ->
+                (match (in_mem lm i,is_top_level,maybe_builder) with
+                  | ((V_vector _ _ _ as vec),true,_) ->
+                    let new_vec = fupdate_vector_slice vec (V_vector 1 default_dir [value]) n n in
+                    ((Value (V_lit (L_aux L_unit Unknown)),
+                      update_mem mode.track_lmem lm i new_vec, l_env), Nothing,Nothing)
+                  | ((V_track (V_vector _ _ _ as vec) r), true,_) ->
+                    let new_vec = fupdate_vector_slice vec (V_vector 1 default_dir [value])  n n in
+                    ((Value (V_lit (L_aux L_unit Unknown)),
+                      update_mem mode.track_lmem lm i (taint new_vec r),l_env),Nothing,Nothing)
+                  | ((V_vector _ _ _ as vec),false, Just lexp_builder) ->
+                    ((Value (access_vector vec n), lm, l_env), Just (next_builder lexp_builder),Nothing)
+                  | (v,_,_) ->
+                    Assert_extra.failwith("no vector findable in set bit, found " ^ (string_of_value v))
+                 end )
+              | V_vector inc m vs ->
+                (match (nth(),is_top_level,maybe_builder) with
+                  | (V_register regform,true,_) ->
+                    let start_pos = reg_start_pos regform in
+                    let reg_size = reg_size regform in
+                    ((Action (Write_reg regform Nothing (update_vector_start default_dir start_pos reg_size value))
+                        (Thunk_frame (E_aux (E_lit (L_aux L_unit l))
+                                        (l,intern_annot annot)) t_level l_env l_mem Top),
+                      l_mem,l_env),
+                     Nothing,Nothing)
+                  | (V_register regform,false,Just lexp_builder) ->
+                    let start_pos = reg_start_pos regform in
+                    let reg_size = reg_size regform in
+                    ((Action (Write_reg regform Nothing (update_vector_start default_dir start_pos reg_size value))
+                        (Thunk_frame (E_aux (E_lit (L_aux L_unit l))
+                                        (l,intern_annot annot)) t_level l_env l_mem Top),
+                      l_mem,l_env),
+                     Just (next_builder lexp_builder),maybe_value)
+                  | (V_boxref n t,true,_) ->
+                    ((Value (V_lit (L_aux L_unit Unknown)), update_mem mode.track_lmem lm n value, l_env),
+                     Nothing,Nothing)
+                  | (V_unknown,true,_) -> ((Value (V_lit (L_aux L_unit Unknown)), lm, l_env),Nothing,Nothing)
+                  | (v,true,_) ->
+                    ((Error l "Vector does not contain reg or register values",lm,l_env),Nothing,Nothing)
+                  | ((V_boxref n t),false, Just lexp_builder) ->
+                    ((Value (in_mem lm n),lm, l_env),Just (next_builder lexp_builder),Nothing)
+                  | (v,false, Just lexp_builder) ->
+                    ((Value v,lm,le), Just (next_builder lexp_builder),Nothing)
+                  | _ -> Assert_extra.failwith "Vector assignment logic incomplete"
+                  end)
+              | V_vector_sparse n m inc vs d ->
+              (match (nth(),is_top_level,maybe_builder) with
+                | (V_register regform,true,_) ->
+                    let start_pos = reg_start_pos regform in
+                    let reg_size = reg_size regform in
+                    ((Action (Write_reg regform Nothing (update_vector_start default_dir start_pos reg_size value))
+                      (Thunk_frame (E_aux (E_lit (L_aux L_unit l)) (l,intern_annot annot)) t_level l_env l_mem Top),
+                      l_mem,l_env),Nothing,Nothing)
+                | (V_register regform,false,Just lexp_builder) ->
+                    let start_pos = reg_start_pos regform in
+                    let reg_size = reg_size regform in
+                    ((Action (Write_reg regform Nothing (update_vector_start default_dir start_pos reg_size value))
+                      (Thunk_frame (E_aux (E_lit (L_aux L_unit l)) (l,intern_annot annot)) t_level l_env l_mem Top),
+                      l_mem,l_env),
+                     Just (next_builder lexp_builder),Nothing)
+                | (V_boxref n t,true,_) ->
+                  ((Value (V_lit (L_aux L_unit Unknown)), update_mem mode.track_lmem lm n value, l_env),
+                   Nothing,Nothing)
+                | (v,true,_) ->
+                  ((Error l ("Vector does not contain reg or register values " ^ (string_of_value v)),
+                    lm,l_env), Nothing,Nothing)
+                | ((V_boxref n t),false, Just lexp_builder) ->
+                  ((Value (in_mem lm n),lm, l_env),Just (next_builder lexp_builder),Nothing)
+                | (v,false, Just lexp_builder) ->
+                  ((Value v,lm,le), Just (next_builder lexp_builder), Nothing)
+                | _ -> Assert_extra.failwith "Vector assignment logic incomplete"
+                end)
+            | v ->
+              ((Error l ("Vector access to write of non-vector" ^ (string_of_value v)),lm,l_env),Nothing,Nothing)
+             end)
+         | ((Action a s,lm,le),Just lexp_builder,maybe_value) ->
+           (match (a,is_top_level) with
+           | ((Write_reg regf Nothing value),true) ->
+             ((Action (Write_reg regf (Just (n,n))
+                         (if (vector_length value) = 1
+                          then (update_vector_start default_dir n 1 value)
+                          else (access_vector value n))) s, lm,le), Nothing, Nothing)
+           | ((Write_reg regf Nothing value),false) ->
+             ((Action (Write_reg regf (Just (n,n))
+                         (if (vector_length value) = 1
+                          then (update_vector_start default_dir n 1 value)
+                          else (access_vector value n))) s,lm,le),
+              Just  (next_builder lexp_builder), Nothing)
+           | ((Write_mem id a Nothing value),true) ->
+             ((Action (Write_mem id a (Just (n,n)) value) s,lm,le), Nothing, Nothing)
+           | ((Write_mem id a Nothing value),false) ->
+             ((Action (Write_mem id a (Just (n,n)) value) s,lm,le), Just (next_builder lexp_builder), Nothing)
+           | _ -> ((Action a s,lm,le), Just (next_builder lexp_builder), Nothing) end)
+         | e -> e end)
+        | v ->
+          ((Error l ("Vector access must be a number given " ^ (string_of_value v)),lm,le),Nothing,Nothing) end)
+      | (Action a s,lm,le) ->
+        ((Action a s,lm,le), Just (fun e env -> (LEXP_aux (LEXP_vector lexp e) (l,annot), env)), Nothing)
+      | e -> (e,Nothing,Nothing) end
+    | LEXP_vector_range lexp exp1 exp2  ->
+      match (interp_main mode t_level l_env l_mem exp1) with
+      | (Value i1, lm, le) ->
+        (match detaint i1 with
+        | V_unknown -> ((Value i1,lm,le),Nothing,Nothing)
+        | V_lit (L_aux (L_num n1) ln1) ->
+          (match (interp_main mode t_level l_env l_mem exp2) with
+          | (Value i2,lm,le) ->
+            (match detaint i2 with
+            | V_unknown -> ((Value i2,lm,le),Nothing,Nothing)
+            | V_lit (L_aux (L_num n2) ln2) ->
+              let next_builder le_builder =
+                (fun e env ->
+                  let (e1,env) = to_exp mode env i1 in
+                  let (e2,env) = to_exp mode env i2 in
+                  let (lexp,env) = le_builder e env in
+                  (LEXP_aux (LEXP_vector_range lexp e1 e2) (l,annot), env)) in
+              let (n1,n2) = (natFromInteger n1,natFromInteger n2) in
+              (match (create_write_message_or_update mode t_level value l_env lm false lexp) with
+              | ((Value v,lm,le), Just lexp_builder,_) ->
+                (match (detaint v,is_top_level) with
+                | (V_vector m inc vs,true) ->
+                  ((Value (V_lit (L_aux L_unit Unknown)),
+                    update_vector_slice mode.track_lmem v value n1 n2 lm, l_env), Nothing, Nothing)
+                | (V_boxref _ _, true) ->
+                  ((Value (V_lit (L_aux L_unit Unknown)),
+                    update_vector_slice mode.track_lmem v value n1 n2 lm, l_env), Nothing, Nothing)
+                | (V_vector m inc vs,false) ->
+                  ((Value (slice_vector v n1 n2),lm,l_env), Just (next_builder lexp_builder), Nothing)
+                | (V_register regform,true) ->
+                  let start_pos = reg_start_pos regform in
+                  let reg_size = reg_size regform in
+                  ((Action (Write_reg regform (Just (n1,n2)) (update_vector_start default_dir start_pos reg_size v))
+                      (mk_thunk l annot t_level l_env l_mem),
+                      l_mem,l_env),
+                     Just (next_builder lexp_builder), Nothing)
+                | (V_unknown,_) ->
+                  let inc =  n1 < n2 in
+                  let start = if inc then n1 else (n2-1) in
+                  let size = if inc then n2-n1 +1 else n1 -n2 +1 in
+                  ((Value (V_vector start (if inc then IInc else IDec) (List.replicate size V_unknown)),
+                    lm,l_env),Nothing,Nothing)
+                | _ -> ((Error l "Vector required",lm,le),Nothing,Nothing) end)
+              | ((Action (Write_reg regf Nothing value) s, lm,le), Just lexp_builder,_) ->
+                let len = (if n1 < n2 then n2 -n1 else n1 - n2) +1 in
+                ((Action
+                    (Write_reg regf (Just (n1,n2))
+                       (if (vector_length value) <= len
+                        then (update_vector_start default_dir n1 len value)
+                        else (slice_vector value n1 n2))) s,lm,le),
+                 Just (next_builder lexp_builder), Nothing)
+              | ((Action (Write_mem id a Nothing value) s,lm,le), Just lexp_builder,_) ->
+                ((Action (Write_mem id a (Just (n1,n2)) value) s,lm,le), Just (next_builder lexp_builder), Nothing)
+              | ((Action a s,lm,le), Just lexp_builder,_ ) ->
+                ((Action a s,lm,le), Just (next_builder lexp_builder), Nothing)
+              | e -> e end)
+            | _ -> ((Error l "Vector slice requires a number", lm, le),Nothing,Nothing) end)
+          | (Action a s,lm,le) ->
+            ((Action a s,lm, le),
+             Just (fun e env ->
+               let (e1,env) = to_exp mode env i1 in
+               (LEXP_aux (LEXP_vector_range lexp e1 e) (l,annot), env)), Nothing)
+          | e -> (e,Nothing,Nothing) end)
+        | _ -> ((Error l "Vector slice requires a number", lm, le),Nothing,Nothing) end)
+      | (Action a s,lm,le) ->
+        ((Action a s, lm,le), Just (fun e env -> (LEXP_aux (LEXP_vector_range lexp e exp2) (l,annot), env)), Nothing)
+      | e -> (e,Nothing,Nothing) end
+   | LEXP_field lexp id ->
+     (match (create_write_message_or_update mode t_level value l_env l_mem false lexp) with
+     | ((Value (V_record t fexps),lm,le),Just lexp_builder,_) ->
+       let next_builder = Just (fun e env -> let (lexp,env) = (lexp_builder e env) in
+                                             (LEXP_aux (LEXP_field lexp id) (l,annot), env)) in
+       match (in_env (env_from_list fexps) (get_id id),is_top_level) with
+       | (Just (V_boxref n t),true) ->
+         ((Value (V_lit (L_aux L_unit l)), update_mem mode.track_lmem lm n value, l_env),Nothing,Nothing)
+       | (Just (V_boxref n t),false) -> ((Value (in_mem lm n),lm,l_env),next_builder,Nothing)
+       | (Just v, true) -> ((Error l "Mutating a field access requires a reg type",lm,le),Nothing,Nothing)
+       | (Just v,false) -> ((Value v,lm,l_env),next_builder,Nothing)
+       | (Nothing,_) -> ((Error l "Field not found in specified record",lm,le),Nothing,Nothing) end
+     | ((Action a s,lm,le), Just lexp_builder,_) ->
+       let next_builder = Just (fun e env -> let (lexp,env) = (lexp_builder e env) in
+                                             (LEXP_aux (LEXP_field lexp id) (l,annot), env)) in
+       match a with
+       | Read_reg _ _ -> ((Action a s,lm,le), next_builder, Nothing)
+       | Read_mem _ _ _ -> ((Action a s,lm,le), next_builder, Nothing)
+       | Read_mem_tagged _ _ _ -> ((Action a s,lm,le), next_builder, Nothing)
+       | Call_extern _ _ -> ((Action a s,lm,le), next_builder, Nothing)
+       | Write_reg ((Form_Reg _ (Just(Typ_aux (Typ_id (Id_aux (Id id') _)) _,_,_,_,_)) _) as regf) Nothing value ->
+         match in_env subregs id' with
+           | Just(indexes) ->
+             match in_env indexes (get_id id) with
+               | Just ir ->
+                 ((Action
+                     (Write_reg (Form_SubReg id regf ir) Nothing
+                        (update_vector_start default_dir (get_first_index_range ir)
+                           (get_index_range_size ir) value)) s,
+                   lm,le),
+                  (if is_top_level then Nothing else next_builder), Nothing)
+               | _ -> ((Error l "Internal error, unrecognized write, no field",lm,le),Nothing,Nothing)
+                 end
+            | Nothing -> ((Error l "Internal error, unrecognized write, no subreges",lm,le),Nothing,Nothing) end
+       | _ -> ((Error l "Internal error, unrecognized write, no matching action",lm,le),Nothing,Nothing)
+       end
+     | e -> e end)
+     end
+
+and create_write_message_or_update mode t_level value l_env l_mem is_top_level le =
+  let _ = debug_fun_enter mode "create_write_message_or_update" [show le] in
+  let retval = __create_write_message_or_update (indent_mode mode) t_level value l_env l_mem is_top_level le in
+  let _ = debug_fun_exit mode "create_write_message_or_update" "_" in
+  retval
+
+and __interp_letbind mode t_level l_env l_mem (LB_aux lbind (l,annot)) =
+  match lbind with
+  | LB_val pat exp ->
+    match (interp_main mode t_level l_env l_mem exp) with
+    | (Value v,lm,le) ->
+      (match match_pattern t_level pat v with
+      | (true,used_unknown,env) -> ((Value (V_lit (L_aux L_unit l)), lm, (union_env env l_env)),Nothing)
+      | _ -> ((Error l "Pattern in letbind did not match value",lm,le),Nothing) end)
+    | (Action a s,lm,le) -> ((Action a s,lm,le),(Just (fun e -> (LB_aux (LB_val pat e) (l,annot)))))
+    | e -> (e,Nothing) end
+end
+
+and interp_letbind mode t_level l_env l_mem lb =
+  let _ = debug_fun_enter mode "interp_letbind" [show lb] in
+  let retval = __interp_letbind (indent_mode mode) t_level l_env l_mem lb in
+  let _ = debug_fun_exit mode "interp_letbind" "_" in
+  retval
+
+and __interp_alias_read mode t_level l_env l_mem (AL_aux alspec (l,annot)) =
+  let (Env defs instrs default_dir lets regs ctors subregs aliases debug) = t_level in
+  let stack = Hole_frame redex_id (E_aux (E_id redex_id) (l,(intern_annot annot))) t_level l_env l_mem Top in
+  let get_reg_typ_name typ =
+    match typ with
+      | Typ_aux (Typ_id (Id_aux (Id i) _)) _ -> i
+      | _ -> Assert_extra.failwith "Alias reg typ not well formed"
+   end in
+  match alspec with
+    | AL_subreg (RI_aux (RI_id reg) (li,((Just (t,_,_,_,_)) as annot'))) subreg ->
+      let reg_ti = get_reg_typ_name t in
+      (match in_env subregs reg_ti with
+        | Just indexes ->
+          (match in_env indexes (get_id subreg) with
+           | Just ir -> (Action (Read_reg (Form_SubReg subreg (Form_Reg reg annot' default_dir) ir) Nothing) stack,
+                         l_mem, l_env)
+           | _ -> (Error l "Internal error, alias spec has unknown field", l_mem, l_env) end)
+        | _ -> (Error l (String.stringAppend "Internal error: alias spec has unknown register type " reg_ti),
+                 l_mem, l_env) end)
+    | AL_bit (RI_aux (RI_id reg) (_,annot')) e ->
+      resolve_outcome (interp_main mode t_level l_env l_mem e)
+        (fun v le lm -> match v with
+          | V_lit (L_aux (L_num i) _) ->
+            let i = natFromInteger i in
+            (Action (Read_reg (Form_Reg reg annot' default_dir) (Just (i,i))) stack, l_mem, l_env)
+          | _ -> Assert_extra.failwith "alias bit did not reduce to number" end)
+        (fun a -> a) (*Should not currently happen as type system enforces constants*)
+    | AL_slice (RI_aux (RI_id reg) (_,annot')) start stop ->
+      resolve_outcome (interp_main mode t_level l_env l_mem start)
+        (fun v lm le ->
+          match v with
+            | V_lit (L_aux (L_num start) _) ->
+              (resolve_outcome
+                 (interp_main mode t_level l_env lm stop)
+                 (fun v le lm ->
+                   (match v with
+                     | V_lit (L_aux (L_num stop) _) ->
+                       let (start,stop) = (natFromInteger start,natFromInteger stop) in
+                       (Action (Read_reg (Form_Reg reg annot' default_dir) (Just (start,stop))) stack, l_mem, l_env)
+                     | _ -> Assert_extra.failwith ("Alias slice evaluted non-lit " ^ (string_of_value v))
+                     end))
+                 (fun a -> a))
+           | _ -> Assert_extra.failwith ("Alias slice evaluated non-lit "^ string_of_value v)
+         end)
+        (fun a -> a) (*Neither action function should occur, due to above*)
+    | AL_concat (RI_aux (RI_id reg1) (l1, annot1)) (RI_aux (RI_id reg2) annot2) ->
+      (Action (Read_reg (Form_Reg reg1 annot1 default_dir) Nothing)
+              (Hole_frame redex_id
+                          (E_aux (E_vector_append (E_aux (E_id redex_id) (l1, (intern_annot annot1)))
+                                                  (E_aux (E_id reg2) annot2))
+                                 (l,(intern_annot annot))) t_level l_env l_mem Top), l_mem,l_env)
+    | _ -> Assert_extra.failwith "alias spec not well formed"
+end
+
+and interp_alias_read mode t_level l_env l_mem al =
+  let _ = debug_fun_enter mode "interp_alias_read" [show al] in
+  let retval = __interp_alias_read (indent_mode mode) t_level l_env l_mem al in
+  let _ = debug_fun_exit mode "interp_alias_read" retval in
+  retval
+
+let rec eval_toplevel_let handle_action tlevel env mem lbind =
+  match interp_letbind <| eager_eval=true; track_values=false; track_lmem=false; debug=false; debug_indent="" |> tlevel env mem lbind with
+    | ((Value v, lm, (LEnv _ le)),_) -> Just le
+    | ((Action a s,lm,le), Just le_builder) ->
+      (match handle_action (Action a s) with
+        | Just value ->
+          (match s with
+            | Hole_frame id exp tl lenv lmem s ->
+              eval_toplevel_let handle_action tl (add_to_env (id,value) lenv) lmem (le_builder exp)
+            | _ -> Assert_extra.failwith "Top level def evaluation created a thunk frame" end)
+        | Nothing -> Nothing end)
+    | _ -> Nothing end
+
+let rec to_global_letbinds handle_action (Defs defs) t_level =
+  let  (Env fdefs instrs default_dir lets regs ctors subregs aliases debug) = t_level in
+  match defs with
+  | [] -> ((Value (V_lit (L_aux L_unit Unknown)), (emem "global_letbinds"), eenv),t_level)
+  | def::defs ->
+    match def with
+    | DEF_val lbind ->
+      match eval_toplevel_let handle_action t_level eenv (emem "global_letbinds") lbind with
+        | Just le ->
+          to_global_letbinds handle_action
+            (Defs defs)
+            (Env fdefs instrs default_dir (Map.(union) lets le) regs ctors subregs aliases debug)
+        | Nothing ->
+          to_global_letbinds handle_action (Defs defs)
+                                           (Env fdefs instrs default_dir lets regs ctors subregs aliases debug) end
+    | DEF_type (TD_aux tdef _) ->
+      match tdef with
+      | TD_enum id ns ids _ ->
+        let typ = mk_typ_id (get_id id) in
+        let enum_vals =
+          Map.fromList
+            (snd
+            (List.foldl (fun (c,rst) eid -> (1+c,(get_id eid,V_ctor eid typ (C_Enum c) unitv)::rst)) (0,[]) ids)) in
+        to_global_letbinds
+          handle_action (Defs defs)
+                        (Env fdefs instrs default_dir (Map.(union) lets enum_vals) regs ctors subregs aliases debug)
+      | _ -> to_global_letbinds handle_action (Defs defs) t_level end
+    | _ -> to_global_letbinds handle_action (Defs defs) t_level
+    end
+  end
+
+let rec extract_default_direction (Defs defs) = match defs with
+  | [] -> IInc (*When lack of a declared default, go for inc*)
+  | def::defs ->
+    match def with
+      | DEF_default (DT_aux (DT_order (Ord_aux Ord_inc _)) _) -> IInc
+      | DEF_default (DT_aux (DT_order (Ord_aux Ord_dec _)) _) -> IDec
+      | _ -> extract_default_direction (Defs defs) end end
+
+(*TODO Contemplate making execute environment variable instead of constant*)
+let to_top_env debug external_functions defs =
+  let direction = (extract_default_direction defs) in
+  let t_level = Env (to_fdefs defs)
+                    (extract_instructions "execute" defs)
+                    direction
+                    Map.empty (* empty letbind and enum values, call below will fill in any *)
+                    (to_registers direction defs)
+                    (to_data_constructors defs) (to_register_fields defs) (to_aliases defs) debug in
+  let (o,t_level) = to_global_letbinds (external_functions direction) defs t_level in
+  match o with
+    | (Value _,_,_) -> (Nothing,t_level)
+    | (o,_,_) -> (Just o,t_level)
+  end
+
+let __interp mode external_functions defs exp =
+  match (to_top_env mode.debug external_functions defs) with
+    | (Nothing,t_level) ->
+      interp_main mode t_level eenv (emem "top level") exp
+    | (Just o,_) -> (o,(emem "top level error"),eenv)
+  end
+
+let interp mode external_functions defs exp =
+  let _ = debug_fun_enter mode "interp" [show exp] in
+  let retval = __interp (indent_mode mode) external_functions defs exp in
+  let _ = debug_fun_exit mode "interp" retval in
+  retval
+
+let rec __resume_with_env mode stack value =
+  match (stack,value) with
+  | (Top,_) -> (Error Unknown "Top hit without expression to evaluate in resume_with_env",eenv)
+  | (Hole_frame id exp t_level env mem Top,Just value) ->
+    match interp_main mode t_level (add_to_env (id,value) env) mem exp with | (o,_,e) -> (o,e) end
+  | (Hole_frame id exp t_level env mem stack,Just value) ->
+    match resume_with_env mode stack (Just value) with
+    | (Value v,e) ->
+      match interp_main mode t_level (add_to_env (id,v) env) mem exp with | (o,_,e) -> (o,e) end
+    | (Action action stack,e) -> (Action action (Hole_frame id exp t_level env mem stack),e)
+    | (Error l s,e) -> (Error l s,e)
+    end
+  | (Hole_frame id exp t_level env mem stack, Nothing) ->
+    match resume_with_env mode stack Nothing with
+      | (Value v,e) ->
+        match interp_main mode t_level (add_to_env (id,v) env) mem exp with | (o,_,e) -> (o,e) end
+      | (Action action stack,e) -> (Action action (Hole_frame id exp t_level env mem stack),e)
+      | (Error l s,e) -> (Error l s,e)
+    end
+  | (Thunk_frame exp t_level env mem Top,_) ->
+    match interp_main mode t_level env mem exp with | (o,_,e) -> (o,e) end
+  | (Thunk_frame exp t_level env mem stack,value) ->
+    match resume_with_env mode stack value with
+    | (Value v,e) ->
+      match interp_main mode t_level env mem exp with | (o,_,e) -> (o,e) end
+    | (Action action stack,e) -> (Action action (Thunk_frame exp t_level env mem stack),e)
+    | (Error l s,e) -> (Error l s,e)
+    end
+  end
+
+and resume_with_env mode stack value =
+  let _ = debug_fun_enter mode "resume_with_env" [show value] in
+  let retval = __resume_with_env (indent_mode mode) stack value in
+  let _ = debug_fun_exit mode "interp" retval in
+  retval
+
+
+let rec __resume mode stack value =
+  match (stack,value) with
+  | (Top,_) -> (Error Unknown "Top hit without expression to evaluate in resume",(emem "top level error"),eenv)
+  | (Hole_frame id exp t_level env mem Top,Just value) ->
+    interp_main mode t_level (add_to_env (id,value) env) mem exp
+  | (Hole_frame id exp t_level env mem Top,Nothing) ->
+    (Error Unknown "Top hole frame hit wihtout a value in resume", mem, env)
+  | (Hole_frame id exp t_level env mem stack,Just value) ->
+    match resume mode stack (Just value) with
+    | (Value v,_,_) ->
+      interp_main mode t_level (add_to_env (id,v) env) mem exp
+    | (Action action stack,lm,le) -> (Action action (Hole_frame id exp t_level env mem stack),lm,le)
+    | (Error l s,lm,le) -> (Error l s,lm,le)
+    end
+  | (Hole_frame id exp t_level env mem stack, Nothing) ->
+    match resume mode stack Nothing with
+      | (Value v,_,_) ->
+        interp_main mode t_level (add_to_env (id,v) env) mem exp
+      | (Action action stack,lm,le) -> (Action action (Hole_frame id exp t_level env mem stack),lm,le)
+      | (Error l s,lm,le) -> (Error l s,lm,le)
+    end
+  | (Thunk_frame exp t_level env mem Top,_) ->
+    interp_main mode t_level env mem exp
+  | (Thunk_frame exp t_level env mem stack,value) ->
+    match resume mode stack value with
+    | (Value v,_,_) -> interp_main mode t_level env mem exp
+    | (Action action stack,lm,le) -> (Action action (Thunk_frame exp t_level env mem stack), lm, le)
+    | (Error l s,lm,le) -> (Error l s,lm,le)
+    end
+  end
+
+and resume mode stack value =
+  let _ = debug_fun_enter mode "resume" [show value] in
+  let retval = __resume (indent_mode mode) stack value in
+  let _ = debug_fun_exit mode "resume" retval in
+  retval
diff --git a/src/lem_interp/0.11/interp_inter_imp.lem b/src/lem_interp/0.11/interp_inter_imp.lem
new file mode 100644
index 00000000..3413494e
--- /dev/null
+++ b/src/lem_interp/0.11/interp_inter_imp.lem
@@ -0,0 +1,1338 @@
+(*========================================================================*)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(*========================================================================*)
+
+open import Interp_ast
+import Interp
+import Interp_lib
+import Instruction_extractor
+import Set_extra
+open import Pervasives
+open import Assert_extra
+open import Interp_ast
+open import Interp_utilities
+open import Sail_impl_base
+open import Interp_interface
+
+val intern_reg_value : register_value -> Interp_ast.value
+val intern_mem_value : interp_mode -> direction -> memory_value -> Interp_ast.value
+val extern_reg_value : reg_name -> Interp_ast.value -> register_value
+val extern_with_track: forall 'a. interp_mode -> (Interp_ast.value -> 'a) -> Interp_ast.value -> ('a * maybe (list reg_name))
+val extern_vector_value: Interp_ast.value -> list byte_lifted
+val extern_mem_value :   Interp_ast.value -> memory_value
+val extern_reg : Interp_ast.reg_form -> maybe (nat * nat) -> reg_name
+
+let make_interpreter_mode eager_eval tracking_values debug =
+  <| Interp.eager_eval = eager_eval; Interp.track_values = tracking_values; Interp.track_lmem = false; Interp.debug = debug; Interp.debug_indent = "" |>;;
+
+let make_mode eager_eval tracking_values debug =
+  <| internal_mode = make_interpreter_mode eager_eval tracking_values debug |>;;
+let make_mode_exhaustive debug =
+  <| internal_mode = <| Interp.eager_eval = true; Interp.track_values = true; Interp.track_lmem = true; Interp.debug = debug; Interp.debug_indent = "" |> |>;;
+let tracking_dependencies mode = mode.internal_mode.Interp.track_values
+let make_eager_mode mode = <| internal_mode = <| mode.internal_mode with Interp.eager_eval = true |> |>;;
+let make_default_mode = fun () -> <| internal_mode = make_interpreter_mode false false false |>;;
+
+let bitl_to_ibit = function 
+  | Bitl_zero -> (Interp_ast.V_lit (L_aux L_zero Interp_ast.Unknown)) 
+  | Bitl_one ->  (Interp_ast.V_lit (L_aux L_one Interp_ast.Unknown))
+  | Bitl_undef -> (Interp_ast.V_lit (L_aux L_undef Interp_ast.Unknown))
+  | Bitl_unknown -> Interp_ast.V_unknown
+end
+
+let bit_to_ibit = function
+  | Bitc_zero -> (Interp_ast.V_lit (L_aux L_zero Interp_ast.Unknown))
+  | Bitc_one -> (Interp_ast.V_lit (L_aux L_one Interp_ast.Unknown))
+end
+
+let to_bool = function 
+  | Bitl_zero -> false
+  | Bitl_one ->  true
+  | Bitl_undef -> Assert_extra.failwith "to_bool given undef"
+  | Bitl_unknown -> Assert_extra.failwith "to_bool given unknown"
+end
+
+let is_bool = function 
+  | Bitl_zero -> true
+  | Bitl_one ->  true
+  | Bitl_undef -> false
+  | Bitl_unknown -> false
+end
+
+let bitl_from_ibit b = 
+    let b = Interp.detaint b in
+    match b with
+    | Interp_ast.V_lit (L_aux L_zero _) -> Bitl_zero
+    | Interp_ast.V_vector _ _ [Interp_ast.V_lit (L_aux L_zero _)] -> Bitl_zero
+    | Interp_ast.V_lit (L_aux L_one _)  -> Bitl_one
+    | Interp_ast.V_vector _ _ [Interp_ast.V_lit (L_aux L_one _)] -> Bitl_one
+    | Interp_ast.V_lit (L_aux L_undef _) -> Bitl_undef
+    | Interp_ast.V_vector _ _ [Interp_ast.V_lit (L_aux L_undef _)] -> Bitl_undef
+    | Interp_ast.V_unknown -> Bitl_unknown
+    | _ -> Assert_extra.failwith ("bit_from_ibit given unexpected " ^ (Interp.string_of_value b)) end
+
+let bits_to_ibits l = List.map bit_to_ibit l
+let bitls_to_ibits l = List.map bitl_to_ibit l
+let bitls_from_ibits l = List.map bitl_from_ibit l
+
+let bits_from_ibits l = List.map 
+  (fun b -> 
+    let b = Interp.detaint b in
+    match b with
+    | Interp_ast.V_lit (L_aux L_zero _) -> Bitc_zero
+    | Interp_ast.V_vector _ _ [Interp_ast.V_lit (L_aux L_zero _)] -> Bitc_zero
+    | Interp_ast.V_lit (L_aux L_one _)  -> Bitc_one
+    | Interp_ast.V_vector _ _ [Interp_ast.V_lit (L_aux L_one _)] -> Bitc_one
+    | _ -> Assert_extra.failwith ("bits_from_ibits given unexpected " ^ (Interp.string_of_value b))
+   end) l
+
+let rec to_bytes l = match l with
+  | [] -> []
+  | (a::b::c::d::e::f::g::h::rest) -> (Byte_lifted[a;b;c;d;e;f;g;h])::(to_bytes rest)
+  | _ -> Assert_extra.failwith "to_bytes given list of bits not divisible by 8"
+end 
+
+let all_known l = List.all is_bool l
+let all_known_bytes l = List.all (fun (Byte_lifted bs) -> List.all is_bool bs) l
+
+let bits_to_word8 b = 
+  if ((List.length b) = 8) && (all_known b)
+  then natFromInteger (integerFromBoolList (false,(List.reverse (List.map to_bool b))))
+  else Assert_extra.failwith "bits_to_word8 given a non-8 list or one containing ? and u"
+
+let intern_direction = function
+  | D_increasing -> Interp_ast.IInc
+  | D_decreasing -> Interp_ast.IDec
+end
+
+let extern_direction = function
+  | Interp_ast.IInc -> D_increasing
+  | Interp_ast.IDec -> D_decreasing
+end
+
+let intern_opcode direction (Opcode v) =
+  let bits = List.concatMap (fun (Byte(bits)) -> (List.map bit_to_ibit bits)) v in
+  let direction = intern_direction direction in
+  Interp_ast.V_vector (if Interp.is_inc(direction) then 0 else (List.length(bits) - 1)) direction bits
+                   
+let intern_reg_value v = match v with
+  | <| rv_bits=[b] |> -> bitl_to_ibit b
+  | _ -> Interp_ast.V_vector v.rv_start_internal (intern_direction v.rv_dir) (bitls_to_ibits v.rv_bits)
+end
+
+let intern_mem_value mode direction v =
+  List.reverse v (* match little endian representation *)
+  $> List.concatMap (fun (Byte_lifted bits) -> bitls_to_ibits bits)
+  $> fun bits ->
+  let direction = intern_direction direction in
+  Interp_ast.V_vector (if Interp.is_inc direction then 0 else (List.length bits) -1) direction bits
+
+let intern_ifield_value direction v =
+  let bits = bits_to_ibits v in
+  let direction = intern_direction direction in
+  Interp_ast.V_vector (if Interp.is_inc direction then 0 else (List.length(bits) -1)) direction bits
+
+let extern_slice (d:direction) (start:nat) ((i,j):(nat*nat)) =
+  match d with
+    | D_increasing -> (i,j) (*This is the case the thread/concurrecny model expects, so no change needed*)
+    | D_decreasing ->
+      let slice_i = start - i in
+      let slice_j = (i - j) + slice_i in
+      (slice_i,slice_j)
+   end 
+
+let extern_reg r slice = match (r,slice) with
+  | (Interp_ast.Form_Reg (Id_aux (Id x) _) (Just(t,_,_,_,_)) dir,Nothing) -> 
+    Reg x (Interp.reg_start_pos r) (Interp.reg_size r) (extern_direction dir)
+  | (Interp_ast.Form_Reg (Id_aux (Id x) _) (Just(t,_,_,_,_)) dir,Just(i1,i2)) -> 
+    let start = Interp.reg_start_pos r in
+    let edir = extern_direction dir in
+    Reg_slice x start edir (extern_slice edir start (i1, i2))
+  | (Interp_ast.Form_SubReg (Id_aux (Id x) _) ((Interp_ast.Form_Reg (Id_aux (Id y) _) _ dir) as main_r) (BF_aux(BF_single i) _),
+     Nothing) -> 
+    let i = natFromInteger i in
+    let start = Interp.reg_start_pos main_r in
+    let edir = extern_direction dir in
+    Reg_field y start edir x (extern_slice edir start (i,i))
+  | (Interp_ast.Form_SubReg (Id_aux (Id x) _) ((Interp_ast.Form_Reg (Id_aux (Id y) _) _ dir) as main_r) (BF_aux(BF_range i j) _),
+     Nothing) -> 
+    let start = Interp.reg_start_pos main_r in
+    let edir = extern_direction dir in
+    Reg_field y start edir x (extern_slice edir start (natFromInteger i,natFromInteger j))
+  | (Interp_ast.Form_SubReg (Id_aux (Id x) _) 
+       ((Interp_ast.Form_Reg (Id_aux (Id y) _) _ dir) as main_r) (BF_aux(BF_range i j) _), Just(i1,j1)) ->
+    let start = Interp.reg_start_pos main_r in
+    let edir = extern_direction dir in
+    Reg_f_slice y start edir x (extern_slice edir start (natFromInteger i,natFromInteger j)) 
+      (extern_slice edir start (i1, j1))
+  | _ -> Assert_extra.failwith "extern_reg given non-externable reg" 
+end
+
+let rec extern_reg_value reg_name v = 
+  match v with
+    | Interp_ast.V_track v regs -> extern_reg_value reg_name v 
+    | Interp_ast.V_vector_sparse fst stop inc bits default ->
+      extern_reg_value reg_name (Interp_lib.fill_in_sparse v)
+    | _ ->
+      let (internal_start, external_start, direction) =
+        (match reg_name with
+          | Reg _ start size dir ->
+            (start, (if dir = D_increasing then start else (start - (size +1))), dir)
+          | Reg_slice _ reg_start dir (slice_start, slice_end) ->
+            ((if dir = D_increasing then slice_start else (reg_start - slice_start)),
+             slice_start, dir)
+          | Reg_field _ reg_start dir _ (slice_start, slice_end) ->
+            ((if dir = D_increasing then slice_start else (reg_start - slice_start)),
+             slice_start, dir)
+          | Reg_f_slice _ reg_start dir _ _ (slice_start, slice_end) ->
+            ((if dir = D_increasing then slice_start else (reg_start - slice_start)),
+             slice_start, dir) end) in
+      let bit_list = 
+        (match v with 
+          | Interp_ast.V_vector fst dir bits -> bitls_from_ibits bits
+          | Interp_ast.V_lit (L_aux L_zero _) -> [Bitl_zero]
+          | Interp_ast.V_lit (L_aux L_false _) -> [Bitl_zero]
+          | Interp_ast.V_lit (L_aux L_one _) -> [Bitl_one]
+          | Interp_ast.V_lit (L_aux L_true _) -> [Bitl_one]
+          | Interp_ast.V_lit (L_aux L_undef _) -> [Bitl_undef]
+          | Interp_ast.V_unknown -> [Bitl_unknown]
+          | _ -> Assert_extra.failwith ("extern_reg_val given non externable value " ^ (Interp.string_of_value v)) end)
+     in
+      <| rv_bits=bit_list; 
+         rv_dir=direction;
+         rv_start=external_start;
+         rv_start_internal = internal_start |>
+end 
+
+let extern_with_track mode f = function
+  | Interp_ast.V_track v regs ->
+    (f v,
+     if mode.internal_mode.Interp.track_values
+     then (Just (List.map (fun r -> extern_reg r Nothing) (Set_extra.toList regs)))
+     else Nothing)
+  | v -> (f v, Nothing)
+  end
+
+let rec extern_vector_value v = match v with
+  | Interp_ast.V_vector _fst _inc bits ->
+    bitls_from_ibits bits
+    $> to_bytes
+  | Interp_ast.V_vector_sparse _fst _stop _inc _bits _default ->
+    Interp_lib.fill_in_sparse v
+    $> extern_vector_value
+  | Interp_ast.V_track v _ -> extern_vector_value v
+  | _ -> Assert_extra.failwith ("extern_vector_value received non-externable value " ^ (Interp.string_of_value v))
+end
+
+let rec extern_mem_value v = List.reverse (extern_vector_value v)
+
+
+let rec extern_ifield_value i_name field_name v ftyp = match (v,ftyp) with
+  | (Interp_ast.V_track v regs,_) -> extern_ifield_value i_name field_name v ftyp
+  | (Interp_ast.V_vector fst inc bits,_) -> bits_from_ibits bits
+  | (Interp_ast.V_vector_sparse fst stop inc bits default,_) ->
+    extern_ifield_value i_name field_name (Interp_lib.fill_in_sparse v) ftyp
+  | (Interp_ast.V_lit (L_aux L_zero _),_) -> [Bitc_zero]
+  | (Interp_ast.V_lit (L_aux L_false _),_) -> [Bitc_zero]
+  | (Interp_ast.V_lit (L_aux L_one _),_) ->  [Bitc_one]
+  | (Interp_ast.V_lit (L_aux L_true _),_) -> [Bitc_one]
+  | (Interp_ast.V_lit (L_aux (L_num i) _),Range (Just n)) -> bit_list_of_integer n i
+  | (Interp_ast.V_lit (L_aux (L_num i) _),Enum _ n) -> bit_list_of_integer n i
+  | (Interp_ast.V_lit (L_aux (L_num i) _),_) -> bit_list_of_integer 64 i
+  | (Interp_ast.V_ctor _ _ (Interp_ast.C_Enum i) _,Enum _ n) -> bit_list_of_integer n (integerFromNat i)
+  | (Interp_ast.V_ctor _ _ (Interp_ast.C_Enum i) _,_) -> bit_list_of_integer 64 (integerFromNat i)
+  | _ ->
+    Assert_extra.failwith ("extern_ifield_value of " ^ i_name ^ " for field " ^ field_name
+                           ^ " given non-externable " ^ (Interp.string_of_value v) ^ " ftyp is " ^ show ftyp)
+end 
+
+let rec slice_reg_value v start stop =
+(*  let _ = Interp.debug_print ("slice_reg_value " ^ show v.rv_start_internal ^ " " ^ show v.rv_start ^ " " ^ show start ^ " " ^ show stop) in*)
+  let inc = v.rv_dir = D_increasing in
+  let r_internal_start = if inc then start else (stop - start) + 1 in
+  let r_start = if inc then r_internal_start else start in
+(*  let _ = Interp.debug_print (" " ^ " " ^ if inc then "Inc " else "dec " ^ show (List.length (Interp.from_n_to_n
+                         (if inc then (start - v.rv_start_internal) else (v.rv_start_internal - start))
+                         (if inc then (stop - v.rv_start_internal) else (v.rv_start_internal - stop)) v.rv_bits)) ^ " " ^ show (List.length v.rv_bits) ^ " " ^ show (v.rv_start_internal - start) ^ " " ^ show (v.rv_start_internal - stop) ^ "\n") in*)
+  <| v with rv_bits = (Interp.from_n_to_n (start - v.rv_start) (stop - v.rv_start) v.rv_bits);
+            rv_start = r_start;
+            rv_start_internal = r_internal_start
+  |> 
+
+let lift_reg_name_to_whole reg_name size = match reg_name with
+  | Reg _ _ _ _ -> reg_name
+  | Reg_slice name start dir _ -> Reg name start size dir
+  | Reg_field name start dir _ _ -> Reg name start size dir
+  | Reg_f_slice name start dir _ _ _ -> Reg name start size dir
+end
+
+let update_reg_value_slice reg_name v start stop v2 =
+  let v_internal = intern_reg_value v in
+  let v2_internal = intern_reg_value v2 in
+  <| (extern_reg_value (lift_reg_name_to_whole reg_name 0)
+        (if start = stop then
+           (Interp.fupdate_vec v_internal start v2_internal)
+         else
+           (Interp.fupdate_vector_slice v_internal v2_internal start stop)))
+      with rv_start = v.rv_start; rv_start_internal = v.rv_start_internal |>
+
+(*TODO: Only find some sub piece matches, need to look for field/slice sub pieces*)
+(*TODO immediate: this will be impacted by need to change slicing *)
+let rec find_reg_name reg = function
+  | [] -> Nothing
+  | (reg_name,v)::registers ->
+    match (reg,reg_name) with
+      | (Reg i start size dir, Reg n start2 size2 dir2) -> 
+        if i = n && size = size2 then (Just v) else find_reg_name reg registers
+      | (Reg_slice i _ _ (p1,p2), Reg n _ _ _) -> 
+        if i = n then (Just (slice_reg_value v p1 p2)) else find_reg_name reg registers
+      | (Reg_field i _ _ f (p1,p2), Reg n _ _ _) ->
+(*        let _ = Interp.debug_print ("find_reg_name " ^ i ^ " field case " ^ show p1 ^ " " ^ show p2 ^ "\n") in*)
+        if i = n then (Just (slice_reg_value v p1 p2)) else find_reg_name reg registers
+      | (Reg_slice  i _ _ (p1,p2), Reg_slice n _ _ (p3,p4)) ->
+        if i=n 
+        then if p1=p3 && p2 = p4 then (Just v)
+             else if p1>=p3 && p2<= p4 then (Just (slice_reg_value v p1 p2))
+             else find_reg_name reg registers
+          else find_reg_name reg registers
+      | (Reg_field i _ _ f _,Reg_field n _ _ fn _) ->
+        if i=n && f = fn then (Just v) else find_reg_name reg registers
+      | (Reg_f_slice i _ _ f _ (p1,p2), Reg_f_slice n _ _ fn _ (p3,p4)) ->
+        if i=n && f=fn && p1=p3 && p2=p3 then (Just v) else find_reg_name reg registers
+      | _ -> find_reg_name reg registers
+end end
+
+
+let initial_instruction_state top_level main args = 
+  let e_args = match args with
+    | [] -> [E_aux (E_lit (L_aux L_unit Interp_ast.Unknown)) (Interp_ast.Unknown,Nothing)]
+    | [arg] -> let (e,_) = Interp.to_exp (make_interpreter_mode true false) Interp.eenv (intern_reg_value arg) in [e]
+    | args -> List.map fst (List.map (Interp.to_exp (make_interpreter_mode true false) Interp.eenv)
+                              (List.map intern_reg_value args)) end in
+  Interp.Thunk_frame (E_aux (E_app (Id_aux (Id main) Interp_ast.Unknown) e_args) (Interp_ast.Unknown, Nothing)) 
+    top_level Interp.eenv (Interp.emem "istate top level") Interp.Top
+
+type interp_value_helper_mode = Ivh_translate | Ivh_decode | Ivh_unsupported | Ivh_illegal | Ivh_analysis
+type interp_value_return =
+  | Ivh_value of Interp_ast.value
+  | Ivh_value_after_exn of Interp_ast.value
+  | Ivh_error of decode_error
+
+let rec interp_to_value_helper debug arg ivh_mode err_str instr direction registers events exn_seen thunk =
+  let errk_str = match ivh_mode with
+    | Ivh_translate -> "translate"
+    | Ivh_analysis -> "analysis"
+    | Ivh_decode -> "decode"
+    | Ivh_unsupported -> "supported_instructions"
+    | Ivh_illegal -> "illegal instruction" end in
+  let events_out = match events with [] -> Nothing | _ -> Just events end in
+  let mode = (make_interpreter_mode true false debug) in
+  match thunk() with
+    | (Interp.Value value,_,_) ->
+      if exn_seen
+      then (Ivh_value_after_exn value, events_out)
+      else
+        (match ivh_mode with
+         | Ivh_translate -> (Ivh_value value, events_out)
+         | Ivh_analysis -> (Ivh_value value, events_out)
+         | _ ->
+           (match value with
+            | Interp_ast.V_ctor (Id_aux (Id "Some") _) _ _ vinstr -> (Ivh_value vinstr,events_out)
+            | Interp_ast.V_ctor (Id_aux (Id "None") _) _ _ _ ->
+              (match (ivh_mode,arg) with
+               | (Ivh_decode, (Just arg)) -> (Ivh_error (Interp_interface.Not_an_instruction_error arg), events_out)
+               | (Ivh_illegal, (Just arg)) -> (Ivh_error (Interp_interface.Not_an_instruction_error arg), events_out)
+               | (Ivh_unsupported, _) -> (Ivh_error (Interp_interface.Unsupported_instruction_error instr), events_out)
+               | _ -> Assert_extra.failwith "Reached unreachable pattern" end)
+            | _ -> (Ivh_error (Interp_interface.Internal_error ("Value not an option for " ^ errk_str)), events_out) end) end)
+    | (Interp.Error l msg,_,_) -> (Ivh_error (Interp_interface.Internal_error msg), events_out)
+    | (Interp.Action (Interp.Return value) stack,_,_) ->
+      interp_to_value_helper debug arg ivh_mode err_str instr direction registers events exn_seen
+        (fun _ -> Interp.resume mode stack (Just value))
+    | (Interp.Action (Interp.Call_extern i value) stack,_,_) ->
+      match List.lookup i (Interp_lib.library_functions direction) with
+        | Nothing -> (Ivh_error (Interp_interface.Internal_error ("External function not available " ^ i)), events_out)
+        | Just f  ->
+          interp_to_value_helper debug arg ivh_mode err_str instr direction registers events exn_seen
+                                 (fun _ -> Interp.resume mode stack (Just (f value)))
+      end
+    | (Interp.Action (Interp.Fail v) stack, _, _) ->
+      match (Interp.detaint v) with
+      | Interp_ast.V_ctor (Id_aux (Id "Some") _) _ _ (Interp_ast.V_lit (L_aux (L_string s) _)) ->
+        (Ivh_error (Interp_interface.Internal_error ("Assert failed: " ^ s)), events_out)
+      | _ -> (Ivh_error (Interp_interface.Internal_error "Assert failed"), events_out) end
+    | (Interp.Action (Interp.Exit exp) stack,_,_) ->
+      interp_to_value_helper debug arg ivh_mode err_str instr direction registers events true
+        (fun _ -> Interp.resume mode (Interp.set_in_context stack exp) Nothing)
+    | (Interp.Action (Interp.Read_reg r slice) stack,_,_) ->
+      let rname = match r with 
+        | Interp_ast.Form_Reg (Id_aux (Id i) _) _ _ -> i
+        | Interp_ast.Form_SubReg (Id_aux (Id i) _) (Interp_ast.Form_Reg (Id_aux (Id i2) _) _ _) _ -> i2 ^ "." ^ i
+        | _ -> Assert_extra.failwith "Reg not following expected structure" end in
+      let err_value =
+        (Ivh_error (Interp_interface.Internal_error ("Register read of "^ rname^" request in a " ^ errk_str ^ " of " ^ err_str)),
+        events_out) in
+      (match registers with
+        | Nothing -> err_value
+        | Just(regs) ->
+          let reg = extern_reg r slice in
+          match find_reg_name reg regs with
+            | Nothing -> err_value
+            | Just v ->
+              let value = intern_reg_value v in
+(*              let _ = Interp.debug_print ("Register read of " ^ rname ^ " returning value " ^ (Interp.string_of_value value) ^ "\n") in *)
+              interp_to_value_helper debug arg ivh_mode err_str instr direction registers events exn_seen
+                (fun _ -> Interp.resume mode stack (Just value)) end end)      
+    | (Interp.Action (Interp.Write_reg r slice value) stack,_,_) ->
+      let ext_reg = extern_reg r slice in
+      let reg_value = extern_reg_value ext_reg value in
+      interp_to_value_helper debug arg ivh_mode err_str instr direction registers ((E_write_reg ext_reg reg_value)::events)
+        exn_seen (fun _ -> Interp.resume mode stack Nothing)
+    | (Interp.Action (Interp.Read_mem _ _ _) _,_,_) ->
+      (Ivh_error (Interp_interface.Internal_error ("Read memory request in a " ^ errk_str)), events_out)
+    | (Interp.Action (Interp.Read_mem_tagged _ _ _) _,_,_) ->
+      (Ivh_error (Interp_interface.Internal_error ("Read memory tagged request in a " ^ errk_str)), events_out)
+    | (Interp.Action (Interp.Write_mem _ _ _ _) _,_,_) ->
+      (Ivh_error (Interp_interface.Internal_error ("Write memory request in a " ^ errk_str)), events_out)
+    | (Interp.Action (Interp.Write_ea _ _) _,_,_) ->
+      (Ivh_error (Interp_interface.Internal_error ("Write ea request in a " ^ errk_str)), events_out)
+    | (Interp.Action (Interp.Excl_res _) _,_,_) ->
+      (Ivh_error (Interp_interface.Internal_error ("Exclusive result request in a " ^ errk_str)), events_out)
+    | (Interp.Action (Interp.Write_memv _ _ _) _,_,_) ->
+      (Ivh_error (Interp_interface.Internal_error ("Write memory value request in a " ^ errk_str)), events_out)
+    | (Interp.Action (Interp.Write_memv_tagged _ _ _ _) _,_,_) ->
+      (Ivh_error (Interp_interface.Internal_error ("Write memory value tagged request in a " ^ errk_str)), events_out)
+    | (outcome, _, _) ->
+       (Ivh_error (Interp_interface.Internal_error ("Non expected action in a " ^ errk_str ^ " " ^ Interp.string_of_outcome outcome)), events_out)
+end
+
+let call_external_functions direction outcome = 
+  match outcome with
+    | Interp.Action (Interp.Call_extern i value) stack ->
+      match List.lookup i (Interp_lib.library_functions direction) with
+        | Nothing -> Nothing
+        | Just f -> Just (f value) end
+    | _ -> Nothing end
+
+let build_context debug defs reads writes write_eas write_vals barriers excl_res externs =
+  (*TODO add externs to to_top_env*)
+  match Interp.to_top_env debug call_external_functions defs with 
+    | (_,((Interp.Env _ _ dir _ _ _ _ _ debug) as context)) -> 
+      Context context (if Interp.is_inc(dir) then D_increasing else D_decreasing)
+        reads writes write_eas write_vals barriers excl_res externs end
+
+
+let translate_address top_level end_flag thunk_name registers address =
+  let (Address bytes i) = address in
+  let (Context top_env direction _ _ _ _ _ _ _ _ _) = top_level in
+  let (Interp.Env _ _ _ _ _ _ _ _ debug) = top_env in
+  let mode = make_mode true false debug in
+  let int_mode = mode.internal_mode in
+  let intern_val = intern_mem_value mode direction (memory_value_of_address end_flag address) in
+  let val_str = Interp.string_of_value intern_val in
+  let (arg,_) = Interp.to_exp int_mode Interp.eenv intern_val in
+  let internal_direction = if direction = D_increasing then Interp_ast.IInc else Interp_ast.IDec in
+  let (address_error,events) =
+    interp_to_value_helper debug (Just (Opcode bytes)) Ivh_translate val_str (V_list []) internal_direction
+      registers [] false
+      (fun _ -> Interp.resume 
+        int_mode 
+        (Interp.Thunk_frame 
+         (E_aux (E_app (Id_aux (Id thunk_name) Interp_ast.Unknown) [arg])
+            (Interp_ast.Unknown, Nothing)) 
+         top_env Interp.eenv (Interp.emem "translate top level") Interp.Top) Nothing) in
+  match (address_error) with
+  | Ivh_value addr ->
+    (address_of_byte_lifted_list (extern_vector_value addr), events)
+  | Ivh_value_after_exn _ ->
+    (Nothing, events)
+  | Ivh_error err -> match err with
+     | Interp_interface.Internal_error msg -> Assert_extra.failwith msg
+     | _ -> Assert_extra.failwith "Not an internal error either" end 
+end
+
+let value_of_instruction_param direction (name,typ,v) = 
+  let vec = intern_ifield_value direction v in
+  let v = match vec with
+    | Interp_ast.V_vector start dir bits ->
+      match typ with
+      | Bit -> match bits with | [b] -> b | _ -> Assert_extra.failwith "Expected a bitvector of length 1" end
+      | Range _ -> Interp_lib.to_num Interp_lib.Unsigned vec
+      | Enum _ _ -> Interp_lib.to_num Interp_lib.Unsigned vec
+      | _ -> vec
+    end 
+    | _ -> Assert_extra.failwith "intern_ifield did not return vector"
+  end in v
+
+let intern_instruction direction (name,parms) =
+  Interp_ast.V_ctor (Interp.id_of_string name) (mk_typ_id "ast") Interp_ast.C_Union
+    (Interp_ast.V_tuple (List.map (value_of_instruction_param direction) parms))
+
+let instruction_analysis top_level end_flag thunk_name regn_to_reg_details registers (instruction : Interp_ast.value) =
+  let (Context top_env direction _ _ _ _ _ _ _ _ _) = top_level in
+  let (Interp.Env _ _ _ _ _ _ _ _ debug) = top_env in
+  let mode = make_mode true false debug in
+  let int_mode = mode.internal_mode in
+  let val_str = Interp.string_of_value instruction in
+  let (arg,_) = Interp.to_exp int_mode Interp.eenv instruction in
+  let internal_direction = if direction = D_increasing then Interp_ast.IInc else Interp_ast.IDec in
+  let (analysis_or_error,events) =
+    interp_to_value_helper debug Nothing Ivh_analysis val_str (V_list []) internal_direction
+      registers [] false
+      (fun _ -> Interp.resume 
+        int_mode 
+        (Interp.Thunk_frame 
+         (E_aux (E_app (Id_aux (Id thunk_name) Interp_ast.Unknown) [arg])
+            (Interp_ast.Unknown, Nothing)) 
+         top_env Interp.eenv (Interp.emem "instruction analysis top level") Interp.Top) Nothing) in
+  match (analysis_or_error) with
+  | Ivh_value analysis ->
+    (match analysis with
+     | Interp_ast.V_tuple [Interp_ast.V_list regs1;
+                       Interp_ast.V_list regs2;
+                       Interp_ast.V_list regs3;
+                       Interp_ast.V_list nias;
+                       dia;
+                       ik] ->
+       let reg_to_reg_name v = match v with
+         | Interp_ast.V_ctor (Id_aux (Id "RFull") _) _ _ (Interp_ast.V_lit (L_aux (L_string n) _)) ->
+           let (start,length,direction,_) = regn_to_reg_details n Nothing in
+           Reg n start length direction
+         | Interp_ast.V_ctor (Id_aux (Id "RSlice") _) _ _
+             (Interp_ast.V_tuple [Interp_ast.V_lit (L_aux (L_string n) _);
+                              Interp_ast.V_lit (L_aux (L_num s1) _);
+                              Interp_ast.V_lit (L_aux (L_num s2) _);]) ->
+           let (start,length,direction,_) = regn_to_reg_details n Nothing in
+           Reg_slice n start direction (extern_slice direction start (natFromInteger s1, natFromInteger s2))
+                                       (*Note, this may need to change order depending on the direction*)
+         | Interp_ast.V_ctor (Id_aux (Id "RSliceBit") _) _ _
+             (Interp_ast.V_tuple [Interp_ast.V_lit (L_aux (L_string n) _);
+                              Interp_ast.V_lit (L_aux (L_num s) _);]) ->
+           let (start,length,direction,_) = regn_to_reg_details n Nothing in
+           Reg_slice n start direction (extern_slice direction start (natFromInteger s,natFromInteger s))
+         | Interp_ast.V_ctor (Id_aux (Id "RField") _) _ _
+             (Interp_ast.V_tuple [Interp_ast.V_lit (L_aux (L_string n) _);
+                              Interp_ast.V_lit (L_aux (L_string f) _);]) ->
+           let (start,length,direction,span) = regn_to_reg_details n (Just f) in
+           Reg_field n start direction f (extern_slice direction start span)             
+         | _ -> Assert_extra.failwith "Register footprint analysis did not return an element of the specified type" end
+       in
+       let get_addr v = match address_of_byte_lifted_list (extern_vector_value v) with
+         | Just addr -> addr
+         | Nothing -> failwith "get_nia encountered invalid address" end in
+       let dia_to_dia = function
+         | Interp_ast.V_ctor (Id_aux (Id "DIAFP_none") _) _ _ _ -> DIA_none
+         | Interp_ast.V_ctor (Id_aux (Id "DIAFP_concrete") _) _ _ address ->
+            DIA_concrete_address (get_addr address)
+         | Interp_ast.V_ctor (Id_aux (Id "DIAFP_reg") _) _ _ reg -> DIA_register (reg_to_reg_name reg) 
+         | _ -> failwith "Register footprint analysis did not return dia of expected type" end in
+       let nia_to_nia = function
+         | Interp_ast.V_ctor (Id_aux (Id "NIAFP_successor") _) _ _ _ -> NIA_successor
+         | Interp_ast.V_ctor (Id_aux (Id "NIAFP_concrete_address") _) _ _ address ->
+            NIA_concrete_address (get_addr address)
+         | Interp_ast.V_ctor (Id_aux (Id "NIAFP_indirect_address") _) _ _ _ ->
+            NIA_indirect_address
+         | _ -> failwith "Register footprint analysis did not return nia of expected type" end in
+       let (regs1,regs2,regs3,nias,dia,ik) =
+         (List.map reg_to_reg_name regs1,
+          List.map reg_to_reg_name regs2,
+          List.map reg_to_reg_name regs3,
+          List.map nia_to_nia nias,
+          dia_to_dia dia,
+          fromInterpValue ik) in
+       ((regs1,regs2,regs3,nias,dia,ik), events)
+     | _ -> Assert_extra.failwith "Analysis did not return a four-tuple of lists" end)
+  | Ivh_value_after_exn _ -> Assert_extra.failwith "Instruction analysis failed"
+  | Ivh_error err -> match err with
+     | Interp_interface.Internal_error msg -> Assert_extra.failwith msg
+     | _ -> Assert_extra.failwith "Not an internal error either" end 
+end
+
+let rec find_instruction i = function
+  | [] -> Nothing
+  | Instruction_extractor.Skipped::instrs -> find_instruction i instrs
+  | ((Instruction_extractor.Instr_form name parms effects) as instr)::instrs ->
+      if i = name
+      then Just instr
+      else find_instruction i instrs
+end
+
+let migrate_typ = function
+  | Instruction_extractor.IBit -> Bit
+  | Instruction_extractor.IBitvector len -> Bvector len  
+  | Instruction_extractor.IRange len -> Range len
+  | Instruction_extractor.IEnum s max -> Enum s max
+  | Instruction_extractor.IOther -> Other
+end
+
+
+let interp_value_to_instr_external top_level instr = 
+  let (Context (Interp.Env _ instructions _ _ _ _ _ _ debug) _ _ _ _ _ _ _ _ _ _) = top_level in
+  match instr with
+  | Interp_ast.V_ctor (Id_aux (Id i) _) _ _ parm ->
+     match (find_instruction i instructions) with
+     | Just(Instruction_extractor.Instr_form name parms effects) -> 
+        match (parm,parms) with
+        | (Interp_ast.V_lit (L_aux L_unit _),[]) -> (name, [])
+        | (value,[(p_name,ie_typ)]) -> 
+           let t = migrate_typ ie_typ in
+           (name, [(p_name,t, (extern_ifield_value name p_name value t))])
+        | (Interp_ast.V_tuple vals,parms) -> 
+           (name, 
+            (Interp_utilities.map2 (fun value (p_name,ie_typ) -> 
+                 let t = migrate_typ ie_typ in
+                 (p_name,t,(extern_ifield_value name p_name value t))) vals parms))
+        | _ -> Assert_extra.failwith "decoded instruction doesn't match expectation"
+        end
+     | _ -> Assert_extra.failwith ("failed to find instruction " ^ i) 
+     end
+  | _ -> Assert_extra.failwith "decoded instruction not a constructor" 
+  end
+
+
+let decode_to_instruction top_level registers value : instruction_or_decode_error = 
+  let (Context ((Interp.Env _ instructions _ _ _ _ _ _ debug) as top_env) direction _ _ _ _ _ _ _ _ _) = top_level in
+  let mode = make_interpreter_mode true false debug in
+  let intern_val = intern_opcode direction value in
+  let val_str = Interp.string_of_value intern_val in
+  let (arg,_) = Interp.to_exp mode Interp.eenv intern_val in
+  let internal_direction = if direction = D_increasing then Interp_ast.IInc else Interp_ast.IDec in
+  let (instr_decoded_error,events) =
+    interp_to_value_helper debug (Just value) Ivh_decode val_str (V_list []) internal_direction registers [] false
+      (fun _ -> Interp.resume 
+          mode 
+          (Interp.Thunk_frame 
+             (E_aux (E_app (Id_aux (Id "decode") Interp_ast.Unknown) [arg]) (Interp_ast.Unknown, Nothing)) 
+             top_env Interp.eenv (Interp.emem "decode top level") Interp.Top) Nothing) in
+  match (instr_decoded_error) with
+    | Ivh_value instr -> 
+       (* let instr_external = interp_value_to_instr_external top_level instr in*) 
+      let (instr_decoded_error,events) =
+        interp_to_value_helper debug (Just value) Ivh_unsupported val_str instr (*instr_external*) internal_direction
+          registers [] false
+        (fun _ -> Interp.resume 
+            mode
+            (Interp.Thunk_frame 
+               (E_aux (E_app (Id_aux (Id "supported_instructions") Interp_ast.Unknown) [arg]) 
+                  (Interp_ast.Unknown, Nothing)) 
+               top_env Interp.eenv (Interp.emem "decode second top level") Interp.Top) Nothing) in
+      match (instr_decoded_error) with
+      | Ivh_value _ -> IDE_instr instr (*instr_external*)
+        | Ivh_value_after_exn v ->
+          Assert_extra.failwith "supported_instructions called exit, so support will be needed for that now"
+        | Ivh_error err -> IDE_decode_error err
+        end
+   | Ivh_value_after_exn _ ->
+      Assert_extra.failwith ("Decode of " ^ val_str ^ " called exit.")
+   | Ivh_error err -> IDE_decode_error err
+end
+
+
+let decode_to_istate (top_level:context) registers (value:opcode) : i_state_or_error = 
+  let (Context top_env _ _ _ _ _ _ _ _ _ _) = top_level in
+  match decode_to_instruction top_level registers value with
+  | IDE_instr instr ->
+     let mode = make_interpreter_mode true false in
+     let (arg,_) = Interp.to_exp mode Interp.eenv instr in
+     Instr instr
+           (IState (Interp.Thunk_frame
+                      (E_aux (E_app (Id_aux (Id "execute") Interp_ast.Unknown) [arg]) (Interp_ast.Unknown,Nothing))
+                      top_env Interp.eenv (Interp.emem "execute") Interp.Top)
+                   top_level)
+  | IDE_decode_error de -> Decode_error de
+  end
+
+
+let instr_external_to_interp_value top_level instr =
+  let (Context _ direction _ _ _ _ _ _ _ _ _) = top_level in
+  let (name,parms) = instr in
+
+  let get_value (_,typ,v) = 
+    let vec = intern_ifield_value direction v in
+    match vec with
+      | Interp_ast.V_vector start dir bits ->
+         match typ with
+         | Bit -> match bits with | [b] -> b | _ -> Assert_extra.failwith "Expected a bitvector of length 1" end
+         | Range _ -> Interp_lib.to_num Interp_lib.Unsigned vec
+         | Enum _ _ -> Interp_lib.to_num Interp_lib.Unsigned vec
+         | _ -> vec
+         end 
+      | _ -> Assert_extra.failwith "intern_ifield did not return vector"
+    end in
+
+  let parmsV = match parms with
+    | [] -> Interp_ast.V_lit (L_aux L_unit Unknown)
+    | _  -> Interp_ast.V_tuple (List.map get_value parms)
+    end in
+  (*This type shouldn't be hard-coded*)
+  Interp_ast.V_ctor (Interp_ast.Id_aux (Interp_ast.Id name) Interp_ast.Unknown) 
+                (mk_typ_id "ast") Interp_ast.C_Union parmsV
+
+val instruction_to_istate : context -> Interp_ast.value -> instruction_state 
+let instruction_to_istate (top_level:context) (instr:Interp_ast.value) : instruction_state  = 
+  let mode = make_interpreter_mode true false in
+  let (Context top_env _ _ _ _ _ _ _ _ _ _) = top_level in
+  let ast_node = fst (Interp.to_exp mode Interp.eenv instr) in
+  (IState
+     (Interp.Thunk_frame
+        (E_aux (E_app (Id_aux (Id "execute") Interp_ast.Unknown) [ast_node])
+               (Interp_ast.Unknown,Nothing))
+        top_env Interp.eenv (Interp.emem "execute") Interp.Top)
+     top_level)
+
+let rec interp_to_outcome mode context thunk = 
+  let (Context _ direction mem_reads mem_reads_tagged mem_writes mem_write_eas mem_write_vals mem_write_vals_tagged barriers excl_res spec_externs) = context in
+  let internal_direction = if direction = D_increasing then Interp_ast.IInc else Interp_ast.IDec in
+  match thunk () with
+  | (Interp.Value _,lm,le) -> (Done,lm)
+  | (Interp.Error l msg,lm,le) -> (Error msg,lm)
+  | (Interp.Action a next_state,lm,le) ->
+    (match a with
+      | Interp.Read_reg reg_form slice -> 
+        (Read_reg (extern_reg reg_form slice) 
+          (fun v -> 
+            let v = (intern_reg_value v) in
+            let v = if mode.internal_mode.Interp.track_values then (Interp_ast.V_track v (Set.fromList [reg_form])) else v in 
+            IState (Interp.add_answer_to_stack next_state v) context), lm)
+      | Interp.Write_reg reg_form slice value ->
+        let reg_name = extern_reg reg_form slice in
+        (Write_reg reg_name (extern_reg_value reg_name value) (IState next_state context),lm)
+      | Interp.Read_mem (Id_aux (Id i) _) value slice ->
+        (match List.lookup i mem_reads with
+          | (Just (MR read_k f)) -> 
+            let (location, length, tracking) = (f mode value) in 
+            if (List.length location) = 8
+            then let address_int = match (maybe_all (List.map byte_of_byte_lifted location)) with
+              | Just bs -> Just (integer_of_byte_list bs)
+              | _ -> Nothing end in
+                Read_mem read_k (Address_lifted location address_int) length tracking 
+                  (fun v -> IState (Interp.add_answer_to_stack next_state (intern_mem_value mode direction v)) context)
+            else Error ("Memory address on read is not 64 bits")
+          | _ -> Error ("Memory function " ^ i ^ " not found")
+        end  , lm)
+      | Interp.Read_mem_tagged (Id_aux (Id i) _) value slice ->
+        (match List.lookup i mem_reads_tagged with
+          | (Just (MRT read_k f)) -> 
+            let (location, length, tracking) = (f mode value) in 
+            if (List.length location) = 8
+            then let address_int = match (maybe_all (List.map byte_of_byte_lifted location)) with
+              | Just bs -> Just (integer_of_byte_list bs)
+              | _ -> Nothing end in
+                Read_mem_tagged read_k (Address_lifted location address_int) length tracking 
+                  (fun (tag, v) -> IState (Interp.add_answer_to_stack next_state (Interp_ast.V_tuple ([(bitl_to_ibit tag);(intern_mem_value mode direction v)]))) context)
+            else Error ("Memory address on read is not 64 bits")
+          | _ -> Error ("Memory function " ^ i ^ " not found")
+        end  , lm)
+      | Interp.Write_mem (Id_aux (Id i) _) loc_val slice write_val ->
+        (match List.lookup i mem_writes with
+          | (Just (MW write_k f return)) -> 
+            let (location, length, tracking) = (f mode loc_val) in
+            let (value, v_tracking) = extern_with_track mode extern_mem_value write_val in
+            if (List.length location) = 8
+            then let address_int = match (maybe_all (List.map byte_of_byte_lifted location)) with
+              | Just bs -> Just (integer_of_byte_list bs)
+              | _ -> Nothing end in
+             Write_mem write_k (Address_lifted location address_int) 
+               length tracking value v_tracking 
+               (fun b -> 
+                 match return with 
+                   | Nothing -> (IState (Interp.add_answer_to_stack next_state Interp.unitv) context)
+                   | Just return_bool -> return_bool (IState next_state context) b end)
+            else Error "Memory address on write is not 64 bits"
+          | _ -> Error ("Memory function " ^ i ^ " not found")
+          end , lm)
+      | Interp.Write_ea (Id_aux (Id i) _) loc_val ->
+        (match List.lookup i mem_write_eas with
+          | (Just (MEA write_k f)) ->
+            let (location, length, tracking) = (f mode loc_val) in
+            if (List.length location) = 8
+            then let address_int = match (maybe_all (List.map byte_of_byte_lifted location)) with
+              | Just bs -> Just (integer_of_byte_list bs)
+              | _ -> Nothing end in
+              Write_ea write_k (Address_lifted location address_int) length tracking (IState next_state context)
+            else Error "Memory address for write is not 64 bits"
+          | _ -> Error ("Memory function " ^ i ^ " to signal impending write, not found") end, lm)
+      | Interp.Excl_res (Id_aux (Id i) _) ->
+        (match excl_res with
+          | (Just (i', ER return)) ->
+              Excl_res (fun b ->
+                          match return with
+                          | Nothing -> (IState (Interp.add_answer_to_stack next_state Interp.unitv) context)
+                          | Just return_bool -> return_bool (IState next_state context) b end)
+          | _ -> Error ("Exclusive result function, not provided") end, lm)
+      | Interp.Write_memv (Id_aux (Id i) _) address_val write_val ->
+           (match List.lookup i mem_write_vals with
+            | (Just (MV parmf return)) -> 
+              let (value, v_tracking) = 
+                match (Interp.detaint write_val) with
+                  | Interp_ast.V_tuple[_;v] -> extern_with_track mode extern_mem_value (Interp.retaint write_val v)
+                  | _ -> extern_with_track mode extern_mem_value write_val end in
+               let location_opt = match parmf mode address_val with
+                  | Nothing -> Nothing
+                  | Just mv -> let address_int = match (maybe_all (List.map byte_of_byte_lifted mv)) with
+                      | Just bs -> Just (integer_of_byte_list bs)
+                      | _ -> Nothing end in Just (Address_lifted mv address_int) end
+               in
+               Write_memv location_opt value v_tracking 
+                (fun b -> 
+                  match return with
+                    | Nothing -> (IState (Interp.add_answer_to_stack next_state Interp.unitv) context)
+                    | Just return_bool -> return_bool (IState next_state context) b end)
+            | _ -> Error ("Memory function " ^ i ^ " not found") end, lm)
+        | Interp.Write_memv_tagged (Id_aux (Id i) _) address_val tag_val write_val ->
+           (match List.lookup i mem_write_vals_tagged with
+            | (Just (MVT parmf return)) -> 
+              let (value, v_tracking) = 
+                match (Interp.detaint write_val) with
+                  | Interp_ast.V_tuple[_;v] -> extern_with_track mode extern_mem_value (Interp.retaint write_val v)
+                  | _ -> extern_with_track mode extern_mem_value write_val end in
+               let location_opt = match parmf mode address_val with
+                  | Nothing -> Nothing
+                  | Just mv -> let address_int = match (maybe_all (List.map byte_of_byte_lifted mv)) with
+                      | Just bs -> Just (integer_of_byte_list bs)
+                      | _ -> Nothing end in Just (Address_lifted mv address_int) end
+               in
+               Write_memv_tagged location_opt ((bitl_from_ibit tag_val), value) v_tracking 
+                (fun b -> 
+                  match return with
+                    | Nothing -> (IState (Interp.add_answer_to_stack next_state Interp.unitv) context)
+                    | Just return_bool -> return_bool (IState next_state context) b end)
+            | _ -> Error ("Memory function " ^ i ^ " not found") end, lm)
+         | Interp.Barrier (Id_aux (Id i) _) lval ->
+           (match List.lookup i barriers with
+             | Just barrier -> 
+               Barrier barrier (IState next_state context)
+             | _ -> Error ("Barrier " ^ i ^ " function not found") end, lm)
+         | Interp.Footprint (Id_aux (Id i) _) lval ->
+           (Footprint (IState next_state context), lm)
+         | Interp.Nondet exps tag ->
+           (match tag with
+             | Tag_unknown _ ->
+               let possible_states = List.map (Interp.set_in_context next_state) exps in
+               let cleared_possibles = List.map Interp.clear_stack_state possible_states in
+               Analysis_non_det (List.map (fun i -> IState i context) cleared_possibles) (IState next_state context)   
+             | _ -> 
+               let nondet_states = List.map (Interp.set_in_context next_state) exps in
+               Nondet_choice (List.map (fun i -> IState i context) nondet_states) (IState next_state context) end, lm)
+         | Interp.Call_extern i value ->  
+           (match List.lookup i ((Interp_lib.library_functions internal_direction) ++ spec_externs) with
+             | Nothing -> (Error ("External function not available " ^ i), lm)
+             | Just f  ->
+               if (mode.internal_mode.Interp.eager_eval)
+               then interp_to_outcome mode context 
+                    (fun _ -> Interp.resume mode.internal_mode next_state (Just (f value)))
+               else let new_v = f value in
+                    (Internal (Just i) 
+                      (Just (fun _ -> (Interp.string_of_value value) ^ "=>" ^ (Interp.string_of_value new_v)))
+                      (IState (Interp.add_answer_to_stack next_state new_v) context), lm)
+            end)
+         | Interp.Return value ->
+           interp_to_outcome mode context (fun _ -> Interp.resume mode.internal_mode next_state (Just value))
+         | Interp.Step l Nothing Nothing -> (Internal Nothing Nothing (IState next_state context), lm)
+         | Interp.Step l (Just name) Nothing -> (Internal (Just name) Nothing (IState next_state context), lm)
+         | Interp.Step l (Just name) (Just value) ->
+           (Internal (Just name) (Just (fun _ -> Interp.string_of_value value)) (IState next_state context), lm)
+         | Interp.Fail value ->
+           (match value with
+            | Interp_ast.V_ctor (Id_aux (Id "Some") _) _ _ (Interp_ast.V_lit (L_aux (L_string s) _)) -> (Fail (Just s),lm)
+            | _ -> (Fail Nothing,lm) end)
+         | Interp.Exit e -> 
+           (Escape (match e with
+             | E_aux (E_lit (L_aux L_unit _)) _ -> Nothing
+             | _ -> Just (IState (Interp.set_in_context next_state e) context) end)
+            (IState next_state context),
+            (snd (Interp.get_stack_state next_state)))
+         | _ -> Assert_extra.failwith "Action not as expected: consider if a deiid could have appeared"
+         end )  
+        end
+
+
+
+(*Update slice potentially here*)
+let reg_size = function
+  | Reg i _ size _ -> size
+  | Reg_slice i _ _ (p1,p2) -> if p1 < p2 then (p2-p1 +1) else (p1-p2 +1)
+  | Reg_field i _ _ f (p1,p2) -> if p1 < p2 then (p2-p1 +1) else (p1-p2 +1)
+  | Reg_f_slice i _ _ f _ (p1,p2) -> if p1 < p2 then p2-p1 +1 else p1-p2+1
+end
+
+
+let interp mode (IState interp_state context) = 
+  match interp_to_outcome mode context (fun _ -> Interp.resume mode.internal_mode interp_state Nothing) with
+    | (o,_) -> o
+end 
+
+
+(*ie_loop returns a tuple of event list, and a tuple ofinternal interpreter memory, bool to indicate normal or exceptional termination*)
+let rec ie_loop mode register_values (IState interp_state context) = 
+  let (Context _ direction externs reads reads_tagged writes write_eas write_vals write_vals_tagged barriers excl_res) = context in
+  let unknown_reg size =  
+    <| rv_bits = (List.replicate size Bitl_unknown);
+       rv_start = 0;
+       rv_start_internal = (if direction = D_increasing then 0 else (size-1));
+       rv_dir = direction |> in
+  let unknown_mem size = List.replicate size (Byte_lifted (List.replicate 8 Bitl_unknown)) in
+  match interp_to_outcome mode context (fun _ -> Interp.resume mode.internal_mode interp_state Nothing) with
+    | (Done,lm) -> ([],(lm,true))
+    | (Error msg,lm) -> ([E_error msg],(lm,false))
+    | (Escape Nothing i_state,lm) -> ([E_escape],(lm,false))
+    (*Do we want to record anything about the escape expression, which may be a function call*)
+    | (Escape _ i_state,lm) -> ([E_escape],(lm,false))
+    | (Fail _,lm) -> ([E_escape],(lm,false))
+    | (Read_reg reg i_state_fun,_) -> 
+      let v =  (match register_values with
+        | Nothing -> unknown_reg (reg_size reg)
+        | Just(registers) -> match find_reg_name reg registers with
+            | Nothing -> unknown_reg (reg_size reg)
+            | Just v -> v end end) in
+      let (events,analysis_data) = ie_loop mode register_values (i_state_fun v) in
+      ((E_read_reg reg)::events,analysis_data)
+    | (Write_reg reg value i_state, _)->
+      let (events,analysis_data) = ie_loop mode register_values i_state in
+      ((E_write_reg reg value)::events,analysis_data)
+    | (Read_mem read_k loc length tracking i_state_fun, _) ->
+      let (events,analysis_data) = ie_loop mode register_values (i_state_fun (unknown_mem length)) in
+      ((E_read_mem read_k loc length tracking)::events,analysis_data)
+    | (Read_mem_tagged read_k loc length tracking i_state_fun, _) ->
+      let (events,analysis_data) = ie_loop mode register_values (i_state_fun (Bitl_unknown, (unknown_mem length))) in
+      ((E_read_memt read_k loc length tracking)::events,analysis_data)
+    | (Write_mem write_k loc length tracking value v_tracking i_state_fun, _) ->
+      let (events,analysis_data) = ie_loop mode register_values (i_state_fun true) in
+      let (events',analysis_data) = ie_loop mode register_values (i_state_fun false) in
+      (*TODO: consider if lm and lm should be distinct and merged*)
+      ((E_write_mem write_k loc length tracking value v_tracking)::(events++events'),analysis_data)
+    | (Write_ea write_k loc length tracking i_state, _) ->
+      let (events,analysis_data) = ie_loop mode register_values i_state in
+      ((E_write_ea write_k loc length tracking)::events,analysis_data)
+    | (Excl_res i_state_fun, _) ->
+      let (events,analysis_data) = ie_loop mode register_values (i_state_fun true) in
+      let (events',analysis_data) = ie_loop mode register_values (i_state_fun false) in
+      (*TODO: consider if lm and lm should be merged*)
+      (E_excl_res :: (events ++ events'), analysis_data)
+    | (Write_memv opt_address value tracking i_state_fun, _) ->
+      let (events,analysis_data) = ie_loop mode register_values (i_state_fun true) in
+      let (events',analysis_data) = ie_loop mode register_values (i_state_fun false) in
+      (*TODO: consider if lm and lm should be merged*)
+      ((E_write_memv opt_address value tracking)::(events++events'),analysis_data)
+    | (Write_memv_tagged opt_address value tracking i_state_fun, _) ->
+      let (events,analysis_data) = ie_loop mode register_values (i_state_fun true) in
+      let (events',analysis_data) = ie_loop mode register_values (i_state_fun false) in
+      (*TODO: consider if lm and lm should be merged*)
+      ((E_write_memvt opt_address value tracking)::(events++events'),analysis_data)
+    | (Barrier barrier_k i_state, _) ->
+      let (events,analysis_data) = ie_loop mode register_values i_state in
+      ((E_barrier barrier_k)::events,analysis_data)
+    | (Footprint i_state, _) ->
+      let (events,analysis_data) = ie_loop mode register_values i_state in
+      (E_footprint::events,analysis_data)
+    | (Internal _ _ next, _) -> (ie_loop mode register_values next)
+    | (Analysis_non_det possible_istates i_state,_) ->
+      if possible_istates = []
+      then ie_loop mode register_values i_state
+      else 
+        let (possible_events,possible_states) = List.unzip(List.map (ie_loop mode register_values) possible_istates) in
+        let (unified_mem,update_mem) = List.foldr 
+          (fun (lm,terminated_normally) (mem,update_mem) -> 
+            if terminated_normally && update_mem
+            then (Interp.merge_lmems lm mem, true)
+            else if terminated_normally 
+            then (lm, true)
+            else (mem, false))    
+          (List_extra.head possible_states) (List_extra.tail possible_states) in
+        let updated_i_state = 
+          if update_mem
+          then match i_state with 
+            | (IState interp_state context) -> IState (Interp.update_stack_state interp_state unified_mem) context end
+          else i_state in
+        let (events,analysis_data) = ie_loop mode register_values updated_i_state in
+        ((List.concat possible_events)++events, analysis_data)
+      | _ -> Assert_extra.failwith "interp_to_outcome may have produced a nondet action"
+      end ;;
+  
+val interp_exhaustive : bool -> maybe (list (reg_name * register_value)) -> instruction_state -> list event
+let interp_exhaustive debug register_values i_state =
+  let mode = make_mode_exhaustive debug in
+  match ie_loop mode register_values i_state with
+    | (events,_) -> events
+end
+
+
+val state_to_outcome_s : 
+  (instruction_state -> unit -> (string * string)) -> 
+  interp_mode -> instruction_state -> Sail_impl_base.outcome_s unit
+val outcome_to_outcome : 
+  (instruction_state -> unit -> (string * string)) -> 
+  interp_mode -> Interp_interface.outcome -> Sail_impl_base.outcome unit
+
+let rec outcome_to_outcome pp_instruction_state mode = 
+  let state_to_outcome_s = 
+    state_to_outcome_s pp_instruction_state in
+  function
+  | Interp_interface.Read_mem rk addr size _ k ->
+     Sail_impl_base.Read_mem (rk,addr,size) (fun v -> state_to_outcome_s mode (k v))
+  | Interp_interface.Write_mem rk addr size _ mv _ k ->
+     failwith "Write_mem not supported anymore"
+  | Interp_interface.Write_ea wk addr size _ state ->
+     Sail_impl_base.Write_ea (wk,addr,size) (state_to_outcome_s mode state)
+  | Interp_interface.Excl_res k ->
+     Sail_impl_base.Excl_res (fun v -> state_to_outcome_s mode (k v))
+  | Interp_interface.Write_memv _ mv _ k ->
+     Sail_impl_base.Write_memv mv (fun v -> state_to_outcome_s mode (k v))
+  | Interp_interface.Barrier bk state ->
+     Sail_impl_base.Barrier bk (state_to_outcome_s mode state)
+  | Interp_interface.Footprint state ->
+     Sail_impl_base.Footprint (state_to_outcome_s mode state)
+  | Interp_interface.Read_reg r k ->
+     Sail_impl_base.Read_reg r (fun v -> state_to_outcome_s mode (k v))
+  | Interp_interface.Write_reg r rv state ->
+     Sail_impl_base.Write_reg (r,rv) (state_to_outcome_s mode state)
+  | Interp_interface.Nondet_choice _ _ ->
+     failwith "Nondet_choice not supported yet"
+  | Interp_interface.Escape _ _ ->
+     Sail_impl_base.Escape Nothing
+  | Interp_interface.Fail maybestring ->
+     Sail_impl_base.Fail maybestring
+  | Interp_interface.Internal maybestring maybeprint state ->
+     Sail_impl_base.Internal (maybestring,maybeprint) (state_to_outcome_s mode state)
+  | Interp_interface.Analysis_non_det _ _ ->
+     failwith "Analysis_non_det outcome returned"
+  | Interp_interface.Done ->
+     Sail_impl_base.Done ()
+  | Interp_interface.Error message ->
+     failwith ("Interpreter error: " ^ message)
+end
+
+and state_to_outcome_s pp_instruction_state mode state = 
+  let next_outcome' = interp mode state in
+  let next_outcome = outcome_to_outcome pp_instruction_state mode next_outcome' in
+  (next_outcome, 
+   Just ((pp_instruction_state state), 
+         (fun env -> interp_exhaustive mode.internal_mode.Interp.debug (Just env) state))
+  )
+
+val initial_outcome_s_of_instruction : (instruction_state -> unit -> (string * string)) -> context -> interp_mode -> Interp_ast.value -> Sail_impl_base.outcome_s unit
+let initial_outcome_s_of_instruction pp_instruction_state context mode instruction =
+  let state = instruction_to_istate context instruction in
+  state_to_outcome_s pp_instruction_state mode state
+
+
+(*This code is no longer uptodate. If no one is using it, then we don't need to fix it
+If someone is using it, this will let me know*)
+(*let rec rr_ie_loop mode i_state = 
+  let (IState _ (Context _ direction _ _ _ _ _ _)) = i_state in
+  let unknown_reg size =  
+    <| rv_bits = (List.replicate size Bitl_unknown); 
+       rv_start = 0;
+       rv_start_internal = (if direction=D_increasing then 0 else (size-1));
+       rv_dir = direction |> in
+  let unknown_mem size = List.replicate size (Byte_lifted (List.replicate 8 Bitl_unknown)) in
+  match (interp mode i_state) with
+    | Done -> ([],Done)
+    | Error msg -> ([E_error msg], Error msg)
+    | Read_reg reg i_state_fun -> ([], Read_reg reg i_state_fun)
+    | Write_reg reg value i_state->
+      let (events,outcome) = (rr_ie_loop mode i_state) in
+      (((E_write_reg reg value)::events), outcome)
+    | Read_mem read_k loc length tracking i_state_fun ->
+      let (events,outcome) = (rr_ie_loop mode (i_state_fun (unknown_mem length))) in 
+      (((E_read_mem read_k loc length tracking)::events),outcome)
+    | Write_mem write_k loc length tracking value v_tracking i_state_fun ->
+      let (events,outcome) = (rr_ie_loop mode (i_state_fun true)) in
+      (((E_write_mem write_k loc length tracking value v_tracking)::events),outcome)
+    | Barrier barrier_k i_state ->
+      let (events,outcome) = (rr_ie_loop mode i_state) in
+      (((E_barrier barrier_k)::events),outcome)
+    | Internal _ _ next -> (rr_ie_loop mode next)
+     end ;;
+
+let rr_interp_exhaustive mode i_state events = 
+  let (events',outcome) = rr_ie_loop mode i_state in ((events ++ events'),outcome)
+*)
+
+
+let instruction_kind_of_event nia_reg : event -> maybe instruction_kind = function
+  (* this is a hack to avoid adding special events for AArch64 transactional-memory *)
+  | E_read_reg (Reg "TMStartEffect" 63 64 D_decreasing) -> Just (IK_trans Transaction_start)
+  | E_write_reg (Reg "TMAbortEffect" 63 64 D_decreasing) _ -> Just (IK_trans Transaction_abort)
+  | E_barrier Barrier_TM_COMMIT -> Just (IK_trans Transaction_commit)
+
+  | E_read_mem rk _ _ _ -> Just (IK_mem_read rk)
+  | E_read_memt rk _ _ _ -> Just (IK_mem_read rk)
+  | E_write_mem wk _ _ _ _ _  -> Just (IK_mem_write wk)
+  | E_write_ea wk _ _ _ -> Just (IK_mem_write wk)
+  | E_excl_res -> Nothing
+  | E_write_memv _ _ _ -> Nothing
+  | E_write_memvt _ _ _ -> Nothing
+  | E_barrier bk -> Just (IK_barrier bk)
+  | E_footprint -> Nothing
+  | E_read_reg _ -> Nothing
+  | E_write_reg reg _ ->
+      if register_base_name reg = register_base_name nia_reg then Just IK_branch
+      else Nothing
+  | E_error s -> failwith ("instruction_kind_of_event error: "^s)
+  | E_escape -> Nothing (*failwith ("instruction_kind_of_event escape")*)
+ end
+(* TODO: how can we decide, looking only at the output of interp_exhaustive,
+   that an instruction is a conditional branch? *)
+
+let regs_in_of_event : event -> list reg_name = function
+  | E_read_mem _ _ _ _ -> []
+  | E_read_memt _ _ _ _ -> []
+  | E_write_mem _ _ _ _ _ _  -> []
+  | E_write_ea _ _ _ _ -> []
+  | E_excl_res -> []
+  | E_write_memv _ _ _ -> []
+  | E_write_memvt _ _ _ -> []
+  | E_barrier _ -> []
+  | E_footprint -> []
+  | E_read_reg r -> [r]
+  | E_write_reg _ _ -> []
+  | E_error s -> failwith ("regs_in_of_event "^s)
+  | E_escape -> [] (*failwith ("regs_in_of_event escape")*)
+  end
+
+let regs_out_of_event : event -> list reg_name = function
+  | E_read_mem _ _ _ _ -> []
+  | E_read_memt _ _ _ _ -> []
+  | E_write_mem _ _ _ _ _ _  -> []
+  | E_write_ea _ _ _ _ -> []
+  | E_excl_res -> []
+  | E_write_memv _ _ _ -> []
+  | E_write_memvt _ _ _ -> []
+  | E_barrier _ -> []
+  | E_footprint -> []
+  | E_read_reg _ -> []
+  | E_write_reg r _ -> [r]
+  | E_error s -> failwith ("regs_out_of_event "^s)
+  | E_escape -> [] (*failwith ("regs_out_of_event escape")*)
+  end
+
+
+let regs_feeding_memory_access_address_of_event : event -> list reg_name = function
+  | E_read_mem _ _ _ (Just rs)       -> rs
+  | E_read_mem _ _ _ None            -> []
+  | E_read_memt _ _ _ (Just rs)       -> rs
+  | E_read_memt _ _ _ None            -> []
+  | E_write_mem _ _ _ (Just rs) _ _  -> rs
+  | E_write_mem _ _ _ None _ _       -> []
+  | E_write_ea wk _ _ (Just rs)      -> rs
+  | E_write_ea wk _ _ None           -> []
+  | E_excl_res                       -> []
+  | E_write_memv _ _ _               -> []
+  | E_write_memvt _ _ _               -> []
+  | E_barrier bk                     -> []
+  | E_footprint                      -> []
+  | E_read_reg _                     -> []
+  | E_write_reg _ _                  -> []
+  | E_error s -> failwith ("regs_feeding_memory_access_address_of_event " ^ s)
+  | E_escape -> [] (*failwith ("regs_feeding_memory_access_address_of_event escape")*)
+end
+
+let nia_address_of_event nia_reg (event: event) : maybe (maybe address) = 
+   (* return Nothing for unknown/undef *)
+  match event with
+  | E_write_reg reg reg_value ->
+     if register_base_name reg = register_base_name nia_reg then
+       let al = match address_lifted_of_register_value reg_value with
+         | Just al -> al
+         | Nothing -> failwith "nia_register_of_event: NIA read not 64 bits" 
+       end in
+       Just (address_of_address_lifted al)
+     else Nothing
+  | _ -> Nothing
+  end
+
+let interp_instruction_analysis 
+      top_level
+      (interp_exhaustive : ((list (reg_name * register_value)) -> list event))
+      instruction 
+      nia_reg 
+      (nias_function : (list (maybe address) -> list nia))
+      ism environment =
+    
+    let es = interp_exhaustive environment in
+
+    let regs_in = List.concatMap regs_in_of_event es in
+    let regs_out = List.concatMap regs_out_of_event es in
+
+    let regs_feeding_address = List.concatMap regs_feeding_memory_access_address_of_event es in
+
+    let nia_address = List.mapMaybe (nia_address_of_event nia_reg) es in
+    let nias = nias_function nia_address in
+
+    let dia = DIA_none in (* FIX THIS! *)
+
+    let inst_kind =
+      match List.mapMaybe (instruction_kind_of_event nia_reg) es with
+      | [] -> IK_simple
+      | inst_kind :: [] -> inst_kind
+      | inst_kind :: inst_kinds ->
+          if forall (inst_kind' MEM inst_kinds). inst_kind' = inst_kind then
+            inst_kind
+
+          else if
+            (forall (inst_kind' MEM (inst_kind :: inst_kinds)).
+                match inst_kind' with
+                | IK_mem_read _  -> true
+                | IK_mem_write _ -> true
+                | IK_mem_rmw _   -> false
+                | IK_barrier _   -> false
+                | IK_branch      -> false
+                | IK_trans _     -> false
+                | IK_simple      -> false
+                end)
+          then
+            match
+              List.partition
+                (function IK_mem_read _ -> true | _ -> false end)
+                (inst_kind :: inst_kinds)
+            with
+            | ((IK_mem_read r) :: rs, (IK_mem_write w) :: ws) ->
+                let () = ensure (forall (r' MEM rs). r' = IK_mem_read r) "more than one kind of read" in
+                let () = ensure (forall (w' MEM ws). w' = IK_mem_write w) "more than one kind of write" in
+                IK_mem_rmw (r, w)
+            | _ -> fail
+            end
+
+          (* the TSTART instruction can also be aborted so it will have two kinds of events *)
+          else if (exists (inst_kind' MEM (inst_kind :: inst_kinds)).
+                        inst_kind' = IK_trans Transaction_start) &&
+                  (forall (inst_kind' MEM (inst_kind :: inst_kinds)).
+                        inst_kind' = IK_trans Transaction_start
+                        || inst_kind' = IK_trans Transaction_abort)
+          then
+            IK_trans Transaction_start
+
+          else
+            failwith "multiple instruction kinds"
+    end in
+
+  (regs_in, regs_out, regs_feeding_address, nias, dia, inst_kind)
+
+let interp_handwritten_instruction_analysis context endianness instruction analysis_function reg_info environment =
+  fst (instruction_analysis context endianness analysis_function
+                            reg_info (Just environment) instruction)
+
+
+
+val print_and_fail_of_inequal : forall 'a. Show 'a => 
+                                  (string -> unit) -> 
+                                (instruction -> string) ->
+                                (string * 'a) -> (string * 'a) -> unit
+let print_and_fail_if_inequal 
+      (print_endline,instruction)
+      (name1,xs1) (name2,xs2) =
+  if xs1 = xs2 then ()
+  else 
+    let () = print_endline (name1^": "^show xs1) in
+    let () = print_endline (name2^": "^show xs2) in
+    failwith (name1^" and "^ name2^" inequal for instruction: \n" ^ Interp.string_of_value instruction)
+
+let interp_compare_analyses 
+      print_endline
+      (non_pseudo_registers : set reg_name -> set reg_name)
+      context
+      endianness
+      interp_exhaustive
+      (instruction : Interp_ast.value)
+      nia_reg
+      (nias_function : (list (maybe address) -> list nia))
+      ism
+      environment
+      analysis_function
+      reg_info = 
+  let (regs_in1,regs_out1,regs_feeding_address1,nias1,dia1,inst_kind1) = 
+    interp_instruction_analysis context interp_exhaustive instruction nia_reg nias_function ism 
+                                environment in
+  let (regs_in1S,regs_out1S,regs_feeding_address1S,nias1S) =
+    (Set.fromList regs_in1,
+     Set.fromList regs_out1,
+     Set.fromList regs_feeding_address1,
+     Set.fromList nias1) in
+  let (regs_in1S,regs_out1S,regs_feeding_addres1S) = 
+    (non_pseudo_registers regs_in1S,
+     non_pseudo_registers regs_out1S,
+     non_pseudo_registers regs_feeding_address1S) in
+
+  let (regs_in2,regs_out2,regs_feeding_address2,nias2,dia2,inst_kind2) = 
+    interp_handwritten_instruction_analysis 
+      context endianness instruction analysis_function reg_info environment in
+  let (regs_in2S,regs_out2S,regs_feeding_address2S,nias2S) =
+    (Set.fromList regs_in2,
+     Set.fromList regs_out2,
+     Set.fromList regs_feeding_address2,
+     Set.fromList nias2) in
+  let (regs_in2S,regs_out2S,regs_feeding_addres2S) = 
+    (non_pseudo_registers regs_in2S,
+     non_pseudo_registers regs_out2S,
+     non_pseudo_registers regs_feeding_address2S) in
+
+  let aux = (print_endline,instruction) in
+  let () = (print_and_fail_if_inequal aux)
+             ("regs_in exhaustive",regs_in1S) 
+             ("regs_in hand",regs_in2S) in
+  let () = (print_and_fail_if_inequal aux) 
+             ("regs_out exhaustive",regs_out1S)
+             ("regs_out hand",regs_out2S) in
+  let () = (print_and_fail_if_inequal aux) 
+             ("regs_feeding_address exhaustive",regs_feeding_address1S)
+             ("regs_feeding_address hand",regs_feeding_address2S) in
+  let () = (print_and_fail_if_inequal aux) 
+             ("nias exhaustive",nias1S)
+             ("nias hand",nias2S) in
+  let () = (print_and_fail_if_inequal aux) 
+             ("dia exhaustive",dia1)
+             ("dia hand",dia2) in
+  let () = (print_and_fail_if_inequal aux) 
+             ("inst_kind exhaustive",inst_kind1)
+             ("inst_kind hand",inst_kind2) in
+
+  (regs_in1,regs_out1,regs_feeding_address1,nias1,dia1,inst_kind1)
+      
+
diff --git a/src/lem_interp/0.11/interp_interface.lem b/src/lem_interp/0.11/interp_interface.lem
new file mode 100644
index 00000000..32744da2
--- /dev/null
+++ b/src/lem_interp/0.11/interp_interface.lem
@@ -0,0 +1,326 @@
+(*========================================================================*)
+(*     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.                                                          *)
+(*========================================================================*)
+
+(* PS NOTES FOR KATHY:
+
+pls also change:  
+
+  decode_to_istate
+  decode_to_instruction 
+
+to take an opcode as defined above, instead of a value 
+
+and change 
+
+*)
+
+
+open import Sail_impl_base
+import Interp
+open import Interp_ast
+open import Pervasives
+open import Num
+
+open import Assert_extra
+
+(*Type representing the constructor parameters in instruction, other is a type not representable externally*)
+type instr_parm_typ = 
+  | Bit (*A single bit, represented as a one element Bitvector as a value*)
+  | Bvector of maybe nat (* A bitvector type, with length when statically known *)
+  | Range of maybe nat (*Internally represented as a number, externally as a bitvector of length nat *)
+  | Enum of string * nat (*Internally represented as either a number or constructor, externally as a bitvector*)
+  | Other (*An unrepresentable type, will be represented as Unknown in instruciton form *)
+
+let {coq} instr_parm_typEqual ip1 ip2 = match (ip1,ip2) with
+  | (Bit,Bit) -> true
+  | (Bvector i1,Bvector i2) -> i1 = i2
+  | (Range i1,Range i2) -> i1 = i2
+  | (Enum s1 i1,Enum s2 i2) -> s1 = s2 && i1 = i2
+  | (Other,Other) -> true
+  | _ -> false
+end
+let inline ~{coq} instr_parm_typEqual = unsafe_structural_equality
+
+let {coq} instr_parm_typInequal ip1 ip2 = not (instr_parm_typEqual ip1 ip2)
+let inline ~{coq} instr_parm_typInequal = unsafe_structural_inequality
+
+instance (Eq instr_parm_typ) 
+  let (=) = instr_parm_typEqual
+  let (<>) ip1 ip2 = not (instr_parm_typEqual ip1 ip2)
+end 
+
+let instr_parm_typShow ip = match ip with
+  | Bit -> "Bit"
+  | Bvector i -> "Bvector " ^ show i
+  | Range i -> "Range " ^ show i
+  | Enum s i -> "Enum " ^ s ^ " " ^ show i
+  | Other -> "Other"
+ end
+
+instance (Show instr_parm_typ)
+let show = instr_parm_typShow
+end
+
+(*A representation of the AST node for each instruction in the spec, with concrete values from this call,
+  and the potential static effects from the funcl clause for this instruction 
+  Follows the form of the instruction in instruction_extractor, but populates the parameters with actual values
+*)
+
+
+type instruction_field_value = list bit
+
+type instruction = (string * list (string * instr_parm_typ * instruction_field_value))
+
+let {coq} instructionEqual i1 i2 = match (i1,i2) with
+  | ((i1,parms1,effects1),(i2,parms2,effects2)) -> i1=i2 && parms1 = parms2 && effects1 = effects2
+end
+let inline ~{coq} instructionEqual = unsafe_structural_equality
+
+let {coq} instructionInequal i1 i2 = not (instructionEqual i1 i2)
+let inline ~{coq} instructionInequal = unsafe_structural_inequality
+
+type v_kind = Bitv | Bytev
+
+type decode_error = 
+  | Unsupported_instruction_error of Interp_ast.value
+  | Not_an_instruction_error of opcode
+  | Internal_error of string
+
+
+let decode_error_compare e1 e2 =
+  match (e1, e2) with
+  | (Unsupported_instruction_error i1, Unsupported_instruction_error i2)
+      -> defaultCompare i1 i2
+  | (Unsupported_instruction_error _, _) -> LT
+  | (_, Unsupported_instruction_error _) -> GT
+
+  | (Not_an_instruction_error o1, Not_an_instruction_error o2) -> defaultCompare o1 o2
+  | (Not_an_instruction_error _, _) -> LT
+  | (_, Not_an_instruction_error _) -> GT
+
+  | (Internal_error s1, Internal_error s2) -> compare s1 s2
+  (* | (Internal_error _, _) -> LT *)
+  (* | (_, Internal_error _) -> GT *)
+  end
+
+let decode_error_less e1 e2       = decode_error_compare e1 e2 =  LT
+let decode_error_less_eq e1 e2    = decode_error_compare e1 e2 <> GT
+let decode_error_greater e1 e2    = decode_error_compare e1 e2 =  GT
+let decode_error_greater_eq e1 e2 = decode_error_compare e1 e2 <> LT
+
+instance (Ord decode_error)
+  let compare = decode_error_compare
+  let (<)  = decode_error_less
+  let (<=) = decode_error_less_eq
+  let (>)  = decode_error_greater
+  let (>=) = decode_error_greater_eq
+end
+
+let decode_error_equal e1 e2 = (decode_error_compare e1 e2) = EQ
+let decode_error_inequal e1 e2 = not (decode_error_equal e1 e2)
+
+instance  (Eq decode_error)
+  let (=)  = decode_error_equal
+  let (<>) = decode_error_inequal
+end
+
+
+type interpreter_state = Interp.stack (*Deem abstract*)
+(* Will come from a .lem file generated by Sail, bound to a 'defs' identifier *)
+type specification = Interp_ast.defs Interp_ast.tannot (*Deem abstract*)
+type interpreter_mode = Interp.interp_mode (*Deem abstract*)
+type interp_mode = <| internal_mode: interpreter_mode |>
+val make_mode : (*eager*) bool -> (*tracking*) bool -> interp_mode
+val tracking_dependencies : interp_mode -> bool
+
+
+
+(*Map between external functions as preceived from a Sail spec and the actual implementation of the function *)
+type external_functions = list (string * (Interp_ast.value -> Interp_ast.value))
+
+(*Maps between the memory functions as preceived from a Sail spec and the values needed for actions in the memory model*)
+type barriers = list (string * barrier_kind)
+type memory_parameter_transformer = interp_mode -> Interp_ast.value -> (memory_value * nat * maybe (list reg_name))
+type optional_memory_transformer = interp_mode -> Interp_ast.value -> maybe memory_value
+type memory_read = MR of read_kind * memory_parameter_transformer
+type memory_reads  = list (string * memory_read)
+type memory_read_tagged  = MRT of read_kind * memory_parameter_transformer
+type memory_read_taggeds = list (string * memory_read_tagged)
+type memory_write_ea = MEA of write_kind * memory_parameter_transformer
+type memory_write_eas = list (string * memory_write_ea)
+type memory_write = MW of write_kind * memory_parameter_transformer * (maybe (instruction_state -> bool -> instruction_state))
+and memory_writes = list (string * memory_write)
+and memory_write_val = MV of optional_memory_transformer * (maybe (instruction_state -> bool -> instruction_state))
+and memory_write_vals = list (string * memory_write_val)
+and excl_res_t = ER of maybe (instruction_state -> bool -> instruction_state)
+and excl_res = maybe (string * excl_res_t)
+and memory_write_val_tagged = MVT of optional_memory_transformer * (maybe (instruction_state -> bool -> instruction_state))
+and memory_write_vals_tagged = list (string * memory_write_val_tagged)
+
+(* Definition information needed to run an instruction *)
+and context =
+    Context of Interp.top_level * direction * 
+	memory_reads * memory_read_taggeds * memory_writes * memory_write_eas * memory_write_vals * memory_write_vals_tagged * barriers * excl_res * external_functions
+
+(* An instruction in flight *)
+and instruction_state = IState of interpreter_state * context
+
+
+type outcome =
+(* Request to read N bytes at address *)
+(* The register list, used when mode.track_values, is those that the address depended on *)
+| Read_mem of read_kind * address_lifted * nat * maybe (list reg_name) * (memory_value -> instruction_state)
+| Read_mem_tagged of read_kind * address_lifted * nat * maybe (list reg_name) * ((bit_lifted * memory_value) -> instruction_state)
+
+(* Request to write memory *)
+| Write_mem of write_kind * address_lifted * nat * maybe (list reg_name)
+  * memory_value * maybe (list reg_name)  * (bool -> instruction_state)
+
+(* Request the result of store-exclusive *)
+| Excl_res of (bool -> instruction_state)
+
+(* Tell the system a write is imminent, at address lifted tainted by register list, of size nat *)
+| Write_ea of write_kind * address_lifted * nat * maybe (list reg_name) * instruction_state
+
+(* Request to write memory at last signaled address. Memory value should be 8* the size given in Write_ea *)
+| Write_memv of maybe address_lifted * memory_value * maybe (list reg_name) * (bool -> instruction_state)
+| Write_memv_tagged of maybe address_lifted * (bit_lifted * memory_value) * maybe (list reg_name) * (bool -> instruction_state)
+
+(* Request a memory barrier *)
+| Barrier of barrier_kind * instruction_state
+
+(* Tell the system to dynamically recalculate dependency footprint *)
+| Footprint of instruction_state
+
+(* Request to read register, will track dependency when mode.track_values *)
+| Read_reg of reg_name * (register_value -> instruction_state) 
+
+(* Request to write register *)
+| Write_reg of reg_name * register_value * instruction_state
+
+(* List of instruciton states to be run in parallel, any order*)
+| Nondet_choice of list instruction_state * instruction_state
+
+(* Escape the current instruction, for traps, some sys calls, interrupts, etc. Can optionally 
+   provide a handler.  The non-optional instruction_state is what we would be doing if we're 
+   not escaping. This is for exhaustive interp *)
+| Escape of maybe instruction_state * instruction_state
+
+(*Result of a failed assert with possible error message to report*)
+| Fail of maybe string
+
+(* Stop for incremental stepping, function can be used to display function call data *)
+| Internal of maybe string * maybe (unit -> string) * instruction_state
+
+(* Analysis can lead to non_deterministic evaluation, represented with this outcome *)
+(*Note: this should not be externally visible *)
+| Analysis_non_det of list instruction_state * instruction_state
+
+(*Completed interpreter*)
+| Done
+
+(*Interpreter error*)
+| Error of string
+
+
+(* Functions to build up the initial state for interpretation *)
+val build_context : bool -> specification -> memory_reads -> memory_read_taggeds-> memory_writes -> memory_write_eas -> memory_write_vals -> memory_write_vals_tagged -> barriers -> excl_res -> external_functions -> context
+val initial_instruction_state : context -> string -> list register_value -> instruction_state 
+  (* string is a function name, list of value are the parameters to that function *)
+
+type instruction_or_decode_error =
+  | IDE_instr of Interp_ast.value
+  | IDE_decode_error of decode_error
+
+(** propose to remove the following type and use the above instead *)
+type i_state_or_error =
+  | Instr of Interp_ast.value * instruction_state
+  | Decode_error of decode_error
+
+
+(** PS:I agree. propose to remove this: Function to decode an instruction and build the state to run it*)
+val decode_to_istate : context -> maybe (list (reg_name * register_value)) -> opcode -> i_state_or_error
+
+(** propose to add this, and then use instruction_to_istate on the result: Function to decode an instruction and build the state to run it*)
+(** PS made a placeholder in interp_inter_imp.lem, but it just uses decode_to_istate and throws away the istate; surely it's easy to just do what's necessary to get the instruction.   This sort-of works, but it crashes on ioid 10 after 167 steps - maybe instruction_to_istate (which I wasn't using directly before) isn't quite right? *)
+val decode_to_instruction : context -> maybe (list (reg_name * register_value))-> opcode -> instruction_or_decode_error
+
+(*Function to generate the state to run from an instruction form; is always an Instr*)
+val instruction_to_istate : context -> instruction -> instruction_state (*i_state_or_error*)
+
+(* Slice a register value into a smaller vector, starting at first number (wrt the indices of the register value, not raw positions in its list of bits) and going to second (inclusive) according to order. *)
+val slice_reg_value : register_value -> nat -> nat -> register_value
+(*Create a new register value where the contents of nat to nat are replaced by the second register_value *)  
+val update_reg_value_slice : reg_name -> register_value -> nat -> nat -> register_value -> register_value
+
+
+(* Big step of the interpreter, to the next request for an external action *)
+(* When interp_mode has eager_eval false, interpreter is (close to) small step *)
+val interp : interp_mode -> instruction_state -> outcome
+
+(* Run the interpreter without external interaction, feeding in Unknown on all reads 
+except for those register values provided *)
+val interp_exhaustive : maybe (list (reg_name * register_value)) -> instruction_state -> list event
+
+(* As above, but will request register reads: outcome will only be rreg, done, or error *)
+val rr_interp_exhaustive : interp_mode -> instruction_state -> list event -> (outcome * (list event)) 
+
+val translate_address :
+  context -> end_flag -> string -> maybe (list (reg_name * register_value)) -> address
+  -> maybe address * maybe (list event)
+
+                      
+val instruction_analysis :
+  context -> end_flag -> string -> (string -> (nat * nat * direction * (nat * nat)))
+  -> maybe (list (reg_name * register_value)) -> instruction -> (list reg_name * list reg_name * list reg_name * list nia * dia * instruction_kind)
+
+
+val initial_outcome_s_of_instruction : (instruction_state -> unit -> (string * string)) -> context -> interp_mode -> instruction -> Sail_impl_base.outcome_s unit
+
diff --git a/src/lem_interp/0.11/interp_lib.lem b/src/lem_interp/0.11/interp_lib.lem
new file mode 100644
index 00000000..e55fc175
--- /dev/null
+++ b/src/lem_interp/0.11/interp_lib.lem
@@ -0,0 +1,1111 @@
+(*========================================================================*)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(*========================================================================*)
+
+open import Pervasives
+open import Interp_utilities
+open import Interp
+open import Interp_ast
+(* For failwith for error reporting while debugging; and for fromJust when we know it's not Nothing *)
+import Assert_extra Maybe_extra 
+open import Num
+import Num_extra
+open import List
+open import Word
+open import Bool
+
+type signed = Unsigned | Signed
+
+val debug_print : string -> unit
+declare ocaml target_rep function debug_print s = `Printf.eprintf` "%s" s
+
+let print s = let _ = debug_print (string_of_value s) in V_lit(L_aux L_unit Unknown)
+
+let hardware_mod (a: integer) (b:integer) : integer = 
+ if a < 0 && b < 0
+ then (abs a) mod (abs b)
+ else if (a < 0 && b >= 0) 
+ then (a mod b) - b
+ else a mod b
+
+(* There are different possible answers for integer divide regarding
+rounding behaviour on negative operands. Positive operands always
+round down so derive the one we want (trucation towards zero) from
+that *)
+let hardware_quot (a:integer) (b:integer) : integer = 
+  let q = (abs a) / (abs b) in
+  if ((a<0) = (b<0)) then
+    q  (* same sign -- result positive *)
+  else
+    ~q (* different sign -- result negative *)
+
+let (max_64u : integer) = integerFromNat ((natPow 2 64) - 1)
+let (max_64  : integer) = integerFromNat ((natPow 2 63) - 1)
+let (min_64  : integer) = integerNegate (integerFromNat (natPow 2 63))
+let (max_32u : integer) = integerFromNat (natPow 2 32) (*4294967295*)
+let (max_32  : integer) = integerFromNat ((natPow 2 31) - 1) (*2147483647*)
+let (min_32  : integer) = integerNegate (integerFromNat (natPow 2 31)) (*2147483648*)
+let (max_8   : integer) = (integerFromNat 127)
+let (min_8   : integer) = (integerFromNat 0) - (integerFromNat 128)
+let (max_5   : integer) = (integerFromNat 31)
+
+val get_max_representable_in : signed -> nat -> integer
+let get_max_representable_in sign n = 
+  match (sign, n) with
+  | (Signed, 64)   -> max_64
+  | (Unsigned, 64) -> max_64u
+  | (Signed, 32)   -> max_32
+  | (Unsigned, 32) -> max_32u
+  | (Signed, 8)    -> max_8
+  | (Unsigned, 5)  -> max_5
+  | (Signed, _)    -> 2**(n -1) - 1
+  | (Unsigned, _)  -> 2**n - 1
+  end
+
+val get_min_representable_in : signed -> nat -> integer
+let get_min_representable_in sign n = 
+  match (sign, n) with
+  | (Unsigned, _)  -> 0
+  | (Signed, 64)   -> min_64
+  | (Signed, 32)   -> min_32
+  | (Signed, 8)    -> min_8
+  | (Signed, _)    -> 0-(2**(n-1))
+  end
+
+let ignore_sail x = V_lit (L_aux L_unit Unknown) ;;
+
+let compose f g x = f (V_tuple [g x]) ;;
+
+let zeroi = integerFromNat 0
+let onei = integerFromNat 1
+let twoi = integerFromNat 2
+
+let is_unknown v = match detaint v with
+  | V_unknown -> true
+  | _ -> false
+end 
+
+let is_undef v = match detaint v with
+  | V_lit (L_aux L_undef _) -> true
+  | _ -> false
+end
+
+let has_unknown v = match detaint v with
+  | V_vector _ _ vs -> List.any is_unknown vs
+  | V_unknown -> true
+  | _ -> false
+end
+
+let has_undef v = match detaint v with
+  | V_vector _ _ vs -> List.any is_undef vs
+  | _ -> Assert_extra.failwith ("has_undef given non-vector " ^ (string_of_value v)) 
+end 
+
+let rec sparse_walker update ni processed_length length ls df =
+  if processed_length = length 
+  then []
+  else match ls with
+  | [] -> replicate (length - processed_length) df
+  | (i,v)::ls -> 
+    if ni = i 
+    then v::(sparse_walker update (update ni) (processed_length + 1) length ls df)
+    else df::(sparse_walker update (update ni) (processed_length + 1) length ((i,v)::ls) df)
+end
+
+let fill_in_sparse v = 
+  retaint v (match detaint v with
+    | V_vector_sparse first length dir ls df -> 
+      V_vector first dir
+	(sparse_walker 
+	   (if is_inc(dir) then (fun (x: nat) -> x + 1) else (fun (x: nat) -> x - 1)) first 0 length ls df)
+    | V_unknown -> V_unknown
+    | _ -> Assert_extra.failwith ("fill_in_sparse given non-vector " ^ (string_of_value v))
+    end)
+
+let is_one v = 
+  retaint v
+    match detaint v with 
+      | V_lit (L_aux (L_num n) lb) -> V_lit (L_aux (if n=1 then L_one else L_zero) lb)
+      | V_lit (L_aux b lb) -> V_lit (L_aux (if b = L_one then L_one else L_zero) lb)
+      | V_unknown -> v
+      | _ -> Assert_extra.failwith ("is_one given non-vector " ^ (string_of_value v))
+end ;;
+
+let rec most_significant v =
+  retaint v
+    match detaint v with
+    | V_vector _ _ (v::vs) -> v
+    | V_vector_sparse _ _ _ _ _ -> most_significant (fill_in_sparse v)
+    | V_lit (L_aux L_one _) -> v
+    | V_lit (L_aux L_zero _) -> v
+    | V_lit (L_aux (L_num n) lt) ->
+      if n = 1
+      then V_lit (L_aux L_one lt)
+      else if n = 0
+      then V_lit (L_aux L_zero lt)
+      else Assert_extra.failwith ("most_significant given non-vector " ^ (string_of_value v))
+    | V_lit (L_aux L_undef _) -> v
+    | V_unknown -> V_unknown
+    | _ -> Assert_extra.failwith ("most_significant given non-vector " ^ (string_of_value v))
+end;;                       
+
+let lt_range v = 
+  let lr_helper v1 v2 = match (v1,v2) with
+  | (V_lit (L_aux (L_num l1) lr),V_lit (L_aux (L_num l2) ll)) ->
+    if l1 < l2
+    then V_lit (L_aux L_one Unknown)
+    else V_lit (L_aux L_zero Unknown)
+  | (V_unknown,_) -> V_unknown
+  | (_,V_unknown) -> V_unknown
+  | _ ->
+    Assert_extra.failwith ("lt_range given non-lit (" ^ (string_of_value v1) ^ ", " ^ (string_of_value v2) ^ ")")
+  end in
+  match v with
+    | (V_tuple[v1;v2]) ->
+      binary_taint lr_helper v1 v2
+    | _ -> Assert_extra.failwith ("lt_range not given tuple of length two " ^ (string_of_value v))
+end
+
+let bit_to_bool b = match detaint b with
+  | V_lit (L_aux L_zero _) -> false
+  | V_lit (L_aux L_false _) -> false
+  | V_lit (L_aux L_one _) -> true
+  | V_lit (L_aux L_true _) -> true
+  | _ -> Assert_extra.failwith ("bit_to_bool given unexpected " ^ (string_of_value b))
+  end ;;
+let bool_to_bit b = match b with
+    false -> V_lit (L_aux L_zero Unknown)
+  | true -> V_lit (L_aux L_one Unknown)
+  end ;;
+
+let bitwise_not_bit v = 
+  let lit_not (L_aux l loc) = match l with
+    | L_zero -> (V_lit (L_aux L_one loc))
+    | L_false -> (V_lit (L_aux L_one loc))
+    | L_one  -> (V_lit (L_aux L_zero loc))
+    | L_true -> (V_lit (L_aux L_zero loc))
+    | L_undef -> (V_lit (L_aux L_undef loc))
+    | _ -> Assert_extra.failwith ("bitwise_not_bit given unexpected " ^ (string_of_value v)) end in
+  retaint v (match detaint v with
+  | V_lit lit -> lit_not lit
+  | V_unknown -> V_unknown
+  | _ -> Assert_extra.failwith ("bitwise_not_bit given unexpected " ^ (string_of_value v))
+  end)
+
+let rec bitwise_not v =
+  retaint v (match detaint v with
+  | V_vector idx inc v ->
+    V_vector idx inc (List.map bitwise_not_bit v)
+  | V_unknown -> V_unknown
+  | _ -> Assert_extra.failwith ("bitwise_not given unexpected " ^ (string_of_value v))
+  end)
+
+let rec bitwise_binop_bit op op_s v = 
+  let b_b_b_help x y = match (x,y) with
+  | (V_vector _ _ [b],y) -> bitwise_binop_bit op op_s (V_tuple [b; y])
+  | (_,V_vector _ _ [b]) -> bitwise_binop_bit op op_s (V_tuple [x; b])
+  | (V_unknown,_) -> V_unknown
+  | (_,V_unknown) -> V_unknown
+  | (V_lit (L_aux L_undef li), v) -> 
+    (match op_s with | "|" -> y | "&" -> x | "^" -> y | _ -> x end)
+  | (v,V_lit (L_aux L_undef li)) ->
+    (match op_s with | "|" -> x | "&" -> y | "^" -> y | _ -> y end)
+  | _ -> bool_to_bit (op (bit_to_bool x) (bit_to_bool y)) end in
+  match v with
+    | (V_tuple [x; y]) -> binary_taint b_b_b_help x y
+    | _ -> Assert_extra.failwith ("bitwise_binop_bit not given tuple of length 2 " ^ (string_of_value v))
+end
+
+let rec bitwise_binop op op_s v =
+  let b_b_help v1 v2 = 
+    match (v1,v2) with
+      | (V_vector idx inc v, V_vector idx' inc' v') ->
+        (* typechecker ensures inc = inc' and length v = length v' *)
+	V_vector idx inc (List.map (fun (x,y) -> (bitwise_binop_bit op op_s (V_tuple[x; y]))) (List.zip v v'))
+      | (V_unknown,_) -> V_unknown
+      | (_,V_unknown) -> V_unknown
+      | _ -> Assert_extra.failwith ("bitwise_binop given unexpected " ^ (string_of_value v)) end in
+  match v with
+    | (V_tuple [v1;v2]) -> binary_taint b_b_help v1 v2
+    | _ -> Assert_extra.failwith ("bitwise_binop not given tuple of length 2 " ^ (string_of_value v))
+end
+
+(* BitSeq expects LSB first.
+ * By convention, MSB is on the left, so increasing = Big-Endian (MSB0),
+ * hence MSB first.
+ * http://en.wikipedia.org/wiki/Bit_numbering *)
+let to_num signed v = 
+  retaint v   
+    (match detaint v with
+      | (V_vector idx inc l) ->
+	if has_unknown v then V_unknown else if l=[] then V_unknown
+	  else if has_undef v then V_lit (L_aux L_undef Unknown)
+	  else 
+	  (* Word library in Lem expects bitseq with LSB first *)
+	    let l = reverse l in
+	  (* Make sure the last bit is a zero to force unsigned numbers *)
+	    let l = (match signed with | Signed -> l | Unsigned -> l ++ [V_lit (L_aux L_zero Unknown)] end) in
+	    V_lit(L_aux (L_num(integerFromBitSeq (Maybe_extra.fromJust (bitSeqFromBoolList (map bit_to_bool l))))) Unknown)
+      | V_unknown -> V_unknown
+      | V_lit (L_aux L_undef _) -> v
+      | V_lit (L_aux L_zero l) -> V_lit (L_aux (L_num 0) l)
+      | V_lit (L_aux L_one l) -> V_lit (L_aux (L_num 1) l)
+      | _ -> Assert_extra.failwith ("to_num given unexpected " ^ (string_of_value v))
+     end)
+
+let to_vec_inc v =
+  let fail () =  Assert_extra.failwith ("to_vec_inc given unexpected " ^ (string_of_value v)) in
+  let tv_help v1 v2 = 
+    match (v1,v2) with
+      | (V_lit(L_aux (L_num len) _), (V_lit(L_aux (L_num n) ln))) ->
+	let l = if len < 0 then []
+	  else boolListFrombitSeq (natFromInteger len) (bitSeqFromInteger Nothing n) in
+	V_vector 0 IInc (map bool_to_bit (reverse l)) 
+      | ((V_lit(L_aux (L_num n) ln)),V_unknown) -> 
+	V_vector 0 IInc (List.replicate (if n < 0 then 0 else (natFromInteger n)) V_unknown)
+      | ((V_lit(L_aux (L_num n) ln)),(V_lit (L_aux L_undef _))) -> 
+	V_vector 0 IInc (List.replicate (natFromInteger n) v2)
+      | (_,V_unknown) -> V_unknown
+      | (V_unknown,_) -> V_unknown
+      | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple[v1;v2]) -> binary_taint tv_help v1 v2
+    | _ -> fail ()
+end
+
+let to_vec_dec v =
+  let fail () = Assert_extra.failwith ("to_vec_dec parameters were " ^ (string_of_value v)) in
+  let tv_fun v1 v2 =
+    match (v1,v2) with
+      | (V_lit(L_aux (L_num len) _), (V_lit(L_aux (L_num n) ln))) ->
+	let len = if len < 0 then 0 else natFromInteger len in
+	let l = boolListFrombitSeq len (bitSeqFromInteger Nothing n) in
+	V_vector (len - 1) IDec (map bool_to_bit (reverse l)) 
+      | ((V_lit(L_aux (L_num n) ln)),V_unknown) -> 
+	let n = if n < 0 then 0 else natFromInteger n in
+	V_vector (if n=0 then 0 else (n-1)) IDec (List.replicate n V_unknown)
+      | ((V_lit(L_aux (L_num n) ln)),(V_lit (L_aux L_undef _))) -> 
+	let n = if n < 0 then 0 else natFromInteger n in
+	V_vector (if n = 0 then 0 else (n-1)) IDec (List.replicate n v2)
+      | (_,V_unknown) -> V_unknown
+      | (V_unknown,_) -> V_unknown
+      | _ -> fail ()
+   end in
+  match v with
+    | V_tuple([v1;v2]) -> binary_taint tv_fun v1 v2
+    | _ -> fail()
+end
+
+
+let rec to_vec_inc_undef v1 =
+  retaint v1
+    match detaint v1 with
+    | V_lit(L_aux (L_num len) _) ->
+      let len = if len < 0 then 0 else natFromInteger len in
+      V_vector 0 IInc (List.replicate len (V_lit (L_aux L_undef Unknown)))
+    | _ -> V_unknown
+end
+
+let rec to_vec_dec_undef v1 =
+  retaint v1
+    match detaint v1 with
+    | V_lit(L_aux (L_num len) _) ->
+      let len = if len < 0 then 0 else natFromInteger len in
+      V_vector (len - 1) IDec (List.replicate len (V_lit (L_aux L_undef Unknown)))
+    | _ -> V_unknown
+end
+
+let to_vec ord len n =
+  if is_inc(ord)
+  then to_vec_inc (V_tuple ([V_lit(L_aux (L_num len) Interp_ast.Unknown); n]))
+  else to_vec_dec (V_tuple ([V_lit(L_aux (L_num len) Interp_ast.Unknown); n]))
+;;
+
+let exts direction v = 
+  let exts_help v1 v = match (v1,v) with
+    | (V_lit(L_aux (L_num len) _), V_vector _ inc _)-> to_vec inc len (to_num Signed v)
+    | (V_lit(L_aux (L_num len) _), V_unknown) -> to_vec direction len V_unknown
+    | (V_unknown,_) -> V_unknown
+    | _ -> Assert_extra.failwith ("exts given unexpected " ^ (string_of_value v))
+  end in
+  match v with
+    | (V_tuple[v1;v]) -> binary_taint exts_help v1 v
+    | _ -> Assert_extra.failwith ("exts not given tuple of length 2 " ^ (string_of_value v))
+end
+
+let extz direction v = 
+  let extz_help v1 v = match (v1,v) with
+    | (V_lit(L_aux (L_num len) _), V_vector _ inc _)-> to_vec inc len (to_num Unsigned v)
+    | (V_lit(L_aux (L_num len) _), V_unknown) -> to_vec direction len V_unknown
+    | (V_unknown,_) -> V_unknown
+    | _ -> Assert_extra.failwith ("extx given unexpected " ^ (string_of_value v))
+  end in
+  match v with
+    | (V_tuple[v1;v]) -> binary_taint extz_help v1 v
+    | _ -> Assert_extra.failwith ("extz not given tuple of length 2 " ^ (string_of_value v))
+end
+
+let eq v = match v with
+  | (V_tuple [x; y]) ->
+    let combo = binary_taint (fun v _ -> v) x y in
+    retaint combo 
+      (if has_unknown x || has_unknown y 
+       then V_unknown
+       else (V_lit (L_aux (if ((detaint x) = (detaint y)) then L_one else L_zero) Unknown)))
+  | _ -> Assert_extra.failwith ("eq not given tuple of length 2 " ^ (string_of_value v))
+end
+
+let eq_vec v =
+  let eq_vec_help v1 v2 = match (v1,v2) with
+    | ((V_vector _ _ c1s),(V_vector _ _ c2s)) ->
+      if (List.length c1s = List.length c2s) &&
+         List.listEqualBy
+           (fun v1 v2 -> match eq (V_tuple [v1; v2]) with V_lit (L_aux L_one _) -> true | _ -> false end) c1s c2s then
+        V_lit (L_aux L_one Unknown)
+      else if has_unknown v1 || has_unknown v2
+      then V_unknown
+      else V_lit (L_aux L_zero Unknown)
+    | (V_unknown, _) -> V_unknown
+    | (_, V_unknown) -> V_unknown
+    | (V_vector _ _ [c1], _) -> eq (V_tuple [c1; v2])
+    | (_, V_vector _ _ [c2]) -> eq (V_tuple [v1; c2])
+    | (V_lit _, V_lit _) -> eq (V_tuple [v1;v2]) (*Vectors of one bit return one bit; we need coercion to match*)
+    | _ -> Assert_extra.failwith ("eq_vec not given two vectors, given instead " ^ (string_of_value v)) end in
+  match v with
+  | (V_tuple [v1; v2]) -> binary_taint eq_vec_help v1 v2
+  | _ -> Assert_extra.failwith ("eq_vec not given tuple of length 2 " ^ (string_of_value v))
+end
+
+let eq_vec_range v = match v with
+  | (V_tuple [v; r]) -> eq (V_tuple [to_num Unsigned v; r])
+  | _ -> Assert_extra.failwith ("eq_vec_range not given tuple of length 2 " ^ (string_of_value v))
+end
+let eq_range_vec v = match v with
+  | (V_tuple [r; v]) -> eq (V_tuple [r; to_num Unsigned v])
+  | _ -> Assert_extra.failwith ("eq_range_vec not given tuple of length 2 " ^ (string_of_value v))
+end
+(*let eq_vec_vec v = match v with
+  | (V_tuple [v;v2]) -> eq (V_tuple [to_num Signed v; to_num Signed v2])
+  | _ -> Assert_extra.failwith ("eq_vec_vec not given tuple of length 2 " ^ (string_of_value v))
+end*)
+
+let rec neg v = retaint v (match detaint v with
+  | V_lit (L_aux arg la) -> 
+    V_lit (L_aux (match arg with
+      | L_one -> L_zero
+      | L_zero -> L_one
+      | _ -> Assert_extra.failwith ("neg given unexpected " ^ (string_of_value v)) end) la) 
+  | V_unknown -> V_unknown
+  | V_tuple [v] -> neg v
+  | _ -> Assert_extra.failwith ("neg given unexpected " ^ (string_of_value v))
+end)
+
+let neq = compose neg eq ;;
+
+let neq_vec = compose neg eq_vec
+let neq_vec_range = compose neg eq_vec_range
+let neq_range_vec = compose neg eq_range_vec
+
+let rec v_abs v = retaint v (match detaint v with
+    | V_lit (L_aux arg la) ->
+      V_lit (L_aux (match arg with
+          | L_num n -> if n < 0 then L_num (n * (0 - 1)) else L_num n
+          | _ -> Assert_extra.failwith ("abs given unexpected " ^ (string_of_value v)) end) la)
+   | V_unknown -> V_unknown
+   | V_tuple [v] -> v_abs v
+   | _ -> Assert_extra.failwith ("abs given unexpected " ^ (string_of_value v)) end)
+
+let arith_op op v =
+  let fail () = Assert_extra.failwith ("arith_op given unexpected " ^ (string_of_value v)) in
+  let arith_op_help vl vr = 
+    match (vl,vr) with
+      | (V_lit(L_aux (L_num x) lx), V_lit(L_aux (L_num y) ly)) -> V_lit(L_aux (L_num (op x y)) lx)
+      | (V_unknown,_) -> V_unknown
+      | (_,V_unknown) -> V_unknown
+      | (V_lit (L_aux L_undef lx),_) -> vl
+      | (_, (V_lit (L_aux L_undef ly))) -> vr
+      | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_op_help vl vr
+    | _ -> fail ()
+end 
+let arith_op_vec op sign size v =
+  let fail () = Assert_extra.failwith ("arith_op_vec given unexpected " ^ (string_of_value v)) in
+  let arith_op_help vl vr =
+    match (vl,vr) with
+      | ((V_vector b ord cs as l1),(V_vector _ _ _ as l2)) ->
+	let (l1',l2') = (to_num sign l1,to_num sign l2) in
+	let n = arith_op op (V_tuple [l1';l2']) in
+	to_vec ord (integerFromNat ((List.length cs) * size)) n
+      | (V_unknown,_) -> V_unknown
+      | (_,V_unknown) -> V_unknown
+      | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_op_help vl vr
+    | _ -> fail ()
+end
+let arith_op_vec_vec_range op sign v = 
+  let fail () = Assert_extra.failwith ("arith_op_vec_vec_range given unexpected " ^ (string_of_value v)) in
+  let arith_op_help vl vr =
+    match (vl,vr) with
+      | (V_vector _ _ _,V_vector _ _ _ ) ->
+	let (l1,l2) = (to_num sign vl,to_num sign vr) in
+	arith_op op (V_tuple [l1;l2])
+      | (V_unknown,_) -> V_unknown
+      | (_,V_unknown) -> V_unknown
+      | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_op_help vl vr
+    | _ -> fail ()
+end
+let arith_op_overflow_vec op over_typ sign size v = 
+  let fail () = Assert_extra.failwith ("arith_op_overflow_vec given unexpected " ^ (string_of_value v)) in
+  let overflow_help vl vr =
+    match (vl,vr) with
+      | (V_vector b ord cs1,V_vector _ _ cs2) ->
+	let len = List.length cs1 in
+	let act_size = len * size in
+	let (is_l1_unknown,is_l2_unknown) = ((has_unknown vl), (has_unknown vr)) in
+	if is_l1_unknown || is_l2_unknown 
+	then (V_tuple [ (to_vec ord (integerFromNat act_size) V_unknown);V_unknown;V_unknown])
+	else 
+	  let (l1_sign,l2_sign) = (to_num sign vl,to_num sign vr) in
+	  let (l1_unsign,l2_unsign) = (to_num Unsigned vl,to_num Unsigned vr) in
+	  let n = arith_op op (V_tuple [l1_sign;l2_sign]) in
+	  let n_unsign = arith_op op (V_tuple[l1_unsign;l2_unsign]) in
+	  let correct_size_num = to_vec ord (integerFromNat act_size) n in
+	  let one_more_size_u = to_vec ord (integerFromNat (act_size +1)) n_unsign in
+	  let overflow = (match n with 
+	    | V_lit (L_aux (L_num n') ln) -> 
+	      if (n' <= (get_max_representable_in sign len)) &&
+		(n' >= (get_min_representable_in sign len))
+	      then V_lit (L_aux L_zero ln)
+              else V_lit (L_aux L_one ln)
+            | _ -> Assert_extra.failwith ("overflow arith_op returned " ^ (string_of_value v)) end) in
+	  let out_num = to_num sign correct_size_num in
+	  let c_out = 
+	    match detaint one_more_size_u with
+	      | V_vector _ _ (b::bits) -> b 
+              | v -> Assert_extra.failwith ("to_vec returned " ^ (string_of_value v)) end in
+    V_tuple [correct_size_num;overflow;c_out]
+  | (V_unknown,_) -> V_tuple [V_unknown;V_unknown;V_unknown]
+  | (_,V_unknown) -> V_tuple [V_unknown;V_unknown;V_unknown]
+  | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint overflow_help vl vr
+    | _ -> fail ()
+end
+let arith_op_overflow_vec_bit op sign size v =
+  let fail () = Assert_extra.failwith ("arith_op_overflow_vec_bit given unexpected " ^ (string_of_value v)) in
+  let arith_help vl vr = 
+    match (vl,vr) with
+      | (V_vector b ord cs, V_lit (L_aux bit li)) ->
+	let act_size = (List.length cs) * size in
+	let is_v_unknown = has_unknown vl in
+	if is_v_unknown 
+	then V_tuple [(to_vec ord (integerFromNat act_size) V_unknown);V_unknown;V_unknown]
+	else
+	  let l1' = to_num sign vl in
+	  let l1_u = to_num Unsigned vl in
+	  let (n,nu,changed) = match bit with
+	    | L_one -> (arith_op op (V_tuple [l1';(V_lit (L_aux (L_num 1) li))]),
+			arith_op op (V_tuple [l1_u;(V_lit (L_aux (L_num 1) li))]), true)
+            | L_zero -> (l1',l1_u,false)
+            | _ -> Assert_extra.failwith "arith_op_overflow_vec bit given non bit" end in
+	let correct_size_num = to_vec ord (integerFromNat act_size) n in
+	let one_larger = to_vec ord (integerFromNat (act_size +1)) nu in
+	let overflow = if changed 
+	  then retaint n (match detaint n with 
+	    | V_lit (L_aux (L_num n') ln) -> 
+	      if (n' <= (get_max_representable_in sign act_size)) &&
+		(n' >= (get_min_representable_in sign act_size))
+	      then V_lit (L_aux L_zero ln)
+              else V_lit (L_aux L_one ln)
+            | _ -> Assert_extra.failwith "to_num returned non num" end)
+          else V_lit (L_aux L_zero Unknown) in
+        let carry_out = (match detaint one_larger with
+            | V_vector _ _ (c::rst) -> c
+            | _ -> Assert_extra.failwith "one_larger vector returned non vector" end) in
+	V_tuple [correct_size_num;overflow;carry_out]
+      | (V_unknown,_) -> V_tuple [V_unknown;V_unknown;V_unknown]
+      | (_,V_unknown) -> V_tuple [V_unknown;V_unknown;V_unknown]
+      | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_help vl vr
+    | _ -> fail ()
+end
+
+let arith_op_range_vec op sign size v =
+  let fail () = Assert_extra.failwith ("arith_op_range_vec given unexpected " ^ (string_of_value v)) in
+  let arith_help vl vr = match (vl,vr) with
+    | (V_unknown,_) -> V_unknown
+    | (_,V_unknown) -> V_unknown
+    | (n, V_vector _ ord cs) ->
+      arith_op_vec op sign size (V_tuple [(to_vec ord (integerFromNat (List.length cs)) n);vr])
+    | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_help vl vr
+    | _ -> fail ()
+end
+
+let arith_op_vec_range op sign size v =
+  let fail () = Assert_extra.failwith ("arith_op_vec_range given unexpected " ^ (string_of_value v)) in
+  let arith_help vl vr = match (vl,vr) with
+    | (V_unknown,_) -> V_unknown
+    | (_,V_unknown) -> V_unknown
+    | (V_vector _ ord cs,n) ->
+      arith_op_vec op sign size (V_tuple [vl;(to_vec ord (integerFromNat (List.length cs)) n)])
+    | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_help vl vr
+    | _ -> fail ()
+end
+
+let arith_op_range_vec_range op sign v =
+  let fail () = Assert_extra.failwith ("arith_op_range_vec_range given unexpected " ^ (string_of_value v)) in
+  let arith_help vl vr = match (vl,vr) with
+    | (V_unknown,_) -> V_unknown
+    | (_,V_unknown) -> V_unknown
+    | (n,V_vector _ ord _) ->
+      arith_op op (V_tuple [n;(to_num Unsigned vr)])
+    | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_help vl vr
+    | _ -> fail ()
+end
+
+let arith_op_vec_range_range op sign v = 
+  let fail () = Assert_extra.failwith ("arith_op_vec_range_range given unexpected " ^ (string_of_value v)) in
+  let arith_help vl vr = match (vl,vr) with
+    | (V_unknown,_) -> V_unknown
+    | (_,V_unknown) -> V_unknown
+    | (V_vector _ ord _ ,n) ->
+      arith_op op (V_tuple [(to_num sign vl);n])
+    | _ -> fail ()
+   end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_help vl vr
+    | _ -> fail ()
+end
+
+let arith_op_vec_bit op sign size v =
+  let fail () = Assert_extra.failwith ("arith_op_vec_bit given unexpected " ^ (string_of_value v)) in
+  let arith_help vl vr =
+    match (vl,vr) with
+      | (V_unknown,_) -> V_unknown
+      | (_,V_unknown) -> V_unknown
+      | (V_vector _ ord cs,V_lit (L_aux bit _)) ->
+	let l1' = to_num sign vl in
+	let n = arith_op op (V_tuple 
+			       [l1';
+				V_lit 
+				  (L_aux (L_num (match bit with | L_one -> 1 | _ -> 0 end)) Unknown)])
+	in
+        to_vec ord (integerFromNat ((List.length cs) * size)) n
+      | _ -> fail ()
+      end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_help vl vr
+    | _ -> fail ()
+end
+
+let arith_op_no0 op v =
+  let fail () = Assert_extra.failwith ("arith_op_no0 given unexpected " ^ (string_of_value v)) in
+  let arith_help vl vr =
+    match (vl,vr) with
+      | (V_lit(L_aux (L_num x) lx), V_lit(L_aux (L_num y) ly)) -> 
+	if y = 0 
+	then V_lit (L_aux L_undef ly)
+        else V_lit(L_aux (L_num (op x y)) lx)
+      | (V_lit (L_aux L_undef lx),_) -> vl
+      | (_, (V_lit (L_aux L_undef ly))) -> vr
+      | (V_unknown,_) -> V_unknown
+      | (_,V_unknown) -> V_unknown
+      | _ -> fail ()
+  end in 
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_help vl vr
+    | _ -> fail ()
+end
+
+let arith_op_vec_no0 op op_s sign size v =
+  let fail () = Assert_extra.failwith ("arith_op_vec_no0 given unexpected " ^ (string_of_value v)) in
+  let arith_help vl vr = 
+    match (vl,vr) with
+      | (V_vector b ord cs, V_vector _ _ _) ->
+	let act_size = (List.length cs) * size in
+	let (is_l1_unknown,is_l2_unknown) = ((has_unknown vl), (has_unknown vr)) in
+	let (l1',l2') = (if is_l1_unknown then V_unknown else (to_num sign vl),
+                         if is_l2_unknown then V_unknown else (to_num sign vr)) in
+	let n = if is_l1_unknown || is_l2_unknown then V_unknown else arith_op op (V_tuple [l1';l2']) in
+	let representable = 
+	  match detaint n with 
+	    | V_lit (L_aux (L_num n') ln) ->  
+	      ((n' <= (get_max_representable_in sign act_size)) && (n' >= (get_min_representable_in sign act_size)))
+	    | _ -> true end in
+         if representable 
+	 then to_vec ord (integerFromNat act_size) n
+         else to_vec ord (integerFromNat act_size) (V_lit (L_aux L_undef Unknown))
+      | (V_unknown,_) -> V_unknown
+      | (_,V_unknown) -> V_unknown
+      | _ -> fail ()
+   end in
+   match v with 
+    | (V_tuple [vl;vr]) -> binary_taint arith_help vl vr
+    | _ -> fail ()
+end
+
+let arith_op_overflow_vec_no0 op op_s sign size v =
+  let fail () = Assert_extra.failwith ("arith_op_overflow_vec_no0 given unexpected " ^ (string_of_value v)) in
+  let arith_help vl vr = 
+    match (vl,vr) with
+      | (V_vector b ord cs, V_vector _ _ cs2) ->
+	let rep_size = (List.length cs2) * size in
+	let act_size = (List.length cs) * size in
+	let (is_l1_unknown,is_l2_unknown) = ((has_unknown vl), (has_unknown vr)) in
+	if is_l1_unknown || is_l2_unknown
+	then V_tuple [to_vec ord (integerFromNat act_size) V_unknown;V_unknown;V_unknown]
+	else
+	  let (l1',l2') = ((to_num sign vl),(to_num sign vr)) in
+	  let (l1_u,l2_u) = (to_num Unsigned vl,to_num Unsigned vr) in
+	  let n = arith_op op (V_tuple [l1';l2']) in
+	  let n_u = arith_op op (V_tuple [l1_u;l2_u]) in
+	  let representable = 
+	    match detaint n with 
+	      | V_lit (L_aux (L_num n') ln) ->  
+		((n' <= (get_max_representable_in sign rep_size)) && (n' >= (get_min_representable_in sign rep_size)))
+	      | _ -> true end in
+          let (correct_size_num,one_more) = 
+	  if representable then (to_vec ord (integerFromNat act_size) n,to_vec ord (integerFromNat (act_size+1)) n_u) 
+	  else let udef = V_lit (L_aux L_undef Unknown) in
+	       (to_vec ord (integerFromNat act_size) udef, to_vec ord (integerFromNat (act_size +1)) udef) in
+	  let overflow = if representable then V_lit (L_aux L_zero Unknown) else V_lit (L_aux L_one Unknown) in
+	  let carry = match one_more with
+            | V_vector _ _ (b::bits) -> b
+            | _ -> Assert_extra.failwith "one_more returned non-vector" end in
+	  V_tuple [correct_size_num;overflow;carry]
+	| (V_unknown,_) -> V_tuple [V_unknown;V_unknown;V_unknown]
+        | (_,V_unknown) -> V_tuple [V_unknown;V_unknown;V_unknown]
+        | _ -> fail ()
+   end in
+  match v with 
+    | (V_tuple [vl;vr]) -> binary_taint arith_help vl vr
+    | _ -> fail()
+end
+
+let arith_op_vec_range_no0 op op_s sign size v =
+  let fail () = Assert_extra.failwith ("arith_op_vec_range_no0 given unexpected " ^ (string_of_value v)) in
+  let arith_help vl vr =
+    match (vl,vr) with
+      | (V_unknown,_) -> V_unknown
+      | (_,V_unknown) -> V_unknown
+      | (V_vector _ ord cs,n) ->
+	arith_op_vec_no0 op op_s sign size (V_tuple [vl;(to_vec ord (integerFromNat (List.length cs)) n)])
+      | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_help vl vr
+    | _ -> fail ()
+end
+
+let rec shift_op_vec op v =
+  let fail () = Assert_extra.failwith ("shift_op_vec given unexpected " ^ (string_of_value v)) in
+  let arith_op_help vl vr =
+    match (vl,vr) with
+    | (V_vector b ord cs,V_lit (L_aux (L_num n) _)) ->
+      let n = natFromInteger n in
+      (match op with
+       | "<<" -> 
+	 V_vector b ord 
+           ((from_n_to_n n ((length cs) - 1) cs) ++(List.replicate n (V_lit (L_aux L_zero Unknown))))
+       | ">>" ->
+	    V_vector b ord
+	      ((List.replicate n (V_lit (L_aux L_zero Unknown))) ++ (from_n_to_n 0 (((length cs) -1) - n) cs))
+	  | "<<<" ->
+	    V_vector b ord
+             ((from_n_to_n n ((length cs) -1) cs) ++ (from_n_to_n 0 (n-1) cs))
+          | _ -> Assert_extra.failwith "shift_op_vec given non-recognized op" end)
+      | (V_unknown,_) -> V_unknown
+      | (_,V_unknown) -> V_unknown
+      | (V_lit (L_aux L_undef lx), _) -> V_lit (L_aux L_undef lx)
+      | (_, V_lit (L_aux L_undef ly)) -> V_lit (L_aux L_undef ly)
+      | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint arith_op_help vl vr
+    | _ -> fail ()
+end
+
+let compare_op op v =
+  let fail () = Assert_extra.failwith ("compare_op given unexpected " ^ (string_of_value v)) in
+  let comp_help vl vr = match (vl,vr) with
+    | (V_unknown,_) -> V_unknown
+    | (_,V_unknown) -> V_unknown
+    | (V_lit (L_aux L_undef lx), _) -> V_lit (L_aux L_undef lx)
+    | (_, V_lit (L_aux L_undef ly)) -> V_lit (L_aux L_undef ly)
+    | (V_lit(L_aux (L_num x) lx), V_lit(L_aux (L_num y) ly)) -> 
+      if (op x y)
+      then V_lit(L_aux L_one lx)
+      else V_lit(L_aux L_zero lx)
+    | _ -> fail ()
+   end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint comp_help vl vr
+    | _ -> fail ()
+end
+
+let compare_op_vec op sign v = 
+  let fail () = Assert_extra.failwith ("compare_op_vec given unexpected " ^ (string_of_value v)) in
+  let comp_help vl vr = match (vl,vr) with
+    | (V_unknown,_) -> V_unknown
+    | (_,V_unknown) -> V_unknown
+    | (V_vector _ _ _,V_vector _ _ _) ->
+      let (l1',l2') = (to_num sign vl, to_num sign vr) in
+      compare_op op (V_tuple[l1';l2'])
+    | _ -> fail ()
+   end in
+   match v with
+    | (V_tuple [vl;vr]) -> binary_taint comp_help vl vr
+    | _ -> fail ()
+end
+
+let compare_op_vec_range op sign v = 
+  let fail () = Assert_extra.failwith ("compare_op_vec_range given unexpected " ^ (string_of_value v)) in
+  let comp_help vl vr = match (vl,vr) with
+    | (V_unknown,_) -> V_unknown
+    | (_,V_unknown) -> V_unknown
+    | _ -> compare_op op (V_tuple[(to_num sign vl);vr])
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint comp_help vl vr
+    | _ -> fail ()
+end
+
+let compare_op_range_vec op sign v = 
+  let fail () = Assert_extra.failwith ("compare_op_range_vec given unexpected " ^ (string_of_value v)) in
+  let comp_help vl vr = match (vl,vr) with
+    | (V_unknown,_) -> V_unknown
+    | (_,V_unknown) -> V_unknown
+    | _ -> compare_op op (V_tuple[vl;(to_num sign vr)])
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint comp_help vl vr
+    | _ -> fail ()
+end
+
+let compare_op_vec_unsigned op v = 
+  let fail () = Assert_extra.failwith ("compare_op_vec_unsigned given unexpected " ^ (string_of_value v)) in
+  let comp_help vl vr = match (vl,vr) with
+    | (V_unknown,_) -> V_unknown
+    | (_,V_unknown) -> V_unknown
+    | (V_vector _ _ _,V_vector _ _ _) ->
+      let (l1',l2') = (to_num Unsigned vl, to_num Unsigned vr) in
+      compare_op op (V_tuple[l1';l2'])
+    | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint comp_help vl vr
+    | _ -> fail ()
+end
+
+let duplicate direction v = 
+  let fail () = Assert_extra.failwith ("duplicate given unexpected " ^ (string_of_value v)) in
+  let dup_help vl vr =
+    match (vl,vr) with
+      | ((V_lit _ as v),(V_lit (L_aux (L_num n) _))) ->
+	V_vector 0 direction (List.replicate (natFromInteger n) v)
+      | (V_unknown,(V_lit (L_aux (L_num n) _))) ->
+	V_vector 0 direction (List.replicate (natFromInteger n) V_unknown)
+      | (V_unknown,_) -> V_unknown
+      | (_, V_unknown) -> V_unknown
+      | _ -> fail ()
+    end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint dup_help vl vr
+    | _ -> fail ()
+end
+
+let rec repeat_block_helper (n: integer) bits =
+  if n <= 0
+  then []
+  else bits ++ (repeat_block_helper (n-1) bits)
+
+let duplicate_bits v =
+  let fail () = Assert_extra.failwith ("duplicate_bits given unexpected " ^ (string_of_value v)) in
+  let dup_help vl vr =
+    match (vl,vr) with
+    | (V_vector start direction bits, (V_lit (L_aux (L_num n) _))) ->
+      let start : nat = if direction = IInc then 0 else ((natFromInteger n) * (List.length bits)) - 1 in
+      (V_vector start direction (repeat_block_helper n bits))
+    | (_,V_unknown) -> V_unknown
+    | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint dup_help vl vr
+    | _ -> fail ()
+end
+
+
+let rec vec_concat v = 
+  let fail () = Assert_extra.failwith ("vec_concat given unexpected " ^ (string_of_value v)) in
+  let concat_help vl vr = 
+    match (vl,vr) with
+      | (V_vector n d l, V_vector n' d' l') ->
+      (* XXX d = d' ? dropping n' ? *)
+	V_vector n d (l ++ l')
+      | (V_lit l, (V_vector n d l' as x)) -> vec_concat (V_tuple [litV_to_vec l d; x])
+      | ((V_vector n d l' as x), V_lit l) -> vec_concat (V_tuple [x; litV_to_vec l d]) 
+      | (V_unknown,_) -> V_unknown
+      | (_,V_unknown) -> V_unknown
+      | _ -> fail ()
+  end in
+  match v with
+    | (V_tuple [vl;vr]) -> binary_taint concat_help vl vr
+    | _ -> fail ()
+end
+
+let v_length v = retaint v (match detaint v with
+  | V_vector n d l -> V_lit (L_aux (L_num (integerFromNat (List.length l))) Unknown)
+  | V_unknown -> V_unknown 
+  | _ -> Assert_extra.failwith ("length given unexpected " ^ (string_of_value v)) end)
+
+let min v = retaint v (match detaint v with
+    | V_tuple [v1;v2] ->
+      (match (detaint v1,detaint v2) with
+       | (V_lit (L_aux (L_num l1) _), V_lit (L_aux (L_num l2) _)) ->
+         if l1 < l2
+         then retaint v2 v1
+         else retaint v1 v2
+       | (V_unknown,_) -> V_unknown
+       | (_,V_unknown) -> V_unknown
+       | (V_lit l1,_) -> Assert_extra.failwith ("Second argument to min not a number " ^ (string_of_value v2))
+       | (_,V_lit l2) -> Assert_extra.failwith ("First argument to min not a number " ^ (string_of_value v1))
+       | _ ->
+         Assert_extra.failwith ("min given unexpected " ^ (string_of_value v1) ^ " and " ^ (string_of_value v2)) end)
+    | _ -> Assert_extra.failwith ("min given unexpected " ^ (string_of_value v)) end)
+
+let max v = retaint v (match detaint v with
+    | (V_tuple [(V_lit (L_aux (L_num l1) _) as v1); (V_lit (L_aux (L_num l2) _) as v2)]) ->
+      if l1 > l2
+      then v1
+      else v2
+    | V_tuple [V_unknown; V_unknown] -> V_unknown
+    | _ -> Assert_extra.failwith ("max given unexpected " ^ (string_of_value v)) end)
+
+
+let mask direction v =
+  let fail () = Assert_extra.failwith ("shift_op_vec given unexpected " ^ (string_of_value v)) in
+  match v with
+  | (V_tuple [vsize;v]) ->
+    retaint v (match (detaint v,detaint vsize) with
+        | (V_vector s d l,V_lit (L_aux (L_num n) _)) ->
+          let n = natFromInteger n in
+          let current_size = List.length l in
+          V_vector (if is_inc(d) then 0 else (n-1)) d (drop (current_size - n) l) 
+        | (V_unknown,V_lit (L_aux (L_num n) _)) -> 
+          let nat_n = natFromInteger n in
+          let start_num = if is_inc(direction) then 0 else nat_n -1 in
+          V_vector start_num direction (List.replicate nat_n V_unknown)
+        | (_,V_unknown) -> V_unknown
+        | _ -> fail () end)
+| _ -> fail ()
+end
+
+let s_append v =
+  let fail () = Assert_extra.failwith ("append given unexpected " ^ (string_of_value v)) in
+  match v with
+  | (V_tuple [l1;l2]) ->
+    retaint v (match (detaint l1,detaint l2) with
+        | (V_list vs1, V_list vs2) -> V_list (vs1++vs2)
+        | (V_unknown, _) -> V_unknown
+        | (_,V_unknown) -> V_unknown
+        | _ -> fail () end)
+  | _ -> fail ()
+end
+
+let library_functions direction = [
+  ("ignore", ignore_sail);
+  ("append", s_append);
+  ("length", v_length);
+  ("add", arith_op (+));
+  ("add_vec", arith_op_vec (+) Unsigned 1);
+  ("add_vec_range", arith_op_vec_range (+) Unsigned  1);
+  ("add_vec_range_range", arith_op_vec_range_range (+) Unsigned);
+  ("add_range_vec", arith_op_range_vec (+) Unsigned 1);
+  ("add_range_vec_range", arith_op_range_vec_range (+) Unsigned);
+  ("add_vec_vec_range", arith_op_vec_vec_range (+) Unsigned);
+  ("add_vec_bit", arith_op_vec_bit (+) Unsigned 1);
+  ("add_overflow_vec", arith_op_overflow_vec (+) "+" Unsigned 1);
+  ("add_signed", arith_op (+));
+  ("add_vec_signed", arith_op_vec (+) Signed 1);
+  ("add_vec_range_signed", arith_op_vec_range (+) Signed 1);
+  ("add_vec_range_range_signed", arith_op_vec_range_range (+) Signed);
+  ("add_range_vec_signed", arith_op_range_vec (+) Signed 1);
+  ("add_range_vec_range_signed", arith_op_range_vec_range (+) Signed);
+  ("add_vec_vec_range_signed", arith_op_vec_vec_range (+) Signed);
+  ("add_vec_bit_signed", arith_op_vec_bit (+) Signed 1);
+  ("add_overflow_vec_signed", arith_op_overflow_vec (+) "+" Signed 1);
+  ("add_overflow_vec_bit_signed", arith_op_overflow_vec_bit (+) Signed 1);
+  ("minus", arith_op (-));
+  ("minus_vec", arith_op_vec (-) Unsigned 1);
+  ("minus_vec_range", arith_op_vec_range (-) Unsigned 1);
+  ("minus_range_vec", arith_op_range_vec (-) Unsigned 1);
+  ("minus_vec_range_range", arith_op_vec_range_range (-) Unsigned);
+  ("minus_range_vec_range", arith_op_range_vec_range (-) Unsigned);
+  ("minus_vec_bit", arith_op_vec_bit (-) Unsigned 1);
+  ("minus_overflow_vec", arith_op_overflow_vec (-) "+" Unsigned 1);
+  ("minus_overflow_vec_bit", arith_op_overflow_vec_bit (-) Unsigned 1);
+  ("minus_overflow_vec_signed", arith_op_overflow_vec (-) "+" Signed 1);
+  ("minus_overflow_vec_bit_signed", arith_op_overflow_vec_bit (-) Signed 1);
+  ("multiply", arith_op ( * ));
+  ("multiply_vec", arith_op_vec ( * ) Unsigned 2);
+  ("mult_range_vec", arith_op_range_vec ( * ) Unsigned 2);
+  ("mult_vec_range", arith_op_vec_range ( * ) Unsigned 2);
+  ("mult_overflow_vec", arith_op_overflow_vec ( * ) "*" Unsigned 2);
+  ("multiply_vec_signed", arith_op_vec ( * ) Signed 2);
+  ("mult_range_vec_signed", arith_op_range_vec ( * ) Signed 2);
+  ("mult_vec_range_signed", arith_op_vec_range ( * ) Signed 2);
+  ("mult_overflow_vec_signed", arith_op_overflow_vec ( * ) "*" Signed 2);
+  ("bitwise_leftshift", shift_op_vec "<<");
+  ("bitwise_rightshift", shift_op_vec ">>");
+  ("bitwise_rotate", shift_op_vec "<<<");
+  ("modulo", arith_op_no0 (mod));
+  ("mod_signed", arith_op_no0 hardware_mod);
+  ("mod_vec", arith_op_vec_no0 hardware_mod "mod" Unsigned 1);
+  ("mod_vec_range", arith_op_vec_range_no0 hardware_mod "mod" Unsigned 1);
+  ("mod_signed_vec", arith_op_vec_no0 hardware_mod "mod" Signed 1);
+  ("mod_signed_vec_range", arith_op_vec_range_no0 hardware_mod "mod" Signed 1);
+  ("quot", arith_op_no0 hardware_quot);
+  ("quot_signed", arith_op_no0 hardware_quot);
+  ("quot_vec", arith_op_vec_no0 hardware_quot "quot" Unsigned 1);
+  ("quot_overflow_vec", arith_op_overflow_vec_no0 hardware_quot "quot" Unsigned 1);
+  ("quot_vec_signed", arith_op_vec_no0 hardware_quot "quot" Signed 1);
+  ("quot_overflow_vec_signed", arith_op_overflow_vec_no0 hardware_quot "quot" Signed 1);
+  ("print", print);
+  ("power", arith_op power);
+  ("eq", eq);
+  ("eq_vec", eq_vec);
+  ("eq_vec_range", eq_vec_range);
+  ("eq_range_vec", eq_range_vec);
+  ("eq_bit", eq);
+  ("eq_range", eq);
+  ("neq", neq);
+  ("neq_vec", neq_vec);
+  ("neq_vec_range", neq_vec_range);
+  ("neq_range_vec", neq_range_vec);
+  ("neq_bit", neq);
+  ("neq_range", neq);
+  ("vec_concat", vec_concat);
+  ("is_one", is_one);
+  ("to_num", to_num Unsigned);
+  ("exts", exts direction);
+  ("extz", extz direction);
+  ("to_vec_inc", to_vec_inc);
+  ("to_vec_inc_undef", to_vec_inc_undef);
+  ("to_vec_dec", to_vec_dec);
+  ("to_vec_dec_undef", to_vec_dec_undef);
+  ("bitwise_not", bitwise_not);
+  ("bitwise_not_bit", bitwise_not_bit);
+  ("bitwise_and", bitwise_binop (&&) "&");
+  ("bitwise_or", bitwise_binop (||) "|");
+  ("bitwise_xor", bitwise_binop xor "^");
+  ("bitwise_and_bit", bitwise_binop_bit (&&) "&");
+  ("bitwise_or_bit", bitwise_binop_bit (||) "|");
+  ("bitwise_xor_bit", bitwise_binop_bit xor "^");
+  ("lt", compare_op (<));
+  ("lt_signed", compare_op (<));
+  ("gt", compare_op (>));
+  ("lteq", compare_op (<=));
+  ("gteq", compare_op (>=));
+  ("lt_vec", compare_op_vec (<) Signed);
+  ("gt_vec", compare_op_vec (>) Signed);
+  ("lt_vec_range", compare_op_vec_range (<) Signed);
+  ("gt_vec_range", compare_op_vec_range (>) Signed);
+  ("lt_range_vec", compare_op_range_vec (<) Signed);
+  ("gt_range_vec", compare_op_range_vec (>) Signed);
+  ("lteq_vec_range", compare_op_vec_range (<=) Signed);
+  ("gteq_vec_range", compare_op_vec_range (>=) Signed);
+  ("lteq_range_vec", compare_op_range_vec (<=) Signed);
+  ("gteq_range_vec", compare_op_range_vec (>=) Signed);
+  ("lteq_vec", compare_op_vec (<=) Signed);
+  ("gteq_vec", compare_op_vec (>=) Signed);
+  ("lt_vec_signed", compare_op_vec (<) Signed);
+  ("gt_vec_signed", compare_op_vec (>) Signed);
+  ("lteq_vec_signed", compare_op_vec (<=) Signed);
+  ("gteq_vec_signed", compare_op_vec (>=) Signed);
+  ("lt_vec_unsigned", compare_op_vec (<) Unsigned);
+  ("gt_vec_unsigned", compare_op_vec (>) Unsigned);
+  ("lteq_vec_unsigned", compare_op_vec (<=) Unsigned);
+  ("gteq_vec_unsigned", compare_op_vec (>=) Unsigned);
+  ("signed", to_num Signed);
+  ("unsigned", to_num Unsigned);
+  ("ltu", compare_op_vec_unsigned (<));
+  ("gtu", compare_op_vec_unsigned (>));
+  ("duplicate", duplicate direction);
+  ("duplicate_bits", duplicate_bits);
+  ("mask", mask direction);
+  ("most_significant", most_significant);
+  ("min", min);
+  ("max", max);
+  ("abs", v_abs);
+] ;;
+
+let eval_external name v = match List.lookup name (library_functions IInc) with
+  | Just f -> f v
+  | Nothing -> Assert_extra.failwith ("missing library function " ^ name)
+  end
diff --git a/src/lem_interp/0.11/interp_utilities.lem b/src/lem_interp/0.11/interp_utilities.lem
new file mode 100644
index 00000000..1e6c59ff
--- /dev/null
+++ b/src/lem_interp/0.11/interp_utilities.lem
@@ -0,0 +1,212 @@
+(*========================================================================*)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(*========================================================================*)
+
+open import Interp_ast
+open import Pervasives
+open import Show_extra
+
+let rec power (a: integer) (b: integer) : integer =
+ if b <= 0 
+ then 1
+ else a * (power a (b-1))
+
+let foldr2 f x l l' = List.foldr (Tuple.uncurry f) x (List.zip l l')
+let map2 f l l' = List.map (Tuple.uncurry f) (List.zip l l')
+
+let get_exp_l (E_aux e (l,annot)) = l
+
+val pure : effect
+let pure = Effect_aux(Effect_set []) Unknown
+let unit_t = Typ_aux(Typ_app (Id_aux (Id "unit") Unknown) []) Unknown
+
+let mk_typ_app str args = Typ_aux (Typ_app (Id_aux (Id str) Unknown) (List.map (fun aux -> Typ_arg_aux aux Unknown) args)) Unknown
+let mk_typ_id str = Typ_aux (Typ_id (Id_aux (Id str) Unknown)) Unknown
+
+let mk_typ_var str = Typ_aux (Typ_var (Kid_aux (Var ("'" ^ str)) Unknown)) Unknown
+let mk_typ_tup typs = Typ_aux (Typ_tup typs) Unknown
+
+let nconstant n = Nexp_aux (Nexp_constant n) Unknown
+
+(* Workaround Lem's inability to scrap my (type classes) boilerplate.
+ * Implementing only Eq, and only for literals - hopefully this will
+ * be enough, but we should in principle implement ordering for everything in
+ * Interp_ast *)
+
+val lit_eq: lit -> lit -> bool
+let {ocaml;coq} lit_eq (L_aux left _) (L_aux right _) =
+   match (left, right) with
+   | (L_zero, L_zero) -> true
+   | (L_one, L_one) -> true
+   | (L_bin b, L_bin b') -> b = b'
+   | (L_hex h, L_hex h') -> h = h'
+   | (L_zero, L_num i) -> i = 0
+   | (L_num i,L_zero) -> i = 0
+   | (L_one, L_num i) -> i = 1
+   | (L_num i, L_one) -> i = 1
+   | (L_num n, L_num m) -> n = m
+   | (L_unit, L_unit) -> true
+   | (L_true, L_true) -> true
+   | (L_false, L_false) -> true
+   | (L_undef, L_undef) -> true
+   | (L_string s, L_string s') -> s = s'
+   | (_, _) -> false
+end
+let {isabelle;hol} lit_eq = unsafe_structural_equality
+
+let {ocaml;coq}    lit_ineq n1 n2 = not (lit_eq n1 n2)
+let {isabelle;hol} lit_ineq = unsafe_structural_inequality
+
+instance (Eq lit)
+  let (=)  = lit_eq
+  let (<>) = lit_ineq
+end
+
+let get_id id = match id with (Id_aux (Id s) _) -> s | (Id_aux (DeIid s) _ ) -> s end
+
+let rec {ocaml} list_to_string format sep lst = match lst with 
+  | [] -> ""
+  | [last] -> format last
+  | one::rest -> (format one) ^ sep ^ (list_to_string format sep rest)
+end
+let ~{ocaml} list_to_string format sep list = ""
+
+val has_rmem_effect : list base_effect -> bool
+val has_rmemt_effect : list base_effect -> bool
+val has_barr_effect : list base_effect -> bool
+val has_wmem_effect : list base_effect -> bool
+val has_depend_effect : list base_effect -> bool
+let rec has_effect which efcts =
+  match efcts with
+  | [] -> false
+  | (BE_aux e _)::efcts ->
+    match (which,e) with
+    | (BE_rreg,BE_rreg)     -> true 
+    | (BE_wreg,BE_wreg)     -> true 
+    | (BE_rmem,BE_rmem)     -> true 
+    | (BE_rmemt,BE_rmemt)   -> true 
+    | (BE_wmem,BE_wmem)     -> true 
+    | (BE_wmv,BE_wmv)       -> true
+    | (BE_wmvt,BE_wmvt)     -> true
+    | (BE_eamem,BE_eamem)   -> true
+    | (BE_exmem,BE_exmem)   -> true
+    | (BE_barr,BE_barr)     -> true 
+    | (BE_undef,BE_undef)   -> true 
+    | (BE_unspec,BE_unspec) -> true 
+    | (BE_nondet,BE_nondet) -> true
+    | (BE_depend,BE_depend) -> true 
+    | _ -> has_effect which efcts
+    end 
+  end
+let has_rmem_effect = has_effect BE_rmem
+let has_rmemt_effect = has_effect BE_rmemt
+let has_barr_effect = has_effect BE_barr
+let has_wmem_effect = has_effect BE_wmem
+let has_eamem_effect = has_effect BE_eamem
+let has_exmem_effect = has_effect BE_exmem
+let has_wmv_effect = has_effect BE_wmv
+let has_wmvt_effect = has_effect BE_wmvt
+let has_depend_effect = has_effect BE_depend
+
+let get_typ (TypSchm_aux (TypSchm_ts tq t) _) = t
+let get_effects (Typ_aux t _) =
+  match t with
+    | Typ_fn a r (Effect_aux (Effect_set eff) _) -> eff
+    | _ -> []
+  end
+
+let {ocaml} string_of_tag tag = match tag with
+  | Tag_empty -> "empty"
+  | Tag_global -> "global"
+  | Tag_ctor -> "ctor"
+  | Tag_extern (Just n) -> "extern " ^ n
+  | Tag_extern _ -> "extern"
+  | Tag_default -> "default"
+  | Tag_spec -> "spec"
+  | Tag_enum i -> "enum"
+  | Tag_alias -> "alias"
+end
+let ~{ocaml} string_of_tag tag = ""
+
+val find_type_def : defs tannot -> id -> maybe (type_def tannot)
+val find_function : defs tannot -> id -> maybe (list (funcl tannot))
+
+let get_funcls id (FD_aux (FD_function _ _ _ fcls) _) =
+  List.filter (fun (FCL_aux (FCL_Funcl name pexp) _) -> (get_id id) = (get_id name)) fcls
+
+let rec find_function (Defs defs) id =
+  match defs with 
+  | [] -> Nothing
+  | def::defs -> 
+    match def with
+    | DEF_fundef f -> match get_funcls id f with
+      | [] -> find_function (Defs defs) id
+      | funcs -> Just funcs end
+    | _ -> find_function (Defs defs) id
+    end end
+
+
+let rec get_first_index_range (BF_aux i _) = match i with
+  | BF_single i -> (natFromInteger i)
+  | BF_range i j -> (natFromInteger i)
+  | BF_concat s _ -> get_first_index_range s
+end 
+
+let rec get_index_range_size (BF_aux i _) = match i with
+  | BF_single _ -> 1
+  | BF_range i j -> (natFromInteger (abs (i-j))) + 1
+  | BF_concat i j -> (get_index_range_size i) + (get_index_range_size j)
+end
+
+let rec string_of_loc l = match l with
+  | Unknown -> "Unknown"
+  | Int s Nothing -> "Internal " ^ s
+  | Int s (Just l) -> "Internal " ^ s ^ " " ^ (string_of_loc l) 
+  | Range file n1 n2 n3 n4 -> "File " ^ file ^ ": " ^ (show n1) ^ ": " ^ (show (n2:nat)) ^ ": " ^ (show (n3:nat)) ^ ": " ^ (show (n4:nat))
+end
diff --git a/src/lem_interp/0.11/sail2_impl_base.lem b/src/lem_interp/0.11/sail2_impl_base.lem
new file mode 100644
index 00000000..f1cd9f2a
--- /dev/null
+++ b/src/lem_interp/0.11/sail2_impl_base.lem
@@ -0,0 +1,1103 @@
+(*========================================================================*)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(*========================================================================*)
+
+open import Pervasives_extra
+open import Sail2_instr_kinds
+
+
+class ( EnumerationType 'a ) 
+  val toNat : 'a -> nat
+end
+
+
+val enumeration_typeCompare : forall 'a. EnumerationType 'a => 'a -> 'a -> ordering
+let ~{ocaml} enumeration_typeCompare e1 e2 =
+  compare (toNat e1) (toNat e2)
+let inline {ocaml} enumeration_typeCompare = defaultCompare
+
+ 
+default_instance forall 'a. EnumerationType 'a => (Ord 'a)
+  let compare = enumeration_typeCompare
+  let (<)  r1 r2 = (enumeration_typeCompare r1 r2) = LT
+  let (<=) r1 r2 = (enumeration_typeCompare r1 r2) <> GT
+  let (>)  r1 r2 = (enumeration_typeCompare r1 r2) = GT
+  let (>=) r1 r2 = (enumeration_typeCompare r1 r2) <> LT
+end
+
+
+
+(* maybe isn't a member of type Ord - this should be in the Lem standard library*)
+instance forall 'a. Ord 'a => (Ord (maybe 'a))
+  let compare = maybeCompare compare
+  let (<)  r1 r2 = (maybeCompare compare r1 r2) = LT
+  let (<=) r1 r2 = (maybeCompare compare r1 r2) <> GT
+  let (>)  r1 r2 = (maybeCompare compare r1 r2) = GT
+  let (>=) r1 r2 = (maybeCompare compare r1 r2) <> LT
+end
+
+type word8 = nat (* bounded at a byte, for when lem supports it*)
+
+type end_flag =
+  | E_big_endian
+  | E_little_endian
+
+type bit =
+  | Bitc_zero
+  | Bitc_one
+
+type bit_lifted = 
+  | Bitl_zero
+  | Bitl_one
+  | Bitl_undef    (* used for modelling h/w arch unspecified bits *)
+  | Bitl_unknown  (* used for interpreter analysis exhaustive execution *)
+
+type direction = 
+  | D_increasing
+  | D_decreasing
+
+let dir_of_bool is_inc = if is_inc then D_increasing else D_decreasing
+let bool_of_dir = function
+  | D_increasing -> true
+  | D_decreasing -> false
+  end
+
+(* at some point this should probably not mention bit_lifted anymore *)
+type register_value = <| 
+    rv_bits: list bit_lifted (* MSB first, smallest index number *); 
+    rv_dir: direction; 
+    rv_start: nat ;
+    rv_start_internal: nat; 
+    (*when dir is increasing, rv_start = rv_start_internal. 
+      Otherwise, tells interpreter how to reconstruct a proper decreasing value*)
+    |>
+
+type byte_lifted = Byte_lifted of list bit_lifted (* of length 8 *) (*MSB first everywhere*)
+
+type instruction_field_value = list bit
+
+type byte = Byte of list bit (* of length 8 *)  (*MSB first everywhere*) 
+
+type address_lifted = Address_lifted of list byte_lifted (* of length 8 for 64bit machines*) * maybe integer
+(* for both values of end_flag, MSBy first *)
+
+type memory_byte = byte_lifted (* of length 8 *) (*MSB first everywhere*)
+
+type memory_value = list memory_byte
+(* the list is of length >=1 *)
+(* the head of the list is the byte stored at the lowest address;
+when calling a Sail function with a wmv effect, the least significant 8
+bits of the bit vector passed to the function will be interpreted as
+the lowest address byte; similarly, when calling a Sail function with
+rmem effect, the lowest address byte will be placed in the least
+significant 8 bits of the bit vector returned by the function; this
+behaviour is consistent with little-endian. *)
+
+
+(* not sure which of these is more handy yet *)
+type address = Address of list byte (* of length 8 *) * integer
+(* type address = Address of integer *)
+
+type opcode = Opcode of list byte (* of length 4 *)
+
+(** typeclass instantiations *)
+
+instance (EnumerationType bit)
+  let toNat = function
+    | Bitc_zero -> 0
+    | Bitc_one -> 1
+  end
+end
+
+instance (EnumerationType bit_lifted)
+  let toNat = function
+    | Bitl_zero -> 0
+    | Bitl_one -> 1
+    | Bitl_undef -> 2
+    | Bitl_unknown -> 3
+  end
+end
+
+let ~{ocaml} byte_liftedCompare (Byte_lifted b1) (Byte_lifted b2) = compare b1 b2
+let inline {ocaml} byte_liftedCompare = defaultCompare
+
+let ~{ocaml} byte_liftedLess b1 b2      = byte_liftedCompare b1 b2 =  LT
+let ~{ocaml} byte_liftedLessEq b1 b2    = byte_liftedCompare b1 b2 <> GT
+let ~{ocaml} byte_liftedGreater b1 b2   = byte_liftedCompare b1 b2 =  GT
+let ~{ocaml} byte_liftedGreaterEq b1 b2 = byte_liftedCompare b1 b2 <> LT
+
+let inline {ocaml} byte_liftedLess      = defaultLess
+let inline {ocaml} byte_liftedLessEq    = defaultLessEq
+let inline {ocaml} byte_liftedGreater   = defaultGreater
+let inline {ocaml} byte_liftedGreaterEq = defaultGreaterEq
+
+instance (Ord byte_lifted)
+  let compare = byte_liftedCompare
+  let (<)  = byte_liftedLess
+  let (<=) = byte_liftedLessEq
+  let (>)  = byte_liftedGreater
+  let (>=) = byte_liftedGreaterEq
+end
+
+let ~{ocaml} byteCompare (Byte b1) (Byte b2) = compare b1 b2
+let inline {ocaml} byteCompare = defaultCompare
+
+let ~{ocaml} byteLess b1 b2      = byteCompare b1 b2 =  LT
+let ~{ocaml} byteLessEq b1 b2    = byteCompare b1 b2 <> GT
+let ~{ocaml} byteGreater b1 b2   = byteCompare b1 b2 =  GT
+let ~{ocaml} byteGreaterEq b1 b2 = byteCompare b1 b2 <> LT
+
+let inline {ocaml} byteLess      = defaultLess
+let inline {ocaml} byteLessEq    = defaultLessEq
+let inline {ocaml} byteGreater   = defaultGreater
+let inline {ocaml} byteGreaterEq = defaultGreaterEq
+
+instance (Ord byte)
+  let compare = byteCompare
+  let (<)  = byteLess
+  let (<=) = byteLessEq
+  let (>)  = byteGreater
+  let (>=) = byteGreaterEq
+end
+
+
+
+
+
+let ~{ocaml} opcodeCompare (Opcode o1) (Opcode o2) =
+  compare o1 o2
+let {ocaml} opcodeCompare = defaultCompare
+
+let ~{ocaml} opcodeLess b1 b2      = opcodeCompare b1 b2 =  LT
+let ~{ocaml} opcodeLessEq b1 b2    = opcodeCompare b1 b2 <> GT
+let ~{ocaml} opcodeGreater b1 b2   = opcodeCompare b1 b2 =  GT
+let ~{ocaml} opcodeGreaterEq b1 b2 = opcodeCompare b1 b2 <> LT
+
+let inline {ocaml} opcodeLess      = defaultLess
+let inline {ocaml} opcodeLessEq    = defaultLessEq
+let inline {ocaml} opcodeGreater   = defaultGreater
+let inline {ocaml} opcodeGreaterEq = defaultGreaterEq
+
+instance (Ord opcode)
+  let compare = opcodeCompare
+  let (<)  = opcodeLess
+  let (<=) = opcodeLessEq
+  let (>)  = opcodeGreater
+  let (>=) = opcodeGreaterEq
+end
+
+let addressCompare (Address b1 i1) (Address b2 i2) = compare i1 i2
+(* this cannot be defaultCompare for OCaml because addresses contain big ints *)
+
+let addressLess b1 b2      = addressCompare b1 b2 =  LT
+let addressLessEq b1 b2    = addressCompare b1 b2 <> GT
+let addressGreater b1 b2   = addressCompare b1 b2 =  GT
+let addressGreaterEq b1 b2 = addressCompare b1 b2 <> LT
+
+instance (SetType address)
+  let setElemCompare = addressCompare
+end
+
+instance (Ord address)
+  let compare = addressCompare
+  let (<)  = addressLess
+  let (<=) = addressLessEq
+  let (>)  = addressGreater
+  let (>=) = addressGreaterEq
+end
+
+let {coq; ocaml} addressEqual a1 a2 = (addressCompare a1 a2) = EQ
+let inline {hol; isabelle} addressEqual = unsafe_structural_equality
+
+let {coq; ocaml} addressInequal a1 a2 = not (addressEqual a1 a2)
+let inline {hol; isabelle} addressInequal = unsafe_structural_inequality
+
+instance  (Eq address)
+  let (=)  = addressEqual
+  let (<>) = addressInequal
+end
+
+let ~{ocaml} directionCompare d1 d2 =
+  match (d1, d2) with
+  | (D_decreasing, D_increasing) -> GT
+  | (D_increasing, D_decreasing) -> LT
+  | _ -> EQ
+  end
+let inline {ocaml} directionCompare = defaultCompare
+
+let ~{ocaml} directionLess b1 b2      = directionCompare b1 b2 =  LT
+let ~{ocaml} directionLessEq b1 b2    = directionCompare b1 b2 <> GT
+let ~{ocaml} directionGreater b1 b2   = directionCompare b1 b2 =  GT
+let ~{ocaml} directionGreaterEq b1 b2 = directionCompare b1 b2 <> LT
+
+let inline {ocaml} directionLess      = defaultLess
+let inline {ocaml} directionLessEq    = defaultLessEq
+let inline {ocaml} directionGreater   = defaultGreater
+let inline {ocaml} directionGreaterEq = defaultGreaterEq
+
+instance (Ord direction)
+  let compare = directionCompare
+  let (<)  = directionLess
+  let (<=) = directionLessEq
+  let (>)  = directionGreater
+  let (>=) = directionGreaterEq
+end
+
+instance (Show direction)
+  let show = function D_increasing -> "D_increasing" | D_decreasing  -> "D_decreasing" end
+end
+
+let ~{ocaml} register_valueCompare rv1 rv2 =
+  compare (rv1.rv_bits, rv1.rv_dir, rv1.rv_start, rv1.rv_start_internal)
+          (rv2.rv_bits, rv2.rv_dir, rv2.rv_start, rv2.rv_start_internal)
+let inline {ocaml} register_valueCompare = defaultCompare
+
+let ~{ocaml} register_valueLess b1 b2      = register_valueCompare b1 b2 =  LT
+let ~{ocaml} register_valueLessEq b1 b2    = register_valueCompare b1 b2 <> GT
+let ~{ocaml} register_valueGreater b1 b2   = register_valueCompare b1 b2 =  GT
+let ~{ocaml} register_valueGreaterEq b1 b2 = register_valueCompare b1 b2 <> LT
+
+let inline {ocaml} register_valueLess      = defaultLess
+let inline {ocaml} register_valueLessEq    = defaultLessEq
+let inline {ocaml} register_valueGreater   = defaultGreater
+let inline {ocaml} register_valueGreaterEq = defaultGreaterEq
+
+instance (Ord register_value)
+  let compare = register_valueCompare
+  let (<)  = register_valueLess
+  let (<=) = register_valueLessEq
+  let (>)  = register_valueGreater
+  let (>=) = register_valueGreaterEq
+end
+
+let address_liftedCompare (Address_lifted b1 i1) (Address_lifted b2 i2) =
+  compare (i1,b1) (i2,b2)
+(* this cannot be defaultCompare for OCaml because address_lifteds contain big
+   ints *)
+
+let address_liftedLess b1 b2      = address_liftedCompare b1 b2 =  LT
+let address_liftedLessEq b1 b2    = address_liftedCompare b1 b2 <> GT
+let address_liftedGreater b1 b2   = address_liftedCompare b1 b2 =  GT
+let address_liftedGreaterEq b1 b2 = address_liftedCompare b1 b2 <> LT
+
+instance (Ord address_lifted)
+  let compare = address_liftedCompare
+  let (<)  = address_liftedLess
+  let (<=) = address_liftedLessEq
+  let (>)  = address_liftedGreater
+  let (>=) = address_liftedGreaterEq
+end
+
+(* Registers *)
+type slice = (nat * nat)
+
+type reg_name = 
+  (* do we really need this here if ppcmem already has this information by itself? *)
+| Reg of string * nat * nat * direction
+(*Name of the register, accessing the entire register, the start and size of this register, and its direction *)
+
+| Reg_slice of string * nat * direction * slice 
+(* Name of the register, accessing from the bit indexed by the first
+to the bit indexed by the second integer of the slice, inclusive. For
+machineDef* the first is a smaller number or equal to the second, adjusted
+to reflect the correct span direction in the interpreter side.  *)
+
+| Reg_field of string * nat * direction * string * slice 
+(*Name of the register, start and direction, and name of the field of the register
+accessed. The slice specifies where this field is in the register*)
+
+| Reg_f_slice of string * nat * direction * string * slice * slice 
+(* The first four components are as in Reg_field; the final slice
+specifies a part of the field, indexed w.r.t. the register as a whole *)
+
+let register_base_name : reg_name -> string = function
+  | Reg s _ _ _             -> s
+  | Reg_slice s _ _ _       -> s
+  | Reg_field s _ _ _ _     -> s
+  | Reg_f_slice s _ _ _ _ _ -> s
+  end
+
+let slice_of_reg_name : reg_name -> slice = function
+  | Reg _ start width D_increasing -> (start, start + width -1)
+  | Reg _ start width D_decreasing -> (start - width - 1, start)
+  | Reg_slice _ _ _ sl             -> sl
+  | Reg_field _ _ _ _ sl           -> sl
+  | Reg_f_slice _ _ _ _ _ sl       -> sl
+  end
+
+let width_of_reg_name (r: reg_name) : nat =
+  let width_of_slice (i, j) = (* j - i + 1 in *)
+
+    (integerFromNat j) - (integerFromNat i) + 1
+    $> abs $> natFromInteger
+  in
+  match r with
+  | Reg _ _ width _          -> width
+  | Reg_slice _ _ _ sl       -> width_of_slice sl
+  | Reg_field _ _ _ _ sl     -> width_of_slice sl
+  | Reg_f_slice _ _ _ _ _ sl -> width_of_slice sl
+  end
+
+let reg_name_non_empty_intersection (r: reg_name) (r': reg_name) : bool = 
+  register_base_name r = register_base_name r' &&
+  let (i1,  i2)  = slice_of_reg_name r in
+  let (i1', i2') = slice_of_reg_name r' in
+  i1' <= i2 && i2' >= i1
+
+let reg_nameCompare r1 r2 = 
+  compare (register_base_name r1,slice_of_reg_name r1)
+          (register_base_name r2,slice_of_reg_name r2)
+
+let reg_nameLess b1 b2      = reg_nameCompare b1 b2 =  LT
+let reg_nameLessEq b1 b2    = reg_nameCompare b1 b2 <> GT
+let reg_nameGreater b1 b2   = reg_nameCompare b1 b2 =  GT
+let reg_nameGreaterEq b1 b2 = reg_nameCompare b1 b2 <> LT
+
+instance (Ord reg_name)
+  let compare = reg_nameCompare
+  let (<)  = reg_nameLess
+  let (<=) = reg_nameLessEq
+  let (>)  = reg_nameGreater
+  let (>=) = reg_nameGreaterEq
+end
+
+let {coq;ocaml} reg_nameEqual a1 a2 = (reg_nameCompare a1 a2) = EQ
+let {hol;isabelle} reg_nameEqual = unsafe_structural_equality
+let {coq;ocaml} reg_nameInequal a1 a2 = not (reg_nameEqual a1 a2)
+let {hol;isabelle} reg_nameInequal = unsafe_structural_inequality
+
+instance (Eq reg_name)
+  let (=)  = reg_nameEqual
+  let (<>) = reg_nameInequal
+end
+
+instance (SetType reg_name)
+  let setElemCompare = reg_nameCompare
+end
+
+let direction_of_reg_name r = match r with
+  | Reg _ _ _ d -> d
+  | Reg_slice _ _ d _ -> d
+  | Reg_field _ _ d _ _ -> d
+  | Reg_f_slice _ _ d _ _ _ -> d
+ end
+
+let start_of_reg_name r = match r with
+  | Reg _ start _ _ -> start
+  | Reg_slice _ start _ _ -> start
+  | Reg_field _ start _ _ _ -> start
+  | Reg_f_slice _ start _ _ _ _ -> start
+end
+
+(* Data structures for building up instructions *)
+
+(* read_kind, write_kind, barrier_kind, trans_kind and instruction_kind have
+   been moved to sail_instr_kinds.lem.  This removes the dependency of the
+   shallow embedding on the rest of sail_impl_base.lem, and helps avoid name
+   clashes between the different monad types. *)
+
+type event = 
+  | E_read_mem of read_kind * address_lifted * nat * maybe (list reg_name)
+  | E_read_memt of read_kind * address_lifted * nat * maybe (list reg_name)
+  | E_write_mem of write_kind * address_lifted * nat * maybe (list reg_name) * memory_value * maybe (list reg_name)
+  | E_write_ea of write_kind * address_lifted * nat * maybe (list reg_name)
+  | E_excl_res
+  | E_write_memv of maybe address_lifted * memory_value * maybe (list reg_name)
+  | E_write_memvt of maybe address_lifted * (bit_lifted * memory_value) * maybe (list reg_name)
+  | E_barrier of barrier_kind
+  | E_footprint 
+  | E_read_reg of reg_name
+  | E_write_reg of reg_name * register_value
+  | E_escape
+  | E_error of string 
+
+
+let eventCompare e1 e2 = 
+  match (e1,e2) with
+  | (E_read_mem rk1 v1 i1 tr1, E_read_mem rk2 v2 i2 tr2) ->
+     compare (rk1, (v1,i1,tr1)) (rk2,(v2, i2, tr2)) 
+  | (E_read_memt rk1 v1 i1 tr1, E_read_memt rk2 v2 i2 tr2) ->
+     compare (rk1, (v1,i1,tr1)) (rk2,(v2, i2, tr2)) 
+  | (E_write_mem wk1 v1 i1 tr1 v1' tr1', E_write_mem wk2 v2 i2 tr2 v2' tr2') -> 
+    compare ((wk1,v1,i1),(tr1,v1',tr1'))  ((wk2,v2,i2),(tr2,v2',tr2')) 
+  | (E_write_ea wk1 a1 i1 tr1, E_write_ea wk2 a2 i2 tr2) ->
+    compare (wk1, (a1, i1, tr1)) (wk2, (a2, i2, tr2))
+  | (E_excl_res, E_excl_res) -> EQ
+  | (E_write_memv _ mv1 tr1, E_write_memv _ mv2 tr2) -> compare (mv1,tr1) (mv2,tr2)
+  | (E_write_memvt _ mv1 tr1, E_write_memvt _ mv2 tr2) -> compare (mv1,tr1) (mv2,tr2)
+  | (E_barrier bk1, E_barrier bk2) -> compare bk1 bk2
+  | (E_read_reg r1, E_read_reg r2) -> compare r1 r2
+  | (E_write_reg r1 v1, E_write_reg r2 v2) -> compare (r1,v1) (r2,v2)
+  | (E_error s1, E_error s2) -> compare s1 s2
+  | (E_escape,E_escape) -> EQ
+  | (E_read_mem _ _ _ _, _) -> LT
+  | (E_write_mem _ _ _ _ _ _, _) -> LT
+  | (E_write_ea _ _ _ _, _) -> LT
+  | (E_excl_res, _) -> LT
+  | (E_write_memv _ _ _, _) -> LT
+  | (E_barrier _, _) -> LT
+  | (E_read_reg _, _) -> LT
+  | (E_write_reg _ _, _) -> LT
+  | _ -> GT
+  end
+
+let eventLess b1 b2      = eventCompare b1 b2 =  LT
+let eventLessEq b1 b2    = eventCompare b1 b2 <> GT
+let eventGreater b1 b2   = eventCompare b1 b2 =  GT
+let eventGreaterEq b1 b2 = eventCompare b1 b2 <> LT
+
+instance (Ord event)
+  let compare = eventCompare
+  let (<)  = eventLess
+  let (<=) = eventLessEq
+  let (>)  = eventGreater
+  let (>=) = eventGreaterEq
+end
+
+instance (SetType event)
+  let setElemCompare = compare
+end
+
+
+(* the address_lifted types should go away here and be replaced by address *)
+type with_aux 'o = 'o * maybe ((unit -> (string * string)) * ((list (reg_name * register_value)) -> list event))
+type outcome 'a 'e =
+  (* Request to read memory, value is location to read, integer is size to read,
+     followed by registers that were used in computing that size *)
+  | Read_mem of (read_kind * address_lifted * nat) * (memory_value -> with_aux (outcome 'a 'e))
+  (* Tell the system a write is imminent, at address lifted, of size nat *)
+  | Write_ea of (write_kind * address_lifted * nat) * (with_aux (outcome 'a 'e))
+  (* Request the result of store-exclusive *)
+  | Excl_res of (bool -> with_aux (outcome 'a 'e))
+  (* Request to write memory at last signalled address. Memory value should be 8
+     times the size given in ea signal *)
+  | Write_memv of memory_value * (bool -> with_aux (outcome 'a 'e))
+  (* Request a memory barrier *)
+  | Barrier of barrier_kind * with_aux (outcome 'a 'e)
+  (* Tell the system to dynamically recalculate dependency footprint *)
+  | Footprint of with_aux (outcome 'a 'e)
+  (* Request to read register, will track dependency when mode.track_values *)
+  | Read_reg of reg_name * (register_value -> with_aux (outcome 'a 'e))
+  (* Request to write register *)
+  | Write_reg of (reg_name * register_value) * with_aux (outcome 'a 'e)
+  | Escape of maybe string
+  (*Result of a failed assert with possible error message to report*)
+  | Fail of maybe string
+  (* Exception of type 'e *)
+  | Exception of 'e
+  | Internal of (maybe string * maybe (unit -> string)) * with_aux (outcome 'a 'e)
+  | Done of 'a
+  | Error of string
+
+type outcome_s 'a 'e = with_aux (outcome 'a 'e)
+(* first string : output of instruction_stack_to_string
+   second string: output of local_variables_to_string *)
+
+(** operations and coercions on basic values *)
+
+val word8_to_bitls : word8 -> list bit_lifted
+val bitls_to_word8 : list bit_lifted -> word8
+
+val integer_of_word8_list : list word8 -> integer
+val word8_list_of_integer : integer -> integer -> list word8 
+
+val concretizable_bitl : bit_lifted -> bool
+val concretizable_bytl : byte_lifted -> bool
+val concretizable_bytls : list byte_lifted -> bool
+
+let concretizable_bitl = function
+  | Bitl_zero -> true
+  | Bitl_one -> true
+  | Bitl_undef -> false
+  | Bitl_unknown -> false
+end 
+
+let concretizable_bytl (Byte_lifted bs) = List.all concretizable_bitl bs
+let concretizable_bytls = List.all concretizable_bytl
+
+(* constructing values *)
+
+val build_register_value : list bit_lifted -> direction -> nat -> nat -> register_value
+let build_register_value bs dir width start_index =
+  <| rv_bits = bs;
+     rv_dir = dir; (* D_increasing for Power, D_decreasing for ARM *)
+     rv_start_internal = start_index; 
+     rv_start = if dir = D_increasing
+       then start_index
+       else (start_index+1) - width; (* Smaller index, as in Power, for external interaction *)
+  |>
+
+val register_value : bit_lifted -> direction -> nat -> nat -> register_value
+let register_value b dir width start_index = 
+  build_register_value (List.replicate width b) dir width start_index
+
+val register_value_zeros : direction -> nat -> nat -> register_value
+let register_value_zeros dir width start_index = 
+  register_value Bitl_zero dir width start_index
+
+val register_value_ones : direction -> nat -> nat -> register_value
+let register_value_ones dir width start_index = 
+  register_value Bitl_one dir width start_index
+
+val register_value_for_reg : reg_name -> list bit_lifted -> register_value
+let register_value_for_reg r bs : register_value =
+  let () = ensure (width_of_reg_name r = List.length bs)
+      ("register_value_for_reg (\"" ^ show (register_base_name r) ^ "\") length mismatch: "
+          ^ show (width_of_reg_name r) ^ " vs " ^ show (List.length bs))
+  in
+  let (j1, j2) = slice_of_reg_name r in
+  let d = direction_of_reg_name r in
+  <|  rv_bits = bs;
+      rv_dir = d;
+      rv_start_internal = if d = D_increasing then j1 else (start_of_reg_name r) - j1;
+      rv_start = j1;
+  |>
+
+val byte_lifted_undef : byte_lifted
+let byte_lifted_undef = Byte_lifted (List.replicate 8 Bitl_undef)
+
+val byte_lifted_unknown : byte_lifted
+let byte_lifted_unknown = Byte_lifted (List.replicate 8 Bitl_unknown)
+  
+val memory_value_unknown : nat (*the number of bytes*) -> memory_value
+let memory_value_unknown (width:nat) : memory_value = 
+  List.replicate width byte_lifted_unknown 
+
+val memory_value_undef : nat (*the number of bytes*) -> memory_value
+let memory_value_undef (width:nat) : memory_value = 
+  List.replicate width byte_lifted_undef 
+
+val match_endianness : forall 'a. end_flag -> list 'a -> list 'a
+let match_endianness endian l =
+  match endian with
+  | E_little_endian -> List.reverse l
+  | E_big_endian    -> l
+  end
+
+(* lengths *)  
+
+val memory_value_length : memory_value -> nat
+let memory_value_length (mv:memory_value) = List.length mv
+
+
+(* aux fns *)
+
+val maybe_all : forall 'a.  list (maybe 'a) -> maybe (list 'a)
+let rec maybe_all' xs acc = 
+  match xs with
+  | [] -> Just (List.reverse acc)
+  | Nothing :: _ -> Nothing
+  | (Just y)::xs' -> maybe_all' xs' (y::acc)
+  end
+let maybe_all xs = maybe_all' xs [] 
+
+(** coercions *)
+
+(* bits and bytes *)
+
+let bit_to_bool = function (* TODO: rename bool_of_bit *)
+  | Bitc_zero -> false
+  | Bitc_one -> true
+end
+
+
+val bit_lifted_of_bit : bit -> bit_lifted
+let bit_lifted_of_bit b = 
+  match b with
+  | Bitc_zero -> Bitl_zero
+  | Bitc_one -> Bitl_one
+  end
+
+val bit_of_bit_lifted : bit_lifted -> maybe bit
+let bit_of_bit_lifted bl =
+  match bl with
+  | Bitl_zero -> Just Bitc_zero
+  | Bitl_one -> Just Bitc_one
+  | Bitl_undef -> Nothing
+  | Bitl_unknown -> Nothing
+  end
+
+
+val byte_lifted_of_byte : byte -> byte_lifted
+let byte_lifted_of_byte (Byte bs) : byte_lifted = Byte_lifted (List.map bit_lifted_of_bit bs)
+
+val byte_of_byte_lifted : byte_lifted -> maybe byte
+let byte_of_byte_lifted bl = 
+  match bl with
+  | Byte_lifted bls -> 
+      match maybe_all (List.map bit_of_bit_lifted bls) with
+      | Nothing -> Nothing
+      | Just bs -> Just (Byte bs)
+      end
+  end
+
+
+val bytes_of_bits : list bit -> list byte (*assumes (length bits) mod 8 = 0*)
+let rec bytes_of_bits bits = match bits with
+  | [] -> []
+  | b0::b1::b2::b3::b4::b5::b6::b7::bits -> 
+    (Byte [b0;b1;b2;b3;b4;b5;b6;b7])::(bytes_of_bits bits)
+  | _ -> failwith "bytes_of_bits not given bits divisible by 8"
+end
+
+val byte_lifteds_of_bit_lifteds : list bit_lifted -> list byte_lifted (*assumes (length bits) mod 8 = 0*)
+let rec byte_lifteds_of_bit_lifteds bits = match bits with
+  | [] -> []
+  | b0::b1::b2::b3::b4::b5::b6::b7::bits -> 
+    (Byte_lifted [b0;b1;b2;b3;b4;b5;b6;b7])::(byte_lifteds_of_bit_lifteds bits)
+  | _ -> failwith "byte_lifteds of bit_lifteds not given bits divisible by 8"
+end
+
+
+val byte_of_memory_byte : memory_byte -> maybe byte
+let byte_of_memory_byte = byte_of_byte_lifted
+
+val memory_byte_of_byte : byte -> memory_byte
+let memory_byte_of_byte = byte_lifted_of_byte
+
+
+(* to and from nat *)
+
+(* this natFromBoolList could move to the Lem word.lem library *)
+val natFromBoolList : list bool -> nat
+let rec natFromBoolListAux (acc : nat) (bl : list bool) = 
+  match bl with 
+    | [] -> acc
+    | (true :: bl') -> natFromBoolListAux ((acc * 2) + 1) bl'
+    | (false :: bl') -> natFromBoolListAux (acc * 2) bl'
+  end
+let natFromBoolList bl = 
+  natFromBoolListAux 0 (List.reverse bl)
+
+
+val nat_of_bit_list : list bit -> nat 
+let nat_of_bit_list b =
+  natFromBoolList (List.reverse (List.map bit_to_bool b))
+  (* natFromBoolList takes a list with LSB first, for consistency with rest of Lem word library, so we reverse it. twice. *)
+
+
+(* to and from integer *)
+
+val integer_of_bit_list : list bit -> integer 
+let integer_of_bit_list b =
+  integerFromBoolList (false,(List.reverse (List.map bit_to_bool b)))
+  (* integerFromBoolList takes a list with LSB first, so we reverse it *)
+
+val bit_list_of_integer : nat -> integer -> list bit 
+let bit_list_of_integer len b = 
+  List.map (fun b -> if b then Bitc_one else Bitc_zero) 
+    (reverse (boolListFrombitSeq len (bitSeqFromInteger Nothing b)))
+
+val integer_of_byte_list : list byte -> integer 
+let integer_of_byte_list bytes = integer_of_bit_list (List.concatMap (fun (Byte bs) -> bs) bytes)
+
+val byte_list_of_integer : nat -> integer -> list byte 
+let byte_list_of_integer (len:nat) (a:integer):list byte = 
+  let bits = bit_list_of_integer (len * 8) a in bytes_of_bits bits
+
+
+val integer_of_address : address -> integer 
+let integer_of_address (a:address):integer = 
+  match a with
+  | Address bs i -> i 
+  end
+
+val address_of_integer : integer -> address 
+let address_of_integer (i:integer):address =
+  Address (byte_list_of_integer 8 i) i
+
+(* to and from signed-integer *)
+
+val signed_integer_of_bit_list : list bit -> integer
+let signed_integer_of_bit_list b =
+  match b with
+  | [] -> failwith "empty bit list"
+  | Bitc_zero :: b' ->
+      integerFromBoolList (false,(List.reverse (List.map bit_to_bool b)))
+  | Bitc_one :: b' ->
+      let b'_val = integerFromBoolList (false,(List.reverse (List.map bit_to_bool b'))) in
+      (* integerFromBoolList takes a list with LSB first, so we reverse it *)
+      let msb_val = integerPow 2 ((List.length b) - 1) in
+      b'_val - msb_val
+  end
+
+
+(* regarding a list of int as a list of bytes in memory, MSB lowest-address first, convert to an integer *)
+val integer_address_of_int_list : list int -> integer
+let rec integerFromIntListAux (acc: integer) (is: list int) = 
+  match is with 
+  | [] -> acc
+  | (i :: is') -> integerFromIntListAux ((acc * 256) + integerFromInt i) is'
+  end
+let integer_address_of_int_list (is: list int) =
+  integerFromIntListAux 0 is
+
+val address_of_byte_list : list byte -> address 
+let address_of_byte_list bs = 
+  if List.length bs <> 8 then failwith "address_of_byte_list given list not of length 8" else 
+  Address bs (integer_of_byte_list bs)
+
+let address_of_byte_lifted_list bls =
+  match maybe_all (List.map byte_of_byte_lifted bls) with
+  | Nothing -> Nothing
+  | Just bs -> Just (address_of_byte_list bs)
+  end
+
+(* operations on addresses *)
+
+val add_address_nat : address -> nat -> address 
+let add_address_nat (a:address) (i:nat) : address = 
+  address_of_integer ((integer_of_address a) + (integerFromNat i))
+
+val clear_low_order_bits_of_address : address -> address 
+let clear_low_order_bits_of_address a = 
+  match a with 
+  | Address [b0;b1;b2;b3;b4;b5;b6;b7] i -> 
+      match b7 with
+      | Byte [bt0;bt1;bt2;bt3;bt4;bt5;bt6;bt7] -> 
+          let b7' = Byte [bt0;bt1;bt2;bt3;bt4;bt5;Bitc_zero;Bitc_zero] in
+	  let bytes = [b0;b1;b2;b3;b4;b5;b6;b7'] in
+          Address bytes (integer_of_byte_list bytes)
+      | _ -> failwith "Byte does not contain 8 bits"
+      end
+  | _ -> failwith "Address does not contain 8 bytes"
+  end
+
+
+
+val byte_list_of_memory_value : end_flag -> memory_value -> maybe (list byte)
+let byte_list_of_memory_value endian mv =
+  match_endianness endian mv
+  $> List.map byte_of_memory_byte
+  $> maybe_all
+
+
+val integer_of_memory_value : end_flag -> memory_value -> maybe integer
+let integer_of_memory_value endian (mv:memory_value):maybe integer =
+  match byte_list_of_memory_value endian mv with
+  | Just bs -> Just (integer_of_byte_list bs)
+  | Nothing -> Nothing 
+  end
+
+val memory_value_of_integer : end_flag  -> nat -> integer -> memory_value
+let memory_value_of_integer endian (len:nat) (i:integer):memory_value =
+  List.map byte_lifted_of_byte (byte_list_of_integer len i)
+  $> match_endianness endian
+
+
+val integer_of_register_value : register_value -> maybe integer 
+let integer_of_register_value (rv:register_value):maybe integer = 
+  match maybe_all (List.map bit_of_bit_lifted rv.rv_bits) with
+  | Nothing -> Nothing
+  | Just bs -> Just (integer_of_bit_list bs)
+  end
+
+(* NOTE: register_value_for_reg_of_integer might be easier to use *)
+val register_value_of_integer : nat -> nat -> direction -> integer -> register_value 
+let register_value_of_integer (len:nat) (start:nat) (dir:direction) (i:integer):register_value =
+  let bs = bit_list_of_integer len i in
+  build_register_value (List.map bit_lifted_of_bit bs) dir len start
+
+val register_value_for_reg_of_integer : reg_name -> integer -> register_value
+let register_value_for_reg_of_integer (r: reg_name) (i:integer) : register_value =
+  register_value_of_integer (width_of_reg_name r) (start_of_reg_name r) (direction_of_reg_name r) i
+
+(* *)
+
+val opcode_of_bytes : byte -> byte -> byte -> byte -> opcode
+let opcode_of_bytes b0 b1 b2 b3 : opcode = Opcode [b0;b1;b2;b3]
+
+val register_value_of_address : address -> direction -> register_value   
+let register_value_of_address (Address bytes _) dir : register_value = 
+  let bits = List.concatMap (fun (Byte bs) -> List.map bit_lifted_of_bit bs) bytes in
+   <| rv_bits = bits;
+      rv_dir = dir;
+      rv_start = 0; 
+      rv_start_internal = if dir = D_increasing then 0 else (List.length bits) - 1
+   |>
+
+val register_value_of_memory_value : memory_value -> direction -> register_value
+let register_value_of_memory_value bytes dir : register_value =
+  let bitls = List.concatMap (fun (Byte_lifted bs) -> bs) bytes in
+  <| rv_bits = bitls;
+     rv_dir = dir;
+     rv_start = 0;
+     rv_start_internal = if dir = D_increasing then 0 else (List.length bitls) - 1
+   |>                                                     
+
+val memory_value_of_register_value: register_value -> memory_value
+let memory_value_of_register_value r =
+  (byte_lifteds_of_bit_lifteds r.rv_bits)
+   
+val address_lifted_of_register_value : register_value -> maybe address_lifted
+(* returning Nothing iff the register value is not 64 bits wide, but
+allowing Bitl_undef and Bitl_unknown *)
+let address_lifted_of_register_value (rv:register_value) : maybe address_lifted = 
+  if List.length rv.rv_bits <> 64 then Nothing
+  else 
+    Just (Address_lifted (byte_lifteds_of_bit_lifteds rv.rv_bits)
+                         (if List.all concretizable_bitl rv.rv_bits 
+			  then match (maybe_all (List.map bit_of_bit_lifted rv.rv_bits)) with
+                              | (Just(bits)) -> Just (integer_of_bit_list bits)
+                              | Nothing -> Nothing end
+			  else Nothing))
+
+val address_of_address_lifted : address_lifted -> maybe address
+(* returning Nothing iff the address contains any Bitl_undef or Bitl_unknown *)
+let address_of_address_lifted (al:address_lifted): maybe address =
+  match al with
+  | Address_lifted bls (Just i)-> 
+      match maybe_all ((List.map byte_of_byte_lifted) bls) with
+      | Nothing -> Nothing
+      | Just bs -> Just (Address bs i)
+      end
+  | _ -> Nothing
+end
+
+val address_of_register_value : register_value -> maybe address
+(* returning Nothing iff the register value is not 64 bits wide, or contains Bitl_undef or Bitl_unknown *)
+let address_of_register_value (rv:register_value) : maybe address = 
+  match address_lifted_of_register_value rv with
+  | Nothing -> Nothing
+  | Just al -> 
+      match address_of_address_lifted al with
+      | Nothing -> Nothing
+      | Just a -> Just a
+      end
+  end
+
+let address_of_memory_value (endian: end_flag) (mv:memory_value) : maybe address =
+  match byte_list_of_memory_value endian mv with
+  | Nothing -> Nothing
+  | Just bs -> 
+      if List.length bs <> 8 then Nothing else
+      Just (address_of_byte_list bs)
+  end 
+
+val byte_of_int : int -> byte
+let byte_of_int (i:int) : byte = 
+  Byte (bit_list_of_integer 8 (integerFromInt i))
+
+val memory_byte_of_int : int -> memory_byte
+let memory_byte_of_int (i:int) : memory_byte = 
+  memory_byte_of_byte (byte_of_int i)
+
+(*
+val int_of_memory_byte : int -> maybe memory_byte
+let int_of_memory_byte (mb:memory_byte) : int = 
+  failwith "TODO"
+*)
+
+
+
+val memory_value_of_address_lifted : end_flag -> address_lifted -> memory_value
+let memory_value_of_address_lifted endian (Address_lifted bs _ :address_lifted) =
+  match_endianness endian bs
+
+val byte_list_of_address : address -> list byte
+let byte_list_of_address (Address bs _) : list byte = bs
+
+val memory_value_of_address : end_flag -> address -> memory_value
+let memory_value_of_address endian (Address bs _) =
+  match_endianness endian bs
+  $> List.map byte_lifted_of_byte
+
+val byte_list_of_opcode : opcode -> list byte
+let byte_list_of_opcode (Opcode bs) : list byte = bs
+
+(** ****************************************** *)
+(** show type class instantiations             *)
+(** ****************************************** *)
+
+(* matching printing_functions.ml *)
+val stringFromReg_name : reg_name -> string
+let stringFromReg_name r =
+  let norm_sl start dir (first,second) = (first,second)
+    (* match dir with
+      | D_increasing -> (first,second)
+      | D_decreasing -> (start - first, start - second)
+    end *)
+  in
+  match r with
+  | Reg s start size dir -> s
+  | Reg_slice s start dir sl ->
+      let (first,second) = norm_sl start dir sl in
+      s ^ "[" ^ show first ^ (if (first = second) then "" else ".." ^ (show second)) ^ "]"
+  | Reg_field s start dir f sl ->
+      let (first,second) = norm_sl start dir sl in
+      s ^ "." ^ f ^ " (" ^ (show start) ^ ", " ^ (show dir) ^ ", " ^ (show first) ^ ", " ^ (show second) ^ ")"
+  | Reg_f_slice s start dir f (first1,second1) (first,second) ->
+      let (first,second) =
+        match dir with
+        | D_increasing -> (first,second)
+        | D_decreasing -> (start - first, start - second)
+        end in
+      s ^ "." ^ f ^ "]" ^ show first ^ (if (first = second) then "" else ".." ^ (show second)) ^ "]"
+  end
+
+instance (Show reg_name)
+  let show = stringFromReg_name
+end
+
+
+(* hex pp of integers, adapting the Lem string_extra.lem code *)
+val stringFromNaturalHexHelper : natural -> list char -> list char
+let rec stringFromNaturalHexHelper n acc =
+  if n = 0 then
+    acc
+  else
+    stringFromNaturalHexHelper (n / 16) (String_extra.chr (natFromNatural (let nd = n mod 16 in if nd <=9 then nd + 48 else nd - 10 + 97)) :: acc)
+
+val stringFromNaturalHex : natural -> string
+let (*~{ocaml;hol}*) stringFromNaturalHex n = 
+  if n = 0 then "0" else toString (stringFromNaturalHexHelper n [])
+
+val stringFromIntegerHex : integer -> string
+let (*~{ocaml}*) stringFromIntegerHex i = 
+  if i < 0 then 
+    "-" ^ stringFromNaturalHex (naturalFromInteger i)
+  else
+    stringFromNaturalHex (naturalFromInteger i)
+
+
+let stringFromAddress (Address bs i) = 
+  let i' = integer_of_byte_list bs in
+  if i=i' then
+(*TODO: ideally this should be made to match the src/pp.ml pp_address; the following very roughly matches what's used in the ppcmem UI, enough to make exceptions readable *)
+    if i < 65535 then 
+      show i 
+    else
+      stringFromIntegerHex i
+  else
+    "stringFromAddress bytes and integer mismatch"
+
+instance (Show address)
+  let show = stringFromAddress
+end
+
+let stringFromByte_lifted bl =
+  match byte_of_byte_lifted bl with
+  | Nothing -> "u?"  
+  | Just (Byte bits) -> 
+      let i = integer_of_bit_list bits in
+      show i
+  end
+
+instance (Show byte_lifted)
+  let show = stringFromByte_lifted
+end
+
+(* possible next instruction address options *)
+type nia = 
+  | NIA_successor
+  | NIA_concrete_address of address
+  | NIA_indirect_address
+
+let niaCompare n1 n2 = match (n1,n2) with
+  | (NIA_successor, NIA_successor) -> EQ
+  | (NIA_successor, _) -> LT
+  | (_, NIA_successor) -> GT
+  | (NIA_concrete_address a1, NIA_concrete_address a2) -> compare a1 a2
+  | (NIA_concrete_address _, _) -> LT
+  | (_, NIA_concrete_address _) -> GT
+  | (NIA_indirect_address, NIA_indirect_address) -> EQ
+  (* | (NIA_indirect_address, _) -> LT
+  | (_, NIA_indirect_address) -> GT *)
+  end
+
+instance (Ord nia)
+  let compare = niaCompare
+  let (<)  n1 n2 = (niaCompare n1 n2) = LT
+  let (<=) n1 n2 = (niaCompare n1 n2) <> GT
+  let (>)  n1 n2 = (niaCompare n1 n2) = GT
+  let (>=) n1 n2 = (niaCompare n1 n2) <> LT
+end
+
+let stringFromNia = function
+  | NIA_successor          -> "NIA_successor"
+  | NIA_concrete_address a -> "NIA_concrete_address " ^ show a
+  | NIA_indirect_address   -> "NIA_indirect_address"
+end
+
+instance (Show nia)
+  let show = stringFromNia
+end
+
+type dia =
+  | DIA_none
+  | DIA_concrete_address of address
+  | DIA_register of reg_name
+
+let diaCompare d1 d2 = match (d1, d2) with
+  | (DIA_none, DIA_none) -> EQ
+  | (DIA_none, _) -> LT
+  | (DIA_concrete_address a1, DIA_none) -> GT
+  | (DIA_concrete_address a1, DIA_concrete_address a2) -> compare a1 a2
+  | (DIA_concrete_address a1, _) -> LT
+  | (DIA_register r1, DIA_register r2) -> compare r1 r2
+  | (DIA_register _, _) -> GT
+end
+
+instance (Ord dia)
+  let compare = diaCompare
+  let (<)  n1 n2 = (diaCompare n1 n2) = LT
+  let (<=) n1 n2 = (diaCompare n1 n2) <> GT
+  let (>)  n1 n2 = (diaCompare n1 n2) = GT
+  let (>=) n1 n2 = (diaCompare n1 n2) <> LT
+end
+
+let stringFromDia = function
+  | DIA_none               ->  "DIA_none"
+  | DIA_concrete_address a ->  "DIA_concrete_address " ^ show a
+  | DIA_register r ->  "DIA_delayed_register " ^ show r
+end
+
+instance (Show dia)
+  let show = stringFromDia
+end
diff --git a/src/lem_interp/0.11/sail2_instr_kinds.lem b/src/lem_interp/0.11/sail2_instr_kinds.lem
new file mode 100644
index 00000000..f3cdfbc9
--- /dev/null
+++ b/src/lem_interp/0.11/sail2_instr_kinds.lem
@@ -0,0 +1,376 @@
+(*========================================================================*)
+(*     Sail                                                               *)
+(*                                                                        *)
+(*  Copyright (c) 2013-2017                                               *)
+(*    Kathyrn Gray                                                        *)
+(*    Shaked Flur                                                         *)
+(*    Stephen Kell                                                        *)
+(*    Gabriel Kerneis                                                     *)
+(*    Robert Norton-Wright                                                *)
+(*    Christopher Pulte                                                   *)
+(*    Peter Sewell                                                        *)
+(*    Alasdair Armstrong                                                  *)
+(*    Brian Campbell                                                      *)
+(*    Thomas Bauereiss                                                    *)
+(*    Anthony Fox                                                         *)
+(*    Jon French                                                          *)
+(*    Dominic Mulligan                                                    *)
+(*    Stephen Kell                                                        *)
+(*    Mark Wassell                                                        *)
+(*                                                                        *)
+(*  All rights reserved.                                                  *)
+(*                                                                        *)
+(*  This software was developed by the University of Cambridge Computer   *)
+(*  Laboratory as part of the Rigorous Engineering of Mainstream Systems  *)
+(*  (REMS) project, funded by EPSRC grant EP/K008528/1.                   *)
+(*                                                                        *)
+(*  Redistribution and use in source and binary forms, with or without    *)
+(*  modification, are permitted provided that the following conditions    *)
+(*  are met:                                                              *)
+(*  1. Redistributions of source code must retain the above copyright     *)
+(*     notice, this list of conditions and the following disclaimer.      *)
+(*  2. Redistributions in binary form must reproduce the above copyright  *)
+(*     notice, this list of conditions and the following disclaimer in    *)
+(*     the documentation and/or other materials provided with the         *)
+(*     distribution.                                                      *)
+(*                                                                        *)
+(*  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS''    *)
+(*  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED     *)
+(*  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A       *)
+(*  PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR   *)
+(*  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,          *)
+(*  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT      *)
+(*  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF      *)
+(*  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND   *)
+(*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,    *)
+(*  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT    *)
+(*  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF    *)
+(*  SUCH DAMAGE.                                                          *)
+(*========================================================================*)
+
+open import Pervasives_extra
+
+
+class ( EnumerationType 'a )
+  val toNat : 'a -> nat
+end
+
+
+val enumeration_typeCompare : forall 'a. EnumerationType 'a => 'a -> 'a -> ordering
+let ~{ocaml} enumeration_typeCompare e1 e2 =
+  compare (toNat e1) (toNat e2)
+let inline {ocaml} enumeration_typeCompare = defaultCompare
+
+
+default_instance forall 'a. EnumerationType 'a => (Ord 'a)
+  let compare = enumeration_typeCompare
+  let (<)  r1 r2 = (enumeration_typeCompare r1 r2) = LT
+  let (<=) r1 r2 = (enumeration_typeCompare r1 r2) <> GT
+  let (>)  r1 r2 = (enumeration_typeCompare r1 r2) = GT
+  let (>=) r1 r2 = (enumeration_typeCompare r1 r2) <> LT
+end
+
+
+(* Data structures for building up instructions *)
+
+(* careful: changes in the read/write/barrier kinds have to be
+   reflected in deep_shallow_convert *)
+type read_kind =
+  (* common reads *)
+  | Read_plain
+  (* Power reads *)
+  | Read_reserve
+  (* AArch64 reads *)
+  | Read_acquire | Read_exclusive | Read_exclusive_acquire | Read_stream
+  (* RISC-V reads *)
+  | Read_RISCV_acquire  | Read_RISCV_strong_acquire
+  | Read_RISCV_reserved | Read_RISCV_reserved_acquire
+  | Read_RISCV_reserved_strong_acquire
+  (* x86 reads *)
+  | Read_X86_locked (* the read part of a lock'd instruction (rmw) *)
+
+instance (Show read_kind)
+  let show = function
+    | Read_plain -> "Read_plain"
+    | Read_reserve -> "Read_reserve"
+    | Read_acquire -> "Read_acquire"
+    | Read_exclusive -> "Read_exclusive"
+    | Read_exclusive_acquire -> "Read_exclusive_acquire"
+    | Read_stream -> "Read_stream"
+    | Read_RISCV_acquire -> "Read_RISCV_acquire"
+    | Read_RISCV_strong_acquire -> "Read_RISCV_strong_acquire"
+    | Read_RISCV_reserved -> "Read_RISCV_reserved"
+    | Read_RISCV_reserved_acquire -> "Read_RISCV_reserved_acquire"
+    | Read_RISCV_reserved_strong_acquire -> "Read_RISCV_reserved_strong_acquire"
+    | Read_X86_locked -> "Read_X86_locked"
+  end
+end
+
+type write_kind =
+  (* common writes *)
+  | Write_plain
+  (* Power writes *)
+  | Write_conditional
+  (* AArch64 writes *)
+  | Write_release | Write_exclusive | Write_exclusive_release
+  (* RISC-V *)
+  | Write_RISCV_release     | Write_RISCV_strong_release
+  | Write_RISCV_conditional | Write_RISCV_conditional_release
+  | Write_RISCV_conditional_strong_release
+  (* x86 writes *)
+  | Write_X86_locked (* the write part of a lock'd instruction (rmw) *)
+
+instance (Show write_kind)
+  let show = function
+    | Write_plain -> "Write_plain"
+    | Write_conditional -> "Write_conditional"
+    | Write_release -> "Write_release"
+    | Write_exclusive -> "Write_exclusive"
+    | Write_exclusive_release -> "Write_exclusive_release"
+    | Write_RISCV_release -> "Write_RISCV_release"
+    | Write_RISCV_strong_release -> "Write_RISCV_strong_release"
+    | Write_RISCV_conditional -> "Write_RISCV_conditional"
+    | Write_RISCV_conditional_release -> "Write_RISCV_conditional_release"
+    | Write_RISCV_conditional_strong_release -> "Write_RISCV_conditional_strong_release"
+    | Write_X86_locked -> "Write_X86_locked"
+  end
+end
+
+type a64_barrier_domain =
+  A64_FullShare
+  | A64_InnerShare
+  | A64_OuterShare
+  | A64_NonShare
+
+type a64_barrier_type =
+  A64_barrier_all
+  | A64_barrier_LD
+  | A64_barrier_ST
+
+type barrier_kind =
+  (* Power barriers *)
+  Barrier_Sync of unit | Barrier_LwSync of unit | Barrier_Eieio of unit | Barrier_Isync of unit
+  (* AArch64 barriers *)
+  | Barrier_DMB of (a64_barrier_domain * a64_barrier_type)
+  | Barrier_DSB of (a64_barrier_domain * a64_barrier_type)
+  | Barrier_ISB of unit
+  | Barrier_TM_COMMIT of unit
+  (* MIPS barriers *)
+  | Barrier_MIPS_SYNC of unit
+  (* RISC-V barriers *)
+  | Barrier_RISCV_rw_rw of unit
+  | Barrier_RISCV_r_rw of unit
+  | Barrier_RISCV_r_r of unit
+  | Barrier_RISCV_rw_w of unit
+  | Barrier_RISCV_w_w of unit
+  | Barrier_RISCV_w_rw of unit
+  | Barrier_RISCV_rw_r of unit
+  | Barrier_RISCV_r_w of unit
+  | Barrier_RISCV_w_r of unit
+  | Barrier_RISCV_tso of unit
+  | Barrier_RISCV_i of unit
+  (* X86 *)
+  | Barrier_x86_MFENCE of unit
+
+let string_a64_barrier_domain = function
+  | A64_FullShare  -> "A64_FullShare"
+  | A64_InnerShare -> "A64_InnerShare"
+  | A64_OuterShare -> "A64_OuterShare"
+  | A64_NonShare   -> "A64_NonShare"
+end
+
+instance (Show a64_barrier_domain)
+  let show = string_a64_barrier_domain
+end
+
+let string_a64_barrier_type = function
+  | A64_barrier_all -> "A64_barrier_all"
+  | A64_barrier_LD  -> "A64_barrier_LD"
+  | A64_barrier_ST  -> "A64_barrier_ST"
+end
+
+instance (Show a64_barrier_type)
+  let show = string_a64_barrier_type
+end
+
+instance (Show barrier_kind)
+  let show = function
+    | Barrier_Sync () -> "Barrier_Sync"
+    | Barrier_LwSync () -> "Barrier_LwSync"
+    | Barrier_Eieio () -> "Barrier_Eieio"
+    | Barrier_Isync () -> "Barrier_Isync"
+    | Barrier_DMB (dom,typ) -> "Barrier_DMB (" ^ (show dom) ^ ", " ^ (show typ) ^ ")"
+    | Barrier_DSB (dom,typ) -> "Barrier_DSB (" ^ (show dom) ^ ", " ^ (show typ) ^ ")"
+    | Barrier_ISB () -> "Barrier_ISB"
+    | Barrier_TM_COMMIT () -> "Barrier_TM_COMMIT"
+    | Barrier_MIPS_SYNC () -> "Barrier_MIPS_SYNC"
+    | Barrier_RISCV_rw_rw () -> "Barrier_RISCV_rw_rw"
+    | Barrier_RISCV_r_rw ()  -> "Barrier_RISCV_r_rw"
+    | Barrier_RISCV_r_r ()   -> "Barrier_RISCV_r_r"
+    | Barrier_RISCV_rw_w ()  -> "Barrier_RISCV_rw_w"
+    | Barrier_RISCV_w_w ()   -> "Barrier_RISCV_w_w"
+    | Barrier_RISCV_w_rw ()  -> "Barrier_RISCV_w_rw"
+    | Barrier_RISCV_rw_r ()  -> "Barrier_RISCV_rw_r"
+    | Barrier_RISCV_r_w ()   -> "Barrier_RISCV_r_w"
+    | Barrier_RISCV_w_r ()   -> "Barrier_RISCV_w_r"
+    | Barrier_RISCV_tso ()   -> "Barrier_RISCV_tso"
+    | Barrier_RISCV_i ()     -> "Barrier_RISCV_i"
+    | Barrier_x86_MFENCE ()  -> "Barrier_x86_MFENCE"
+  end
+end
+
+type trans_kind =
+  (* AArch64 *)
+  | Transaction_start | Transaction_commit | Transaction_abort
+
+instance (Show trans_kind)
+  let show = function
+  | Transaction_start  -> "Transaction_start"
+  | Transaction_commit -> "Transaction_commit"
+  | Transaction_abort  -> "Transaction_abort"
+  end
+end
+
+(* cache maintenance instructions *)
+type cache_op_kind =
+  (* AArch64 DC *)
+  | Cache_op_D_IVAC | Cache_op_D_ISW  | Cache_op_D_CSW  |  Cache_op_D_CISW
+  | Cache_op_D_ZVA  | Cache_op_D_CVAC | Cache_op_D_CVAU | Cache_op_D_CIVAC
+  (* AArch64 IC *)
+  | Cache_op_I_IALLUIS | Cache_op_I_IALLU | Cache_op_I_IVAU
+
+instance (Show cache_op_kind)
+  let show = function
+  | Cache_op_D_IVAC    -> "Cache_op_D_IVAC"
+  | Cache_op_D_ISW     -> "Cache_op_D_ISW"
+  | Cache_op_D_CSW     -> "Cache_op_D_CSW"
+  | Cache_op_D_CISW    -> "Cache_op_D_CISW"
+  | Cache_op_D_ZVA     -> "Cache_op_D_ZVA"
+  | Cache_op_D_CVAC    -> "Cache_op_D_CVAC"
+  | Cache_op_D_CVAU    -> "Cache_op_D_CVAU"
+  | Cache_op_D_CIVAC   -> "Cache_op_D_CIVAC"
+  | Cache_op_I_IALLUIS -> "Cache_op_I_IALLUIS"
+  | Cache_op_I_IALLU   -> "Cache_op_I_IALLU"
+  | Cache_op_I_IVAU    -> "Cache_op_I_IVAU"
+  end
+end
+
+type instruction_kind =
+  | IK_barrier   of barrier_kind
+  | IK_mem_read  of read_kind
+  | IK_mem_write of write_kind
+  | IK_mem_rmw   of (read_kind * write_kind)
+  | IK_branch    of unit(* this includes conditional-branch (multiple nias, none of which is NIA_indirect_address),
+  indirect/computed-branch (single nia of kind NIA_indirect_address)
+  and branch/jump (single nia of kind NIA_concrete_address) *)
+  | IK_trans     of trans_kind
+  | IK_simple    of unit
+  | IK_cache_op  of cache_op_kind
+
+
+instance (Show instruction_kind)
+  let show = function
+    | IK_barrier barrier_kind -> "IK_barrier " ^ (show barrier_kind)
+    | IK_mem_read read_kind   -> "IK_mem_read " ^ (show read_kind)
+    | IK_mem_write write_kind -> "IK_mem_write " ^ (show write_kind)
+    | IK_mem_rmw (r, w)       -> "IK_mem_rmw " ^ (show r) ^ " " ^ (show w)
+    | IK_branch ()            -> "IK_branch"
+    | IK_trans trans_kind     -> "IK_trans " ^ (show trans_kind)
+    | IK_simple ()            -> "IK_simple"
+    | IK_cache_op cache_kind  -> "IK_cache_op " ^ (show cache_kind)
+  end
+end
+
+
+let read_is_exclusive = function
+  | Read_plain -> false
+  | Read_reserve -> true
+  | Read_acquire -> false
+  | Read_exclusive -> true
+  | Read_exclusive_acquire -> true
+  | Read_stream -> false
+  | Read_RISCV_acquire -> false
+  | Read_RISCV_strong_acquire -> false
+  | Read_RISCV_reserved -> true
+  | Read_RISCV_reserved_acquire -> true
+  | Read_RISCV_reserved_strong_acquire -> true
+  | Read_X86_locked -> true
+end
+
+
+
+instance (EnumerationType read_kind)
+  let toNat = function
+    | Read_plain -> 0
+    | Read_reserve -> 1
+    | Read_acquire -> 2
+    | Read_exclusive -> 3
+    | Read_exclusive_acquire -> 4
+    | Read_stream -> 5
+    | Read_RISCV_acquire -> 6
+    | Read_RISCV_strong_acquire -> 7
+    | Read_RISCV_reserved -> 8
+    | Read_RISCV_reserved_acquire -> 9
+    | Read_RISCV_reserved_strong_acquire -> 10
+    | Read_X86_locked -> 11
+  end
+end
+
+instance (EnumerationType write_kind)
+  let toNat = function
+    | Write_plain -> 0
+    | Write_conditional -> 1
+    | Write_release -> 2
+    | Write_exclusive -> 3
+    | Write_exclusive_release -> 4
+    | Write_RISCV_release -> 5
+    | Write_RISCV_strong_release -> 6
+    | Write_RISCV_conditional -> 7
+    | Write_RISCV_conditional_release -> 8
+    | Write_RISCV_conditional_strong_release -> 9
+    | Write_X86_locked -> 10
+  end
+end
+
+instance (EnumerationType a64_barrier_domain)
+  let toNat = function
+    | A64_FullShare  -> 0
+    | A64_InnerShare -> 1
+    | A64_OuterShare -> 2
+    | A64_NonShare   -> 3
+  end
+end
+
+instance (EnumerationType a64_barrier_type)
+  let toNat = function
+    | A64_barrier_all -> 0
+    | A64_barrier_LD  -> 1
+    | A64_barrier_ST  -> 2
+  end
+end
+
+instance (EnumerationType barrier_kind)
+  let toNat = function
+    | Barrier_Sync () -> 0
+    | Barrier_LwSync () -> 1
+    | Barrier_Eieio () -> 2
+    | Barrier_Isync () -> 3
+    | Barrier_DMB (dom,typ) -> 4  + (toNat dom) + (4 * (toNat typ)) (* 4-15 *)
+    | Barrier_DSB (dom,typ) -> 16 + (toNat dom) + (4 * (toNat typ)) (* 16-27 *)
+    | Barrier_ISB () -> 28
+    | Barrier_TM_COMMIT () -> 29
+    | Barrier_MIPS_SYNC () -> 30
+    | Barrier_RISCV_rw_rw () -> 31
+    | Barrier_RISCV_r_rw () -> 32
+    | Barrier_RISCV_r_r () -> 33
+    | Barrier_RISCV_rw_w () -> 34
+    | Barrier_RISCV_w_w () -> 35
+    | Barrier_RISCV_w_rw () -> 36
+    | Barrier_RISCV_rw_r () -> 37
+    | Barrier_RISCV_r_w () -> 38
+    | Barrier_RISCV_w_r () -> 39
+    | Barrier_RISCV_tso () -> 40
+    | Barrier_RISCV_i () -> 41
+    | Barrier_x86_MFENCE () -> 42
+  end
+end
diff --git a/src/lem_interp/interp_inter_imp.lem b/src/lem_interp/interp_inter_imp.lem
index 3413494e..74e43a8f 100644
--- a/src/lem_interp/interp_inter_imp.lem
+++ b/src/lem_interp/interp_inter_imp.lem
@@ -579,13 +579,74 @@ let instruction_analysis top_level end_flag thunk_name regn_to_reg_details regis
          | Interp_ast.V_ctor (Id_aux (Id "NIAFP_indirect_address") _) _ _ _ ->
             NIA_indirect_address
          | _ -> failwith "Register footprint analysis did not return nia of expected type" end in
+       let readk_to_readk = function
+                         | "Read_plain" ->             Read_plain
+                         | "Read_reserve" ->           Read_reserve
+                         | "Read_acquire" ->           Read_acquire
+                         | "Read_exclusive" ->         Read_exclusive
+                         | "Read_exclusive_acquire" -> Read_exclusive_acquire
+                         | "Read_stream" ->            Read_stream 
+                         | "Read_RISCV_acquire"                  -> Read_RISCV_acquire
+                         | "Read_RISCV_strong_acquire"           -> Read_RISCV_strong_acquire
+                         | "Read_RISCV_reserved"                 -> Read_RISCV_reserved
+                         | "Read_RISCV_reserved_acquire"         -> Read_RISCV_reserved_acquire
+                         | "Read_RISCV_reserved_strong_acquire"  -> Read_RISCV_reserved_strong_acquire
+                         | "Read_X86_locked"                     -> Read_X86_locked
+                         | r -> failwith ("unknown read kind: " ^ r) end in
+       let writek_to_writek = function
+                         | "Write_plain" ->             Write_plain
+                         | "Write_conditional" ->       Write_conditional
+                         | "Write_release" ->           Write_release
+                         | "Write_exclusive" ->         Write_exclusive
+                         | "Write_exclusive_release" -> Write_exclusive_release 
+                         | "Write_RISCV_release"                    -> Write_RISCV_release
+                         | "Write_RISCV_strong_release"             -> Write_RISCV_strong_release
+                         | "Write_RISCV_conditional"                -> Write_RISCV_conditional
+                         | "Write_RISCV_conditional_release"        -> Write_RISCV_conditional_release
+                         | "Write_RISCV_conditional_strong_release" -> Write_RISCV_conditional_strong_release
+                         | "Write_X86_locked"                       -> Write_X86_locked
+                         | w -> failwith ("unknown write kind: " ^ w) end in
+       let ik_to_ik = function
+         | Interp_ast.V_ctor (Id_aux (Id "IK_barrier") _) _ _
+           (Interp_ast.V_ctor (Id_aux (Id b) _) _ _ _) ->
+            IK_barrier (match b with
+                        | "Barrier_Sync" ->   Barrier_Sync
+                        | "Barrier_LwSync" -> Barrier_LwSync
+                        | "Barrier_Eieio" ->  Barrier_Eieio
+                        | "Barrier_Isync" ->  Barrier_Isync
+                        | "Barrier_DMB" ->    Barrier_DMB
+                        | "Barrier_DMB_ST" -> Barrier_DMB_ST
+                        | "Barrier_DMB_LD" -> Barrier_DMB_LD
+                        | "Barrier_DSB" ->    Barrier_DSB
+                        | "Barrier_DSB_ST" -> Barrier_DSB_ST
+                        | "Barrier_DSB_LD" -> Barrier_DSB_LD
+                        | "Barrier_ISB" ->    Barrier_ISB
+                        | "Barrier_MIPS_SYNC" -> Barrier_MIPS_SYNC
+                        | "Barrier_x86_MFENCE" -> Barrier_x86_MFENCE
+                        end)
+         | Interp_ast.V_ctor (Id_aux (Id "IK_mem_read") _) _ _
+           (Interp_ast.V_ctor (Id_aux (Id r) _) _ _ _) ->
+            IK_mem_read(readk_to_readk r)
+         | Interp_ast.V_ctor (Id_aux (Id "IK_mem_write") _) _ _
+           (Interp_ast.V_ctor (Id_aux (Id w) _) _ _ _) ->
+            IK_mem_write(writek_to_writek w)
+         | Interp_ast.V_ctor (Id_aux (Id "IK_mem_rmw") _) _ _
+           (Interp_ast.V_tuple [(Interp_ast.V_ctor (Id_aux (Id readk) _) _ _ _) ;
+                                (Interp_ast.V_ctor (Id_aux (Id writek) _) _ _ _)]) ->
+            IK_mem_rmw(readk_to_readk readk, writek_to_writek writek)
+         | Interp_ast.V_ctor (Id_aux (Id "IK_branch") _) _ _ _ ->
+            IK_branch
+         | Interp_ast.V_ctor (Id_aux (Id "IK_simple") _) _ _ _ ->
+            IK_simple
+         | _ -> failwith "Analysis returned unexpected instruction kind"
+       end in
        let (regs1,regs2,regs3,nias,dia,ik) =
          (List.map reg_to_reg_name regs1,
           List.map reg_to_reg_name regs2,
           List.map reg_to_reg_name regs3,
           List.map nia_to_nia nias,
           dia_to_dia dia,
-          fromInterpValue ik) in
+          ik_to_ik ik) in
        ((regs1,regs2,regs3,nias,dia,ik), events)
      | _ -> Assert_extra.failwith "Analysis did not return a four-tuple of lists" end)
   | Ivh_value_after_exn _ -> Assert_extra.failwith "Instruction analysis failed"
diff --git a/src/lem_interp/sail2_instr_kinds.lem b/src/lem_interp/sail2_instr_kinds.lem
index f3cdfbc9..bd3a3eb7 100644
--- a/src/lem_interp/sail2_instr_kinds.lem
+++ b/src/lem_interp/sail2_instr_kinds.lem
@@ -136,86 +136,58 @@ instance (Show write_kind)
   end
 end
 
-type a64_barrier_domain =
-  A64_FullShare
-  | A64_InnerShare
-  | A64_OuterShare
-  | A64_NonShare
-
-type a64_barrier_type =
-  A64_barrier_all
-  | A64_barrier_LD
-  | A64_barrier_ST
-
 type barrier_kind =
   (* Power barriers *)
-  Barrier_Sync of unit | Barrier_LwSync of unit | Barrier_Eieio of unit | Barrier_Isync of unit
+  Barrier_Sync | Barrier_LwSync | Barrier_Eieio | Barrier_Isync
   (* AArch64 barriers *)
-  | Barrier_DMB of (a64_barrier_domain * a64_barrier_type)
-  | Barrier_DSB of (a64_barrier_domain * a64_barrier_type)
-  | Barrier_ISB of unit
-  | Barrier_TM_COMMIT of unit
+  | Barrier_DMB | Barrier_DMB_ST | Barrier_DMB_LD | Barrier_DSB
+  | Barrier_DSB_ST | Barrier_DSB_LD | Barrier_ISB
+  | Barrier_TM_COMMIT
   (* MIPS barriers *)
-  | Barrier_MIPS_SYNC of unit
+  | Barrier_MIPS_SYNC
   (* RISC-V barriers *)
-  | Barrier_RISCV_rw_rw of unit
-  | Barrier_RISCV_r_rw of unit
-  | Barrier_RISCV_r_r of unit
-  | Barrier_RISCV_rw_w of unit
-  | Barrier_RISCV_w_w of unit
-  | Barrier_RISCV_w_rw of unit
-  | Barrier_RISCV_rw_r of unit
-  | Barrier_RISCV_r_w of unit
-  | Barrier_RISCV_w_r of unit
-  | Barrier_RISCV_tso of unit
-  | Barrier_RISCV_i of unit
+  | Barrier_RISCV_rw_rw
+  | Barrier_RISCV_r_rw
+  | Barrier_RISCV_r_r
+  | Barrier_RISCV_rw_w
+  | Barrier_RISCV_w_w
+  | Barrier_RISCV_w_rw
+  | Barrier_RISCV_rw_r
+  | Barrier_RISCV_r_w
+  | Barrier_RISCV_w_r
+  | Barrier_RISCV_tso
+  | Barrier_RISCV_i
   (* X86 *)
-  | Barrier_x86_MFENCE of unit
+  | Barrier_x86_MFENCE
 
-let string_a64_barrier_domain = function
-  | A64_FullShare  -> "A64_FullShare"
-  | A64_InnerShare -> "A64_InnerShare"
-  | A64_OuterShare -> "A64_OuterShare"
-  | A64_NonShare   -> "A64_NonShare"
-end
-
-instance (Show a64_barrier_domain)
-  let show = string_a64_barrier_domain
-end
-
-let string_a64_barrier_type = function
-  | A64_barrier_all -> "A64_barrier_all"
-  | A64_barrier_LD  -> "A64_barrier_LD"
-  | A64_barrier_ST  -> "A64_barrier_ST"
-end
-
-instance (Show a64_barrier_type)
-  let show = string_a64_barrier_type
-end
 
 instance (Show barrier_kind)
   let show = function
-    | Barrier_Sync () -> "Barrier_Sync"
-    | Barrier_LwSync () -> "Barrier_LwSync"
-    | Barrier_Eieio () -> "Barrier_Eieio"
-    | Barrier_Isync () -> "Barrier_Isync"
-    | Barrier_DMB (dom,typ) -> "Barrier_DMB (" ^ (show dom) ^ ", " ^ (show typ) ^ ")"
-    | Barrier_DSB (dom,typ) -> "Barrier_DSB (" ^ (show dom) ^ ", " ^ (show typ) ^ ")"
-    | Barrier_ISB () -> "Barrier_ISB"
-    | Barrier_TM_COMMIT () -> "Barrier_TM_COMMIT"
-    | Barrier_MIPS_SYNC () -> "Barrier_MIPS_SYNC"
-    | Barrier_RISCV_rw_rw () -> "Barrier_RISCV_rw_rw"
-    | Barrier_RISCV_r_rw ()  -> "Barrier_RISCV_r_rw"
-    | Barrier_RISCV_r_r ()   -> "Barrier_RISCV_r_r"
-    | Barrier_RISCV_rw_w ()  -> "Barrier_RISCV_rw_w"
-    | Barrier_RISCV_w_w ()   -> "Barrier_RISCV_w_w"
-    | Barrier_RISCV_w_rw ()  -> "Barrier_RISCV_w_rw"
-    | Barrier_RISCV_rw_r ()  -> "Barrier_RISCV_rw_r"
-    | Barrier_RISCV_r_w ()   -> "Barrier_RISCV_r_w"
-    | Barrier_RISCV_w_r ()   -> "Barrier_RISCV_w_r"
-    | Barrier_RISCV_tso ()   -> "Barrier_RISCV_tso"
-    | Barrier_RISCV_i ()     -> "Barrier_RISCV_i"
-    | Barrier_x86_MFENCE ()  -> "Barrier_x86_MFENCE"
+    | Barrier_Sync -> "Barrier_Sync"
+    | Barrier_LwSync -> "Barrier_LwSync"
+    | Barrier_Eieio -> "Barrier_Eieio"
+    | Barrier_Isync -> "Barrier_Isync"
+    | Barrier_DMB -> "Barrier_DMB"
+    | Barrier_DMB_ST -> "Barrier_DMB_ST"
+    | Barrier_DMB_LD -> "Barrier_DMB_LD"
+    | Barrier_DSB -> "Barrier_DSB"
+    | Barrier_DSB_ST -> "Barrier_DSB_ST"
+    | Barrier_DSB_LD -> "Barrier_DSB_LD"
+    | Barrier_ISB -> "Barrier_ISB"
+    | Barrier_TM_COMMIT -> "Barrier_TM_COMMIT"
+    | Barrier_MIPS_SYNC -> "Barrier_MIPS_SYNC"
+    | Barrier_RISCV_rw_rw -> "Barrier_RISCV_rw_rw"
+    | Barrier_RISCV_r_rw  -> "Barrier_RISCV_r_rw"
+    | Barrier_RISCV_r_r   -> "Barrier_RISCV_r_r"
+    | Barrier_RISCV_rw_w  -> "Barrier_RISCV_rw_w"
+    | Barrier_RISCV_w_w   -> "Barrier_RISCV_w_w"
+    | Barrier_RISCV_w_rw  -> "Barrier_RISCV_w_rw"
+    | Barrier_RISCV_rw_r  -> "Barrier_RISCV_rw_r"
+    | Barrier_RISCV_r_w   -> "Barrier_RISCV_r_w"
+    | Barrier_RISCV_w_r   -> "Barrier_RISCV_w_r"
+    | Barrier_RISCV_tso   -> "Barrier_RISCV_tso"
+    | Barrier_RISCV_i     -> "Barrier_RISCV_i"
+    | Barrier_x86_MFENCE  -> "Barrier_x86_MFENCE"
   end
 end
 
@@ -332,45 +304,32 @@ instance (EnumerationType write_kind)
   end
 end
 
-instance (EnumerationType a64_barrier_domain)
-  let toNat = function
-    | A64_FullShare  -> 0
-    | A64_InnerShare -> 1
-    | A64_OuterShare -> 2
-    | A64_NonShare   -> 3
-  end
-end
-
-instance (EnumerationType a64_barrier_type)
-  let toNat = function
-    | A64_barrier_all -> 0
-    | A64_barrier_LD  -> 1
-    | A64_barrier_ST  -> 2
-  end
-end
-
 instance (EnumerationType barrier_kind)
   let toNat = function
-    | Barrier_Sync () -> 0
-    | Barrier_LwSync () -> 1
-    | Barrier_Eieio () -> 2
-    | Barrier_Isync () -> 3
-    | Barrier_DMB (dom,typ) -> 4  + (toNat dom) + (4 * (toNat typ)) (* 4-15 *)
-    | Barrier_DSB (dom,typ) -> 16 + (toNat dom) + (4 * (toNat typ)) (* 16-27 *)
-    | Barrier_ISB () -> 28
-    | Barrier_TM_COMMIT () -> 29
-    | Barrier_MIPS_SYNC () -> 30
-    | Barrier_RISCV_rw_rw () -> 31
-    | Barrier_RISCV_r_rw () -> 32
-    | Barrier_RISCV_r_r () -> 33
-    | Barrier_RISCV_rw_w () -> 34
-    | Barrier_RISCV_w_w () -> 35
-    | Barrier_RISCV_w_rw () -> 36
-    | Barrier_RISCV_rw_r () -> 37
-    | Barrier_RISCV_r_w () -> 38
-    | Barrier_RISCV_w_r () -> 39
-    | Barrier_RISCV_tso () -> 40
-    | Barrier_RISCV_i () -> 41
-    | Barrier_x86_MFENCE () -> 42
+    | Barrier_Sync -> 0
+    | Barrier_LwSync -> 1
+    | Barrier_Eieio ->2
+    | Barrier_Isync -> 3
+    | Barrier_DMB -> 4
+    | Barrier_DMB_ST -> 5
+    | Barrier_DMB_LD -> 6
+    | Barrier_DSB -> 7
+    | Barrier_DSB_ST -> 8
+    | Barrier_DSB_LD -> 9
+    | Barrier_ISB -> 10
+    | Barrier_TM_COMMIT -> 11
+    | Barrier_MIPS_SYNC -> 12
+    | Barrier_RISCV_rw_rw -> 13
+    | Barrier_RISCV_r_rw -> 14
+    | Barrier_RISCV_r_r -> 15
+    | Barrier_RISCV_rw_w -> 16
+    | Barrier_RISCV_w_w -> 17
+    | Barrier_RISCV_w_rw -> 18
+    | Barrier_RISCV_rw_r -> 19
+    | Barrier_RISCV_r_w -> 20
+    | Barrier_RISCV_w_r -> 21
+    | Barrier_RISCV_tso -> 22
+    | Barrier_RISCV_i -> 23
+    | Barrier_x86_MFENCE -> 24
   end
 end
diff --git a/src/optimize.ml b/src/optimize.ml
index 1fc2fbe8..b0d05bef 100644
--- a/src/optimize.ml
+++ b/src/optimize.ml
@@ -52,43 +52,57 @@ open Ast
 open Ast_util
 open Rewriter
 
+let rec split_at_function' id defs acc =
+  match defs with
+  | [] -> None
+  | ([def], env) :: defs when is_fundef id def -> Some (acc, (def, env), defs)
+  | (def, env) :: defs -> split_at_function' id defs ((def, env) :: acc)
+
+let split_at_function id defs =
+  match split_at_function' id defs [] with
+  | None -> None
+  | Some (pre_defs, def, post_defs) ->
+     Some (List.rev pre_defs, def, post_defs)
+
 let recheck (Defs defs) =
   let defs = Type_check.check_with_envs Type_check.initial_env defs in
 
   let rec find_optimizations = function
-    | ([DEF_pragma ("optimize", pragma, p_l)], env)
-      :: ([DEF_spec vs as def1], _)
-      :: ([DEF_fundef fdef as def2], _)
-      :: defs ->
+    | ([DEF_pragma ("optimize", pragma, p_l)], env) :: ([DEF_spec vs as def1], _) :: defs ->
        let id = id_of_val_spec vs in
        let args = Str.split (Str.regexp " +") (String.trim pragma) in
        begin match args with
        | ["unroll"; n]->
           let n = int_of_string n in
+          begin match split_at_function id defs with
+          | Some (intervening_defs, ((DEF_fundef fdef as def2, _)), defs) ->
+             let rw_app subst (fn, args) =
+               if Id.compare id fn = 0 then E_app (subst, args) else E_app (fn, args)
+             in
+             let rw_exp subst = { id_exp_alg with e_app = rw_app subst } in
+             let rw_defs subst = { rewriters_base with rewrite_exp = (fun _ -> fold_exp (rw_exp subst)) } in
 
-          let rw_app subst (fn, args) =
-            if Id.compare id fn = 0 then E_app (subst, args) else E_app (fn, args)
-          in
-          let rw_exp subst = { id_exp_alg with e_app = rw_app subst } in
-          let rw_defs subst = { rewriters_base with rewrite_exp = (fun _ -> fold_exp (rw_exp subst)) } in
-
-          let specs = ref [def1] in
-          let bodies = ref [rewrite_def (rw_defs (append_id id "_unroll_1")) def2] in
+             let specs = ref [def1] in
+             let bodies = ref [rewrite_def (rw_defs (append_id id "_unroll_1")) def2] in
 
-          for i = 1 to n do
-            let current_id = append_id id ("_unroll_" ^ string_of_int i) in
-            let next_id = if i = n then current_id else append_id id ("_unroll_" ^ string_of_int (i + 1)) in
-            (* Create a valspec for the new unrolled function *)
-            specs := !specs @ [DEF_spec (rename_valspec current_id vs)];
-            (* Then duplicate it's function body and make it call the next unrolled function *)
-            bodies := !bodies @ [rewrite_def (rw_defs next_id) (DEF_fundef (rename_fundef current_id fdef))]
-          done;
+             for i = 1 to n do
+               let current_id = append_id id ("_unroll_" ^ string_of_int i) in
+               let next_id = if i = n then current_id else append_id id ("_unroll_" ^ string_of_int (i + 1)) in
+               (* Create a valspec for the new unrolled function *)
+               specs := !specs @ [DEF_spec (rename_valspec current_id vs)];
+               (* Then duplicate it's function body and make it call the next unrolled function *)
+               bodies := !bodies @ [rewrite_def (rw_defs next_id) (DEF_fundef (rename_fundef current_id fdef))]
+             done;
 
-          !specs @ !bodies @ find_optimizations defs
+             !specs @ List.concat (List.map fst intervening_defs) @ !bodies @ find_optimizations defs
 
+          | _ ->
+             Reporting.warn "Could not find function body for unroll pragma at " p_l "";
+             def1 :: find_optimizations defs
+          end
        | _ ->
           Reporting.warn "Unrecognised optimize pragma at" p_l "";
-          def1 :: def2 :: find_optimizations defs
+          def1 :: find_optimizations defs
        end
 
     | (defs, _) :: defs' ->
diff --git a/src/sail.ml b/src/sail.ml
index b15e1746..516b3726 100644
--- a/src/sail.ml
+++ b/src/sail.ml
@@ -414,6 +414,9 @@ let load_files ?check:(check=false) type_envs files =
   else
     let ast = Scattered.descatter ast in
     let ast, type_envs = rewrite_ast_initial type_envs ast in
+    (* Recheck after descattering so that the internal type environments always
+       have complete variant types *)
+    let ast, type_envs = Type_error.check Type_check.initial_env ast in
 
     let out_name = match !opt_file_out with
       | None when parsed = [] -> "out.sail"