diff --git a/compiler/backend/Holmakefile b/compiler/backend/Holmakefile
index 2e0936b5e2..aec2a6de26 100644
--- a/compiler/backend/Holmakefile
+++ b/compiler/backend/Holmakefile
@@ -1,6 +1,7 @@
 INCLUDES = $(HOLDIR)/examples/machine-code/multiword\
 					 $(CAKEMLDIR)/misc $(CAKEMLDIR)/semantics $(CAKEMLDIR)/semantics/proofs\
 					 $(CAKEMLDIR)/basis/pure\
+					 pattern_matching\
 					 ../encoders/asm reg_alloc reachability
 
 all: $(DEFAULT_TARGETS) README.md
diff --git a/compiler/backend/README.md b/compiler/backend/README.md
index c6a7c259c0..9b607382f7 100644
--- a/compiler/backend/README.md
+++ b/compiler/backend/README.md
@@ -178,15 +178,14 @@ replaces it with an alloc call with 0.
 [flat_elimScript.sml](flat_elimScript.sml):
 Implementation for flatLang dead-code elimination.
 
-[flat_exh_matchScript.sml](flat_exh_matchScript.sml):
-This compiler phase ensures that all pattern matches are exhaustive.
+[flat_patternScript.sml](flat_patternScript.sml):
+Interface between flatLang and pattern compiler.
 
-[flat_reorder_matchScript.sml](flat_reorder_matchScript.sml):
-This compiler phase reorders patterns in pattern matches to improve
-code quality.
-
-[flat_to_patScript.sml](flat_to_patScript.sml):
-This phase performs pattern-match compilation.
+[flat_to_closScript.sml](flat_to_closScript.sml):
+Compilation from flatLang to closLang. This compiler phase converts
+explicit variable names of flatLang to de Bruijn indexing of
+closLang. It also makes all division-by-zero and out-of-bounds
+exceptions raised explicitly.
 
 [flat_uncheck_ctorsScript.sml](flat_uncheck_ctorsScript.sml):
 This compiler phase replaces tuples with constructors (with tag 0).
@@ -220,17 +219,8 @@ compiler configuration.
 [mips](mips):
 This directory contains the mips-specific part of the compiler backend.
 
-[patLangScript.sml](patLangScript.sml):
-The patLang intermediate language follows immediately after
-pattern-match compilation from flatLang. The patLang language
-differs from earlier languages in that it uses de Bruijn indices
-for variable names.
-
-[pat_to_closScript.sml](pat_to_closScript.sml):
-The translation from patLang to closLang is very simple.
-Its main purpose is simplifying the semantics of some operations,
-for example to explicitly raise an exception for Div so the semantics
-in closLang can make more assumptions about the arguments.
+[pattern_matching](pattern_matching):
+The CakeML pattern matching expressions compiler
 
 [presLangScript.sml](presLangScript.sml):
 Functions for converting various intermediate languages
diff --git a/compiler/backend/backendComputeLib.sml b/compiler/backend/backendComputeLib.sml
index b1e3c63b84..1b25bacd03 100644
--- a/compiler/backend/backendComputeLib.sml
+++ b/compiler/backend/backendComputeLib.sml
@@ -26,6 +26,7 @@ val add_backend_compset = computeLib.extend_compset
   [computeLib.Tys
     [ (* ---- configurations ---- *)
      ``:source_to_flat$config``
+    ,``:flat_pattern$config``
     ,``:clos_to_bvl$config``
     ,``:bvl_to_bvi$config``
     ,``:data_to_word$config``
@@ -72,16 +73,29 @@ val add_backend_compset = computeLib.extend_compset
     [ (* ---- source_to_flat ---- *)
      flatLangTheory.bool_id_def
     ,flatLangTheory.Bool_def
+    ,miscTheory.enumerate_def
     ]
   ,computeLib.Defs (theory_computes "source_to_flat")
       (* ---- flat_elim ---- *)
   ,computeLib.Defs (theory_computes "flat_elim")
+  ,computeLib.Defs (theory_computes "flat_pattern")
+  ,computeLib.Defs (theory_computes "flatLang")
+  ,computeLib.Defs (theory_computes "pattern_semantics")
+  ,computeLib.Defs (theory_computes "pattern_comp")
   ,computeLib.Defs (theory_computes "reachable_spt")
   ,computeLib.Tys
     [``:flatLang$op``
     ,``:flatLang$pat``
     ,``:flatLang$exp``
     ,``:flatLang$dec``
+    ,``:pattern_semantics$pat``
+    ,``:pattern_semantics$dTest``
+    ,``:pattern_semantics$dGuard``
+    ,``:pattern_semantics$dTree``
+    ,``:pattern_semantics$term``
+    ,``:pattern_common$position``
+    ,``:pattern_common$pmatchResult``
+    ,``:pattern_common$matchResult``
     ,``:source_to_flat$environment``
     ,``:source_to_flat$next_indices``
     ,``:source_to_flat$config``
@@ -93,27 +107,15 @@ val add_backend_compset = computeLib.extend_compset
 
   ,computeLib.Defs (theory_computes "flat_uncheck_ctors")
 
-  ,computeLib.Tys
-    [ (* ---- patLang ---- *)
-     ``:patLang$exp``
-    ,``:patLang$op``
-    ]
+  ,computeLib.Defs (theory_computes "flat_to_clos")
 
-      (* ---- flat_to_pat ---- *)
-  ,computeLib.Defs
-    [flat_to_patTheory.Bool_def
-    ,flat_to_patTheory.isBool_def
-    ,flat_to_patTheory.sIf_def
-    ,flat_to_patTheory.pure_op_op_eqn (* could put this in the compute set and avoid listing explicitly *)
-    ,flat_to_patTheory.pure_op_def
-    ,flat_to_patTheory.pure_def
-    ,flat_to_patTheory.ground_def
-    ,flat_to_patTheory.sLet_def
-    ,flat_to_patTheory.Let_Els_compute
-    ,flat_to_patTheory.compile_pat_def
-    ,flat_to_patTheory.compile_row_def
-    ,flat_to_patTheory.compile_exp_def
-    ,flat_to_patTheory.compile_def
+  ,computeLib.Tys
+    [``:closLang$exp``
+    ,``:closLang$op``
+    ,``:clos_known$val_approx``
+    ,``:clos_known$globalOpt``
+    ,``:clos_known$inliningDecision``
+    ,``:clos_known$config``
     ]
 
   ,computeLib.Tys
@@ -128,13 +130,6 @@ val add_backend_compset = computeLib.extend_compset
   ,computeLib.Defs
     [closLangTheory.pure_def
     ,closLangTheory.pure_op_def
-      (* ---- pat_to_clos ---- *)
-    ,pat_to_closTheory.dest_WordToInt_def
-    ,pat_to_closTheory.CopyByteStr_def
-    ,pat_to_closTheory.CopyByteAw8_def
-    ,pat_to_closTheory.vector_tag_def
-    ,pat_to_closTheory.compile_def
-      (*,pat_to_closTheory.pat_tag_shift_def*)
       (* ---- clos_mti ---- *)
     ,clos_mtiTheory.intro_multi_def
     ,clos_mtiTheory.collect_args_def
diff --git a/compiler/backend/backendScript.sml b/compiler/backend/backendScript.sml
index 8c33d88b5a..24936800de 100644
--- a/compiler/backend/backendScript.sml
+++ b/compiler/backend/backendScript.sml
@@ -6,8 +6,7 @@
 
 open preamble
      source_to_flatTheory
-     flat_to_patTheory
-     pat_to_closTheory
+     flat_to_closTheory
      clos_to_bvlTheory
      bvl_to_bviTheory
      bvi_to_dataTheory
@@ -46,12 +45,9 @@ val compile_tap_def = Define`
     let td = tap_flat c.tap_conf p [] in
     let _ = empty_ffi (strlit "finished: source_to_flat") in
     let c = c with source_conf := c' in
-    let p = flat_to_pat$compile p in
-    let td = tap_pat c.tap_conf p td in
-    let _ = empty_ffi (strlit "finished: flat_to_pat") in
-    let p = MAP pat_to_clos$compile p in
+    let p = flat_to_clos$compile_decs p in
     let td = tap_clos c.tap_conf p td in
-    let _ = empty_ffi (strlit "finished: pat_to_clos") in
+    let _ = empty_ffi (strlit "finished: flat_to_clos") in
     let (c',p) = clos_to_bvl$compile c.clos_conf p in
     let c = c with clos_conf := c' in
     let _ = empty_ffi (strlit "finished: clos_to_bvl") in
@@ -87,16 +83,10 @@ val to_flat_def = Define`
     let c = c with source_conf := c' in
     (c,p)`;
 
-val to_pat_def = Define`
-  to_pat c p =
-  let (c,p) = to_flat c p in
-  let p = flat_to_pat$compile p in
-  (c,p)`;
-
 val to_clos_def = Define`
   to_clos c p =
-  let (c,p) = to_pat c p in
-  let p = MAP pat_to_clos$compile p in
+  let (c,p) = to_flat c p in
+  let p = flat_to_clos$compile_decs p in
   (c,p)`;
 
 val to_bvl_def = Define`
@@ -160,7 +150,6 @@ Proof
      to_bvi_def,
      to_bvl_def,
      to_clos_def,
-     to_pat_def,
      to_flat_def] >>
   unabbrev_all_tac >>
   rpt (CHANGED_TAC (srw_tac[][] >> full_simp_tac(srw_ss())[] >> srw_tac[][] >> rev_full_simp_tac(srw_ss())[]))
@@ -215,15 +204,10 @@ val from_clos_def = Define`
   let c = c with clos_conf := c' in
   from_bvl c p`;
 
-val from_pat_def = Define`
-  from_pat c p =
-  let p = MAP pat_to_clos$compile p in
-  from_clos c p`;
-
 val from_flat_def = Define`
   from_flat c p =
-  let p = flat_to_pat$compile p in
-  from_pat c p`;
+  let p = flat_to_clos$compile_decs p in
+  from_clos c p`;
 
 val from_source_def = Define`
   from_source c p =
@@ -243,7 +227,6 @@ Proof
      from_bvi_def,
      from_bvl_def,
      from_clos_def,
-     from_pat_def,
      from_flat_def] >>
   unabbrev_all_tac >>
   rpt (CHANGED_TAC (srw_tac[][] >> full_simp_tac(srw_ss())[] >> srw_tac[][] >> rev_full_simp_tac(srw_ss())[]))
@@ -307,7 +290,6 @@ Proof
      to_bvi_def,
      to_bvl_def,
      to_clos_def,
-     to_pat_def,
      to_flat_def,to_livesets_def] >>
   fs[compile_def,compile_tap_def]>>
   pairarg_tac>>
@@ -352,7 +334,6 @@ Proof
      to_bvi_def,
      to_bvl_def,
      to_clos_def,
-     to_pat_def,
      to_flat_def,to_livesets_def] >>
   unabbrev_all_tac>>fs[]>>
   rpt(rfs[]>>fs[])
@@ -370,7 +351,7 @@ Theorem to_data_change_config:
                  bvl_conf := c1'.bvl_conf |>,
       prog')
 Proof
-  rw[to_data_def,to_bvi_def,to_bvl_def,to_clos_def,to_pat_def,to_flat_def]
+  rw[to_data_def,to_bvi_def,to_bvl_def,to_clos_def,to_flat_def]
   \\ rpt (pairarg_tac \\ fs[]) \\ rw[] \\ fs[] \\ rfs[] \\ rveq \\ fs[] \\ rfs[] \\ rveq \\ fs[]
   \\ simp[config_component_equality]
 QED
diff --git a/compiler/backend/bvl_to_bviScript.sml b/compiler/backend/bvl_to_bviScript.sml
index 9996cb283f..995378429b 100644
--- a/compiler/backend/bvl_to_bviScript.sml
+++ b/compiler/backend/bvl_to_bviScript.sml
@@ -120,7 +120,7 @@ val ConcatByte_location_eq = save_thm("ConcatByte_location_eq",
 val AllocGlobal_code_def = Define`
   AllocGlobal_code = (0:num,
     Let [Op GlobalsPtr []]
-     (Let [Op Deref [Op (Const 0) []; Var 0]]
+     (Let [Op El [Op (Const 0) []; Var 0]]
        (Let [Op Update [Op Add [Var 0; Op(Const 1)[]]; Op (Const 0) []; Var 1]]
          (Let [Op Length [Var 2]]
            (If (Op Less [Var 0; Var 2]) (Var 1)
@@ -130,7 +130,7 @@ val AllocGlobal_code_def = Define`
 
 val CopyGlobals_code_def = Define`
   CopyGlobals_code = (3:num, (* ptr to new array, ptr to old array, index to copy *)
-    Let [Op Update [Op Deref [Var 2; Var 1]; Var 2; Var 0]]
+    Let [Op Update [Op El [Var 2; Var 1]; Var 2; Var 0]]
       (If (Op Equal [Op(Const 0)[]; Var 3]) (Var 0)
         (Call 0 (SOME CopyGlobals_location) [Var 1; Var 2; Op Sub [Op(Const 1)[];Var 3]] NONE)))`;
 
@@ -209,7 +209,7 @@ local val compile_op_quotation = `
     dtcase op of
     | Const i => (dtcase c1 of [] => compile_int i
                   | _ => Let [Op (Const 0) c1] (compile_int i))
-    | Global n => Op Deref (c1++[compile_int(&(n+1)); Op GlobalsPtr []])
+    | Global n => Op El (c1++[compile_int(&(n+1)); Op GlobalsPtr []])
     | SetGlobal n => Op Update (c1++[compile_int(&(n+1)); Op GlobalsPtr []])
     | AllocGlobal =>
         (dtcase c1 of [] => Call 0 (SOME AllocGlobal_location) [] NONE
diff --git a/compiler/backend/closLangScript.sml b/compiler/backend/closLangScript.sml
index 66dba54b82..863ee7b4ef 100644
--- a/compiler/backend/closLangScript.sml
+++ b/compiler/backend/closLangScript.sml
@@ -25,7 +25,7 @@ val _ = Datatype `
                         indicating the first element, and how many, should be
                         copied into the end of the new block. The fourth
                         argument is the total size of the new block. *)
-     | El            (* read Block field index *)
+     | El            (* read Block field index or loads a value from a reference *)
      | LengthBlock   (* get length of Block *)
      | Length        (* get length of reference *)
      | LengthByte    (* get length of byte array *)
@@ -43,9 +43,9 @@ val _ = Datatype `
      | LengthByteVec (* get length of ByteVector *)
      | DerefByteVec  (* load a byte from a ByteVector *)
      | TagLenEq num num (* check Block's tag and length *)
+     | LenEq num     (* check Block's length *)
      | TagEq num     (* check Block's tag *)
      | Ref           (* makes a reference *)
-     | Deref         (* loads a value from a reference *)
      | Update        (* updates a reference *)
      | Label num     (* constructs a CodePtr *)
      | FFI string    (* calls the FFI *)
diff --git a/compiler/backend/clos_to_bvlScript.sml b/compiler/backend/clos_to_bvlScript.sml
index 1bd59cd932..df11f8fd33 100644
--- a/compiler/backend/clos_to_bvlScript.sml
+++ b/compiler/backend/clos_to_bvlScript.sml
@@ -126,7 +126,7 @@ val code_for_recc_case_def = Define `
   code_for_recc_case n num_args (c:bvl$exp) =
     (num_args + 1,
      Let [mk_el (Var num_args) (mk_const 2)]
-      (Let (GENLIST (\a. Var (a + 1)) num_args ++ GENLIST (\i. Op Deref [mk_const i; Var 0]) n) c))`;
+      (Let (GENLIST (\a. Var (a + 1)) num_args ++ GENLIST (\i. Op El [mk_const i; Var 0]) n) c))`;
 
 val build_aux_def = Define `
   (build_aux i [] aux = (i:num,aux)) /\
diff --git a/compiler/backend/data_to_wordScript.sml b/compiler/backend/data_to_wordScript.sml
index d48d05357d..5d1f8ef427 100644
--- a/compiler/backend/data_to_wordScript.sml
+++ b/compiler/backend/data_to_wordScript.sml
@@ -100,7 +100,7 @@ val all_ones_def = Define `
 
 val maxout_bits_def = Define `
   maxout_bits n rep_len k =
-    if n < 2 ** rep_len then n2w n << k else all_ones (k + rep_len) k`
+    if n < 2 ** rep_len - 1 then n2w n << k else all_ones (k + rep_len) k`
 
 val ptr_bits_def = Define `
   ptr_bits conf tag len =
@@ -353,7 +353,7 @@ val RefByte_code_def = Define `
 
 val Maxout_bits_code_def = Define `
   Maxout_bits_code rep_len k dest n =
-    If Lower n (Imm (n2w (2 ** rep_len)))
+    If Lower n (Imm (n2w (2 ** rep_len - 1)))
       (Assign dest (Op Or [Var dest; Shift Lsl (Var n) k]))
       (Assign dest (Op Or [Var dest; Const (all_ones (k + rep_len) k)]))
          :'a wordLang$prog`
@@ -1040,13 +1040,6 @@ val def = assign_Define `
                                            real_offset c (adjust_var v2)])),l)
       : 'a wordLang$prog # num`;
 
-val def = assign_Define `
-  assign_Deref (c:data_to_word$config) (l:num) (dest:num) v1 v2 =
-                         (Assign (adjust_var dest)
-                            (Load (Op Add [real_addr c (adjust_var v1);
-                                           real_offset c (adjust_var v2)])),l)
-      : 'a wordLang$prog # num`;
-
 val def = assign_Define `
   assign_DerefByte (c:data_to_word$config) (l:num) (dest:num) v1 v2 =
          (list_Seq [
@@ -1381,6 +1374,15 @@ val def = assign_Define `
                                 (Assign (adjust_var dest) TRUE_CONST)
                                 (Assign (adjust_var dest) FALSE_CONST),l)
                            else (Assign (adjust_var dest) FALSE_CONST,l)
+                         else if tag < 2 ** c.tag_bits - 1 /\
+                                 len < 2 ** c.len_bits -1 then
+                           (Seq
+                             (Assign 1 (Op And
+                                [Var (adjust_var v1);
+                                 Const (all_ones (c.len_bits + c.tag_bits + 1) 0)]))
+                             (If Equal 1 (Imm (ptr_bits c tag len || 1w))
+                                (Assign (adjust_var dest) TRUE_CONST)
+                                (Assign (adjust_var dest) FALSE_CONST)),l)
                          else
                            dtcase encode_header c (4 * tag) len of
                            | NONE => (Assign (adjust_var dest) FALSE_CONST,l)
@@ -1394,6 +1396,38 @@ val def = assign_Define `
                                   (Assign (adjust_var dest) FALSE_CONST)],l))
       : 'a wordLang$prog # num`;
 
+val def = assign_Define `
+  assign_LenEq (c:data_to_word$config) (secn:num)
+             (l:num) (dest:num) (names:num_set option) len v1 =
+                        (if len = 0 then
+                           (If Test (adjust_var v1) (Imm 1w)
+                              (Assign (adjust_var dest) TRUE_CONST)
+                              (Assign (adjust_var dest) FALSE_CONST),l)
+                         else if len < 2 ** c.len_bits - 1 then
+                           (Seq
+                             (Assign 1 (Op And
+                                [Var (adjust_var v1);
+                                 Const (all_ones (c.len_bits + 1) 0)]))
+                             (If Equal 1 (Imm (ptr_bits c 0 len || 1w))
+                                (Assign (adjust_var dest) TRUE_CONST)
+                                (Assign (adjust_var dest) FALSE_CONST)),l)
+                         else if len < dimword (:'a) then
+                           (list_Seq
+                             [Assign 1 (Const 0w);
+                              If Test (adjust_var v1) (Imm 1w) Skip
+                               (Assign 1
+                                 (let addr = real_addr c (adjust_var v1) in
+                                  let header = Load addr in
+                                  let k = dimindex (:'a) - c.len_size in
+                                  let len = Shift Lsr header k in
+                                    len));
+                              If Equal 1 (Imm (n2w len))
+                                (Assign (adjust_var dest) TRUE_CONST)
+                                (Assign (adjust_var dest) FALSE_CONST)],l)
+                         else
+                           (Assign (adjust_var dest) FALSE_CONST,l))
+      : 'a wordLang$prog # num`;
+
 val def = assign_Define `
   assign_TagEq (c:data_to_word$config) (secn:num)
              (l:num) (dest:num) (names:num_set option) tag v1 =
@@ -1937,7 +1971,6 @@ val assign_def = Define `
     | GlobalsPtr => (Assign (adjust_var dest) (Lookup Globals),l)
     | SetGlobalsPtr => arg1 args (assign_SetGlobalsPtr l dest) (Skip,l)
     | El => arg2 args (assign_El c l dest) (Skip,l)
-    | Deref => arg2 args (assign_Deref c l dest) (Skip,l)
     | DerefByte => arg2 args (assign_DerefByte c l dest) (Skip,l)
     | Update => arg3 args (assign_Update c l dest) (Skip,l)
     | UpdateByte => arg3 args (assign_UpdateByte c l dest) (Skip,l)
@@ -1966,6 +1999,7 @@ val assign_def = Define `
     | LengthByte => arg1 args (assign_LengthByte c secn l dest names) (Skip,l)
     | TagLenEq tag len =>
         arg1 args (assign_TagLenEq c secn l dest names tag len) (Skip,l)
+    | LenEq len => arg1 args (assign_LenEq c secn l dest names len) (Skip,l)
     | TagEq tag => arg1 args (assign_TagEq c secn l dest names tag) (Skip,l)
     | Add => arg2 args (assign_Add c secn l dest names) (Skip,l)
     | Sub => arg2 args (assign_Sub c secn l dest names) (Skip,l)
diff --git a/compiler/backend/displayLangScript.sml b/compiler/backend/displayLangScript.sml
index 69f5e33d88..8dde542203 100644
--- a/compiler/backend/displayLangScript.sml
+++ b/compiler/backend/displayLangScript.sml
@@ -11,25 +11,28 @@ val _ = new_theory"displayLang";
 val _ = Datatype`
   sExp =
     | Item (tra option) mlstring (sExp list)
+    | String mlstring
     | Tuple (sExp list)
     | List (sExp list)`;
 
 val sExp_size_def = fetch "-" "sExp_size_def";
 
 (* display_to_json *)
-val num_to_json_def = Define`
-  num_to_json n = String (explode (toString n))`;
-
 val trace_to_json_def = Define`
   (trace_to_json (backend_common$Cons tra num) =
-    Object [("name", String "Cons"); ("num", num_to_json num); ("trace", trace_to_json tra)])
+    Object [(strlit "name", String (strlit "Cons"));
+      (strlit "num", String (toString num));
+      (strlit "trace", trace_to_json tra)])
   /\
   (trace_to_json (Union tra1 tra2) =
-      Object [("name", String "Union"); ("trace1", trace_to_json tra1); ("trace2", trace_to_json tra2)])
+    Object [(strlit "name", String (strlit "Union"));
+      (strlit "trace1", trace_to_json tra1);
+      (strlit "trace2", trace_to_json tra2)])
   /\
   (trace_to_json (SourceLoc sr sc er ec) =
     let arr = MAP Int (MAP (&)  [ sr; sc; er; ec ]) in
-      Object [("name", String "SourcePos"); ("pos", Array arr)])
+      Object [(strlit "name", String (strlit "SourcePos"));
+        (strlit "pos", Array arr)])
   /\
   (* TODO: cancel entire trace when None, or verify that None will always be at
   * the top level of a trace. *)
@@ -45,15 +48,16 @@ QED
 val display_to_json_def = tDefine"display_to_json" `
   (display_to_json (Item tra name es) =
     let es' = MAP display_to_json es in
-    let props = [("name", String (explode name)); ("args", Array es')] in
+    let props = [(strlit "name", String name); (strlit "args", Array es')] in
     let props' = case tra of
                    | NONE => props
-                   | SOME t => ("trace", trace_to_json t)::props in
+                   | SOME t => (strlit "trace", trace_to_json t)::props in
       Object props')
    /\
+  (display_to_json (String s : sExp) = String s) /\
   (display_to_json (Tuple es) =
     let es' = MAP display_to_json es in
-      Object [("isTuple", Bool T); ("elements", Array es')])
+      Object [(strlit "isTuple", Bool T); (strlit "elements", Array es')])
   /\
    (display_to_json (List es) = Array (MAP display_to_json es))`
   (WF_REL_TAC `measure sExp_size` \\ rw []
diff --git a/compiler/backend/flatLangScript.sml b/compiler/backend/flatLangScript.sml
index 29c6cdaa68..0c7be029dd 100644
--- a/compiler/backend/flatLangScript.sml
+++ b/compiler/backend/flatLangScript.sml
@@ -23,7 +23,7 @@ val _ = new_theory "flatLang";
 val _ = set_grammar_ancestry ["ast", "backend_common"];
 
 (* Copied from the semantics, but with AallocEmpty missing. GlobalVar ops have
- * been added. *)
+ * been added, also TagLenEq and El for pattern match compilation. *)
 val _ = Datatype `
  op =
   (* Operations on integers *)
@@ -43,7 +43,7 @@ val _ = Datatype `
   (* Reference operations *)
   | Opassign
   | Opref
-  | Opderef
+ (* Opderef -- replaced by El, later in this list *)
   (* Word8Array operations *)
   | Aw8alloc
   | Aw8sub
@@ -92,7 +92,11 @@ val _ = Datatype `
   (* Initialise given global variable *)
   | GlobalVarInit num
   (* Get the value of the given global variable *)
-  | GlobalVarLookup num`;
+  | GlobalVarLookup num
+  (* for pattern match compilation *)
+  | TagLenEq num num
+  | LenEq num
+  | El num`;
 
 Type ctor_id = ``:num``
 (* NONE represents the exception type *)
@@ -106,6 +110,16 @@ val _ = Datatype `
   | Pcon ((ctor_id # type_id) option) (pat list)
   | Pref pat`;
 
+Definition pat_bindings_def:
+  (pat_bindings Pany already_bound = already_bound) ∧
+  (pat_bindings (Pvar n) already_bound = n::already_bound) ∧
+  (pat_bindings (Plit l) already_bound = already_bound) ∧
+  (pat_bindings (Pcon _ ps) already_bound = pats_bindings ps already_bound) ∧
+  (pat_bindings (Pref p) already_bound = pat_bindings p already_bound) ∧
+  (pats_bindings [] already_bound = already_bound) ∧
+  (pats_bindings (p::ps) already_bound = pats_bindings ps (pat_bindings p already_bound))
+End
+
 val _ = Datatype`
   exp =
     Raise tra exp
@@ -134,6 +148,24 @@ Proof
   Induct_on`es`>>simp[exp_size_def]
 QED
 
+Theorem exp6_size:
+  exp6_size xs = LENGTH xs + SUM (MAP exp_size xs)
+Proof
+  Induct_on `xs` \\ simp [exp_size_def]
+QED
+
+Theorem exp1_size:
+  exp1_size xs = LENGTH xs + SUM (MAP exp2_size xs)
+Proof
+  Induct_on `xs` \\ simp [exp_size_def]
+QED
+
+Theorem exp3_size:
+  exp3_size xs = LENGTH xs + SUM (MAP exp5_size xs)
+Proof
+  Induct_on `xs` \\ simp [exp_size_def]
+QED
+
 Theorem exp_size_MAP:
    (!xs. exp6_size (MAP SND xs) < exp3_size xs + 1) /\
    (!xs. exp6_size (MAP (SND o SND) xs) < exp1_size xs + 1)
diff --git a/compiler/backend/flat_elimScript.sml b/compiler/backend/flat_elimScript.sml
index ae96fa1584..7427d67653 100644
--- a/compiler/backend/flat_elimScript.sml
+++ b/compiler/backend/flat_elimScript.sml
@@ -52,9 +52,21 @@ val is_hidden_def = tDefine "is_hidden" `
 
 val is_hidden_ind = theorem "is_hidden_ind";
 
+Definition total_pat_def:
+  total_pat Pany = T /\
+  total_pat (Pvar _) = T /\
+  total_pat (Pcon NONE xs) = total_pat_list xs /\
+  total_pat _ = F /\
+  total_pat_list [] = T /\
+  total_pat_list (p::ps) = (total_pat p /\ total_pat_list ps)
+Termination
+  WF_REL_TAC `measure (\x. case x of INL p => pat_size p
+                                   | INR ps => pat1_size ps)`
+End
+
 (* check if expression is pure in that it does not make any visible changes
     (other than writing to globals) *)
-val is_pure_def = tDefine "is_pure" `
+Definition is_pure_def:
     (is_pure (Handle t e pes) = is_pure e) ∧
     (is_pure (Lit t l) = T) ∧
     (is_pure (Con t id_option es) = EVERY is_pure es) ∧
@@ -62,19 +74,17 @@ val is_pure_def = tDefine "is_pure" `
     (is_pure (Fun t name body) = T) ∧
     (is_pure (App t (GlobalVarInit g) es) = EVERY is_pure es) ∧
     (is_pure (If t e1 e2 e3) = (is_pure e1 ∧ is_pure e2 ∧ is_pure e3)) ∧
-    (is_pure (Mat t e1 pes) = (is_pure e1 ∧ EVERY is_pure (MAP SND pes))) ∧
+    (is_pure (Mat t e1 pes) =
+      (is_pure e1 ∧ EVERY is_pure (MAP SND pes) ∧ EXISTS total_pat (MAP FST pes))) ∧
     (is_pure (Let t opt e1 e2) = (is_pure e1 ∧ is_pure e2)) ∧
     (is_pure (Letrec t funs e) = is_pure e) ∧
     (is_pure _ = F)
-`
-    (
-        WF_REL_TAC `measure (λ e . exp_size e)` >> rw[exp_size_def] >> fs[] >>
-        TRY (Induct_on `es` >> rw[exp_size_def] >> fs[])
-        >- (Induct_on `pes` >> rw[exp_size_def] >> fs[] >>
-            Cases_on `h` >> fs[exp_size_def])
-    );
-
-val is_pure_ind = theorem "is_pure_ind";
+Termination
+  WF_REL_TAC `measure (λ e . exp_size e)` >> rw[exp_size_def] >> fs[] >>
+  TRY (Induct_on `es` >> rw[exp_size_def] >> fs[])
+  >- (Induct_on `pes` >> rw[exp_size_def] >> fs[] >>
+      Cases_on `h` >> fs[exp_size_def])
+End
 
 val dest_GlobalVarInit_def = Define `
     dest_GlobalVarInit (GlobalVarInit n) = SOME n ∧
@@ -104,7 +114,7 @@ Proof
         (Cases_on `h` >> Cases_on `r` >> rw[exp_size_def]) >> rw[]
 QED
 
-val find_loc_def = tDefine "find_loc" `
+Definition find_loc_def:
     (find_loc ((Raise _ er):flatLang$exp) = find_loc er) ∧
     (find_loc (Handle _ eh p_es) =
         union (find_loc eh) (find_locL (MAP SND p_es))) ∧
@@ -123,8 +133,8 @@ val find_loc_def = tDefine "find_loc" `
     (find_loc (Letrec _ vv_es elr1) =
         union (find_locL (MAP (SND o SND) vv_es)) (find_loc elr1)) ∧
     (find_locL [] = LN) ∧
-    (find_locL (e::es) = union (find_loc e) (find_locL es))`
-    (
+    (find_locL (e::es) = union (find_loc e) (find_locL es))
+Termination
         WF_REL_TAC `measure (λ e . case e of
             | INL x => exp_size x
             | INR y => exp6_size y)` >>
@@ -139,11 +149,9 @@ val find_loc_def = tDefine "find_loc" `
         >- (qspec_then `p_es` mp_tac exp_size_map_snd >>
             Cases_on `exp6_size(MAP SND p_es') = exp3_size p_es` >>
             rw[])
-    );
-
-val find_loc_ind = theorem "find_loc_ind";
+End
 
-val find_lookups_def = tDefine "find_lookups" `
+Definition find_lookups_def:
     (find_lookups (Raise _ er) = find_lookups er) ∧
     (find_lookups (Handle _ eh p_es) =
         union (find_lookups eh) (find_lookupsL (MAP SND p_es))) ∧
@@ -165,8 +173,7 @@ val find_lookups_def = tDefine "find_lookups" `
         union (find_lookupsL (MAP (SND o SND) vv_es)) (find_lookups elr1)) ∧
     (find_lookupsL [] = LN) ∧
     (find_lookupsL (e::es) = union (find_lookups e) (find_lookupsL es))
-`
-    (
+Termination
         WF_REL_TAC `measure (λ e . case e of
                 | INL x => exp_size x
                 | INR (y:flatLang$exp list) =>
@@ -181,7 +188,7 @@ val find_lookups_def = tDefine "find_lookups" `
         >- (qspec_then `p_es` mp_tac exp_size_map_snd >>
             Cases_on `exp6_size(MAP SND p_es) = exp3_size p_es` >>
             rw[])
-    );
+End
 
 val find_lookups_ind = theorem "find_lookups_ind";
 
@@ -207,6 +214,45 @@ val analyse_code_def = Define `
     analyse_code (_::cs) = analyse_code cs
 `
 
+(*
+
+(**************************** REACHABILITY FUNS *****************************)
+
+
+val superdomain_def = Define `
+    superdomain (t:num_set num_map) = spt_fold union LN t
+`
+
+val mk_wf_set_tree_def = Define `
+    mk_wf_set_tree t =
+        let t' = union t (map (K LN) (superdomain t)) in mk_wf (map (mk_wf) t')
+`
+
+Definition close_spt_def:
+    close_spt (reachable :num_set) (seen :num_set) (tree :num_set spt) =
+        let to_look = difference seen reachable in
+        let new_sets = inter tree to_look in
+            if new_sets = LN then reachable else
+                let new_set = spt_fold union LN new_sets in
+                    close_spt (union reachable to_look) (union seen new_set)
+                        tree
+Termination
+        WF_REL_TAC `measure (λ (r, _, t) . size (difference t r))` >>
+        rw[] >>
+        match_mp_tac size_diff_less >>
+        fs[domain_union, domain_difference] >>
+        fs[inter_eq_LN, IN_DISJOINT, domain_difference] >>
+        qexists_tac `x` >>
+        fs[]
+End
+
+val close_spt_ind = theorem "close_spt_ind";
+
+val closure_spt_def = Define
+    `closure_spt start tree = close_spt LN start tree`;
+
+*)
+
 (**************************** REMOVAL FUNCTIONS *****************************)
 
 val keep_def = Define `
diff --git a/compiler/backend/flat_exh_matchScript.sml b/compiler/backend/flat_exh_matchScript.sml
deleted file mode 100644
index ad9d03f396..0000000000
--- a/compiler/backend/flat_exh_matchScript.sml
+++ /dev/null
@@ -1,179 +0,0 @@
-(*
-  This compiler phase ensures that all pattern matches are exhaustive.
-*)
-open preamble flatLangTheory backend_commonTheory
-
-val _ = new_theory"flat_exh_match"
-
-val _ = set_grammar_ancestry ["flatLang", "sptree"];
-val _ = temp_tight_equality ();
-val _ = numLib.prefer_num()
-
-val _ = tDefine "is_unconditional" `
-  is_unconditional p ⇔
-    case p of
-      Pcon NONE ps => EVERY is_unconditional ps
-    | Pvar _       => T
-    | Pany         => T
-    | Pref p       => is_unconditional p
-    | _            => F`
-  (WF_REL_TAC `measure pat_size` >> gen_tac >>
-   Induct_on`ps` >> simp[pat_size_def] >>
-   rw[] >> res_tac >> simp[pat_size_def]);
-
-(* The map for datatype tags is arity |-> count. *)
-val _ = Define `
-  (get_dty_tags []      dtys = SOME dtys) ∧
-  (get_dty_tags (p::ps) dtys =
-     case p of
-       Pcon (SOME (cid, SOME _)) pats =>
-           if EVERY is_unconditional pats then
-             let arity = LENGTH pats in
-               (case lookup arity dtys of
-                 SOME tags =>
-                     get_dty_tags ps (insert arity (delete cid tags) dtys)
-               | _ => NONE)
-           else NONE
-     | _ => NONE)`;
-
-val _ = Define `
-  exhaustive_match ctors ps ⇔
-    EXISTS is_unconditional ps ∨
-    case ps of
-      Pcon (SOME (tag, SOME tyid)) pats :: _ =>
-          EVERY is_unconditional pats  /\
-          (case FLOOKUP ctors tyid of
-            NONE      => F
-          | SOME dtys =>
-              let tags = map (\n. fromList (GENLIST (K ()) n)) dtys in
-                (case get_dty_tags ps tags of
-                  NONE     => F
-                | SOME res => EVERY isEmpty (toList res)))
-    | _ => F`
-
-val add_default_def = Define `
-  add_default t is_hdl is_exh ps =
-    if is_exh then
-      ps
-    else if is_hdl then
-      ps ++ [(Pvar "x", Raise (t § 1) (Var_local (t § 2) "x"))]
-    else
-      ps ++ [(Pany, Raise (t § 1) (Con (t § 2) (SOME (bind_tag, NONE)) []))]`;
-
-val e2sz_def = Lib.with_flag (computeLib.auto_import_definitions, false) (tDefine"e2sz"`
-  (e2sz (Raise _ e) = e2sz e + 1) ∧
-  (e2sz (Letrec _ funs e) = e2sz e + f2sz funs + 1) ∧
-  (e2sz (Mat _ e pes) = e2sz e + p2sz pes + 4) ∧
-  (e2sz (Handle _ e pes) = e2sz e + p2sz pes + 4) ∧
-  (e2sz (App _ op es) = l2sz es + 1) ∧
-  (e2sz (Let _ x e1 e2) = e2sz e1 + e2sz e2 + 1) ∧
-  (e2sz (If _ x1 x2 x3) = e2sz x1 + e2sz x2 + e2sz x3 + 1) /\
-  (e2sz (Fun _ x e) = e2sz e + 1) ∧
-  (e2sz (Con _ t es) = l2sz es + 1) ∧
-  (e2sz _ = (0:num)) ∧
-  (l2sz [] = 0) ∧
-  (l2sz (e::es) = e2sz e + l2sz es + 1) ∧
-  (p2sz [] = 0) ∧
-  (p2sz ((p,e)::pes) = e2sz e + p2sz pes + 1) ∧
-  (f2sz [] = 0) ∧
-  (f2sz ((f,x,e)::funs) = e2sz e + f2sz funs + 1)`)
-  (WF_REL_TAC`inv_image $< (\x. case x of
-    | INL (e) => exp_size e
-    | INR (INL (es)) => exp6_size es
-    | INR (INR (INL (pes))) => exp3_size pes
-    | INR (INR (INR (funs))) => exp1_size funs)`)
-
-val compile_exps_def = tDefine "compile_exps" `
-  (compile_exps ctors [] = []) /\
-  (compile_exps ctors (x::y::xs) =
-    HD (compile_exps ctors [x]) :: compile_exps ctors (y::xs)) /\
-  (compile_exps ctors [Raise t x] =
-    let y = HD (compile_exps ctors [x]) in
-      [Raise t y]) /\
-  (compile_exps ctors [Handle t x ps] =
-    let y   = HD (compile_exps ctors [x]) in
-    let ps1 = add_default t T (exhaustive_match ctors (MAP FST ps)) ps in
-    let ps2 = MAP (\(p,e). (p, HD (compile_exps ctors [e]))) ps1 in
-      [Handle t y ps2]) /\
-  (compile_exps ctors [Con t ts xs] = [Con t ts (compile_exps ctors xs)]) /\
-  (compile_exps ctors [Fun t vs x] =
-    let y = HD (compile_exps ctors [x]) in
-      [Fun t vs y]) /\
-  (compile_exps ctors [App t op xs] =
-    let ys = compile_exps ctors xs in
-      [App t op ys]) /\
-  (compile_exps ctors [Mat t x ps] =
-    let y   = HD (compile_exps ctors [x]) in
-    let ps1 = add_default t F (exhaustive_match ctors (MAP FST ps)) ps in
-    let ps2 = MAP (\(p,e). (p, HD (compile_exps ctors [e]))) ps1 in
-      [Mat t y ps2]) /\
-  (compile_exps ctors [Let t v x1 x2] =
-    let y1 = HD (compile_exps ctors [x1]) in
-    let y2 = HD (compile_exps ctors [x2]) in
-      [Let t v y1 y2]) /\
-  (compile_exps ctors [Letrec t fs x] =
-    let fs1 = MAP (\(a,b,c). (a, b, HD (compile_exps ctors [c]))) fs in
-    let y   = HD (compile_exps ctors [x]) in
-      [Letrec t fs1 y]) /\
-  (compile_exps ctors [If t x1 x2 x3] =
-    let y1 = HD (compile_exps ctors [x1]) in
-    let y2 = HD (compile_exps ctors [x2]) in
-    let y3 = HD (compile_exps ctors [x3]) in
-      [If t y1 y2 y3]) /\
-  (compile_exps ctors [expr] = [expr])`
- (WF_REL_TAC `measure (l2sz o SND)` \\ rw [add_default_def] \\ fs [e2sz_def]
-  \\ pop_assum mp_tac
-  \\ TRY (pop_assum kall_tac)
-  >-
-   (map_every qid_spec_tac [`a`,`b`,`c`,`fs`]
-    \\ Induct \\ rw [] \\ fs [e2sz_def]
-    \\ PairCases_on `h`
-    \\ res_tac \\ fs [e2sz_def])
-  \\ map_every qid_spec_tac [`p`,`e`,`ps`]
-  \\ Induct \\ rw [] \\ fs [exp_size_def]
-  \\ TRY (PairCases_on `h`)
-  \\ res_tac \\ fs [e2sz_def]);
-
-val _ = map delete_const ["e2sz","p2sz","l2sz","f2sz","e2sz_UNION"]
-val _ = delete_binding "e2sz_ind"
-
-Theorem compile_exps_LENGTH:
-   !ctors xs. LENGTH (compile_exps ctors xs) = LENGTH xs
-Proof
-  ho_match_mp_tac (theorem "compile_exps_ind") \\ rw [compile_exps_def]
-QED
-
-Theorem compile_exps_SING[simp]:
-   compile_exps ctors [x] <> []
-Proof
-  strip_tac \\ pop_assum (mp_tac o Q.AP_TERM `LENGTH`)
-  \\ fs [compile_exps_LENGTH]
-QED
-
-val compile_exp_def = Define `
-  compile_exp ctors exp = HD (compile_exps ctors [exp])`;
-
-val compile_dec_def = Define `
-  (compile_dec ctors (Dlet exp) = (ctors, Dlet (compile_exp ctors exp))) /\
-  (compile_dec ctors (Dtype tid amap) =
-     (ctors |+ (tid, amap), Dtype tid amap)) /\
-  (compile_dec ctors dec = (ctors, dec))`
-
-val compile_decs_def = Define `
-  (compile_decs ctors [] = (ctors, [])) /\
-  (compile_decs ctors (d::ds) =
-    let (ctor1, e)  = compile_dec  ctors d  in
-    let (ctor2, es) = compile_decs ctor1 ds in
-      (ctor2, e::es))`;
-
-(* Only care about type declarations, not exceptions *)
-val init_ctors_def = Define `
-  init_ctors =
-    FEMPTY |++
-      [ (0 (* bool_id *), insert 0 2 LN)
-      ; (1 (* list_id *), insert 0 1 (insert 2 1 LN)) ]`;
-
-val compile_def = Define`
-  compile = compile_decs init_ctors`;
-
-val _ = export_theory()
diff --git a/compiler/backend/flat_patternScript.sml b/compiler/backend/flat_patternScript.sml
new file mode 100644
index 0000000000..e4c0800654
--- /dev/null
+++ b/compiler/backend/flat_patternScript.sml
@@ -0,0 +1,332 @@
+(*
+  Interface between flatLang and pattern compiler.
+
+  - ensures every case match is on a variable
+  - sends case matches to pattern compiler to get a decision tree
+  - decodes decision tree to if-tree
+  - encodes the variable bindings of each case as let-bindings
+*)
+
+open preamble sptreeTheory flatLangTheory pattern_semanticsTheory
+  pattern_compTheory
+
+val _ = new_theory "flat_pattern";
+
+val _ = set_grammar_ancestry ["misc","flatLang","sptree",
+    "pattern_semantics"];
+
+val _ = Datatype `config =
+  <| pat_heuristic : (* pattern_matching$branch list *) unit -> num ;
+    type_map : (num # num) list spt |>`;
+
+Definition init_type_map_def:
+  init_type_map = sptree$fromAList
+    [(bool_id, [(0 : num, 0 : num); (1, 0)]);
+        (1 (* list_id *), [(0, 0); (0, 2)])]
+End
+
+Definition init_config_def:
+  init_config ph = <| pat_heuristic := ph; type_map := init_type_map |>
+End
+
+Definition sum_string_ords_def:
+  sum_string_ords i str = if i < LENGTH str
+    then (ORD (EL i str) - 35) + sum_string_ords (i + 1) str
+    else 0
+Termination
+  WF_REL_TAC `measure (\(i, str). LENGTH str - i)`
+End
+
+Definition dec_name_to_num_def:
+  dec_name_to_num name = if LENGTH name < 2 then 0
+    else if EL 0 name = #"." /\ EL 1 name = #"."
+    then sum_string_ords 2 name else 0
+End
+
+Definition enc_num_to_name_def:
+  enc_num_to_name i xs = if i < 90 then #"." :: #"." :: CHR (i + 35) :: xs
+    else enc_num_to_name (i - 90) (CHR 125 :: xs)
+End
+
+Theorem pat1_size:
+  flatLang$pat1_size xs = LENGTH xs + SUM (MAP pat_size xs)
+Proof
+  Induct_on `xs` \\ simp [flatLangTheory.pat_size_def]
+QED
+
+Theorem MAPi_eq_MAP:
+  MAPi (\n x. f x) xs = MAP f xs
+Proof
+  Induct_on `xs` \\ simp [o_DEF]
+QED
+
+Definition compile_pat_bindings_def:
+  compile_pat_bindings _ _ [] exp = (LN, exp) /\
+  compile_pat_bindings t i ((Pany, _, _) :: m) exp =
+    compile_pat_bindings t i m exp /\
+  compile_pat_bindings t i ((Pvar s, k, x) :: m) exp = (
+    let (spt, exp2) = compile_pat_bindings t i m exp in
+    (insert k () spt, Let t (SOME s) x exp2)) /\
+  compile_pat_bindings t i ((Plit _, _, _) :: m) exp =
+    compile_pat_bindings t i m exp /\
+  compile_pat_bindings t i ((Pcon stmp ps, k, x) :: m) exp = (
+    let j_nms = MAP (\(j, p). let k = i + 1 + j in
+        let nm = enc_num_to_name k [] in
+        ((j, nm), (p, k, Var_local t nm))) (enumerate 0 ps) in
+    let (spt, exp2) = compile_pat_bindings t (i + 2 + LENGTH ps)
+        (MAP SND j_nms ++ m) exp in
+    let j_nms_used = FILTER (\(_, (_, k, _)). IS_SOME (lookup k spt)) j_nms in
+    let exp3 = FOLDR (\((j, nm), _) exp.
+        flatLang$Let t (SOME nm) (App t (El j) [x]) exp) exp2 j_nms_used in
+    let spt2 = if NULL j_nms_used then spt else insert k () spt in
+    (spt2, exp3)) /\
+  compile_pat_bindings t i ((Pref p, k, x) :: m) exp = (
+    let nm = enc_num_to_name (i + 1) [] in
+    let (spt, exp2) = compile_pat_bindings t (i + 2)
+        ((p, i + 1, Var_local t nm) :: m) exp in
+    (insert k () spt, Let t (SOME nm) (App t (El 0) [x]) exp2))
+Termination
+  WF_REL_TAC `measure (\(t, i, m, exp). SUM (MAP (pat_size o FST) m) + LENGTH m)`
+  \\ simp [flatLangTheory.pat_size_def]
+  \\ rw [MAP_MAP_o, o_DEF, UNCURRY, SUM_APPEND, pat1_size]
+  \\ simp [LENGTH_enumerate, MAP_enumerate_MAPi, MAPi_eq_MAP]
+End
+
+Definition compile_pat_rhs_def:
+  compile_pat_rhs t i v (p, exp) =
+  SND (compile_pat_bindings t (i + 1) [(p, i, v)] exp)
+End
+
+Definition decode_pos_def:
+  decode_pos t v EmptyPos = v /\
+  decode_pos t v (Pos i pos) = decode_pos t (App t (El i) [v]) pos
+End
+
+Definition decode_test_def:
+  decode_test t (TagLenEq tag l) v = App t (TagLenEq tag l) [v] /\
+  decode_test t (LitEq lit) v = App t Equality [v; Lit t lit]
+End
+
+Definition simp_guard_def:
+  simp_guard (Conj x y) = (if x = True then simp_guard y
+    else if y = True then simp_guard x
+    else if x = Not True \/ y = Not True then Not True
+    else Conj (simp_guard x) (simp_guard y)) /\
+  simp_guard (Disj x y) = (if x = True \/ y = True then True
+    else if x = Not True then simp_guard y
+    else if y = Not True then simp_guard x
+    else Disj (simp_guard  x) (simp_guard y)) /\
+  simp_guard (Not (Not x)) = simp_guard x /\
+  simp_guard (Not x) = Not (simp_guard x) /\
+  simp_guard x = x
+End
+
+Definition decode_guard_def:
+  decode_guard t v (Not gd) = App t Equality [decode_guard t v gd; Bool t F] /\
+  decode_guard t v (Conj gd1 gd2) = If t (decode_guard t v gd1)
+    (decode_guard t v gd2) (Bool t F) /\
+  decode_guard t v (Disj gd1 gd2) = If t (decode_guard t v gd1) (Bool t T)
+    (decode_guard t v gd2) /\
+  decode_guard t v True = Bool t T /\
+  decode_guard t v (PosTest pos test) = decode_test t test (decode_pos t v pos)
+End
+
+Definition decode_dtree_def:
+  decode_dtree t br_spt v df (Leaf n) = (case lookup n br_spt
+    of SOME br => br | NONE => df) /\
+  decode_dtree t br_spt v df pattern_semantics$Fail = df /\
+  decode_dtree t br_spt v df TypeFail = Var_local t "impossible-case" /\
+  decode_dtree t br_spt v df (If guard dt1 dt2) =
+  let guard = simp_guard guard in
+  let dec1 = decode_dtree t br_spt v df dt1 in
+  let dec2 = decode_dtree t br_spt v df dt2 in
+  if guard = True then dec1
+  else if guard = Not True then dec2
+  else If t (decode_guard t v guard) dec1 dec2
+End
+
+Definition encode_pat_def:
+  encode_pat type_map (flatLang$Pany) = pattern_semantics$Any /\
+  encode_pat type_map (Plit l) = Lit l /\
+  encode_pat type_map (Pvar _) = Any /\
+  encode_pat type_map (Pcon stmp ps) = Cons
+    (case stmp of NONE => NONE | SOME (i, NONE) => SOME (i, NONE)
+        | SOME (i, SOME ty) => SOME (i, lookup ty type_map))
+    (MAP (encode_pat type_map) ps) /\
+  encode_pat type_map (Pref p) = Ref (encode_pat type_map p)
+Termination
+  WF_REL_TAC `measure (pat_size o SND)`
+  \\ rw [pat1_size]
+  \\ fs [MEM_SPLIT, SUM_APPEND]
+End
+
+Definition naive_pattern_match_def:
+  naive_pattern_match t [] = Bool t T /\
+  naive_pattern_match t ((flatLang$Pany, _) :: mats) = naive_pattern_match t mats
+  /\
+  naive_pattern_match t ((Pvar _, _) :: mats) = naive_pattern_match t mats /\
+  naive_pattern_match t ((Plit l, v) :: mats) = If t
+    (App t Equality [v; Lit t l]) (naive_pattern_match t mats) (Bool t F) /\
+  naive_pattern_match t ((Pcon NONE ps, v) :: mats) =
+    naive_pattern_match t (MAPi (\i p. (p, App t (El i) [v])) ps ++ mats) /\
+  naive_pattern_match t ((Pcon (SOME stmp) ps, v) :: mats) =
+    If t (App t (TagLenEq (FST stmp) (LENGTH ps)) [v])
+      (naive_pattern_match t (MAPi (\i p. (p, App t (El i) [v])) ps ++ mats))
+      (Bool t F)
+  /\
+  naive_pattern_match t ((Pref p, v) :: mats) =
+    naive_pattern_match t ((p, App t (El 0) [v]) :: mats)
+Termination
+  WF_REL_TAC `measure (\x. SUM (MAP (pat_size o FST) (SND x)) + LENGTH (SND x))`
+  \\ simp [flatLangTheory.pat_size_def]
+  \\ rw []
+  \\ simp [o_DEF, MAPi_eq_MAP, SUM_APPEND, pat1_size]
+End
+
+Definition naive_pattern_matches_def:
+  naive_pattern_matches t v [] dflt_x = dflt_x /\
+  naive_pattern_matches t v ((p, x) :: ps) dflt_x =
+  If t (naive_pattern_match t [(p, v)]) x (naive_pattern_matches t v ps dflt_x)
+End
+
+Definition compile_pats_def:
+  compile_pats (cfg : config) naive t i v default_x ps =
+  let branches = MAP (compile_pat_rhs t i v) ps in
+  if naive then
+  naive_pattern_matches t v (ZIP (MAP FST ps, branches)) default_x
+  else let pats = MAPi (\j (p, _). (encode_pat cfg.type_map p, j)) ps in
+  let dt = pattern_comp$comp (* cfg.pat_heuristic *) pats
+  in decode_dtree t (fromList branches) v default_x dt
+End
+
+Definition max_dec_name_def:
+  max_dec_name [] = 0 /\
+  max_dec_name (nm :: nms) = MAX (dec_name_to_num nm) (max_dec_name nms)
+End
+
+Definition op_sets_globals_def:
+  op_sets_globals (GlobalVarInit n) = T /\
+  op_sets_globals _ = F
+End
+
+Theorem op_sets_globals_EX:
+  op_sets_globals op = (?n. op = GlobalVarInit n)
+Proof
+  Cases_on `op` \\ simp [op_sets_globals_def]
+QED
+
+Definition compile_exp_def:
+  (compile_exp cfg (Var_local t vid) =
+    (dec_name_to_num vid, F, Var_local t vid)) /\
+  (compile_exp cfg (Raise t x) =
+    let (i, sg, y) = compile_exp cfg x in
+    (i, sg, Raise t y)) /\
+  (compile_exp cfg (Handle t x ps) =
+    let (i, sgx, y) = compile_exp cfg x in
+    let (j, sgp, ps2) = compile_match cfg ps in
+    let k = MAX i j + 2 in
+    let nm = enc_num_to_name k [] in
+    let v = Var_local t nm in
+    let r = Raise t v in
+    let exp = compile_pats cfg sgp t k v r ps2 in
+    (k, sgx \/ sgp, Handle t y [(Pvar nm, exp)])) /\
+  (compile_exp cfg (Con t ts xs) =
+    let (i, sg, ys) = compile_exps cfg (REVERSE xs) in
+    (i, sg, Con t ts (REVERSE ys))) /\
+  (compile_exp cfg (Fun t vs x) =
+    let (i, sg, y) = compile_exp cfg x in
+    (i, sg, Fun t vs y)) /\
+  (compile_exp cfg (App t op xs) =
+    let (i, sg, ys) = compile_exps cfg (REVERSE xs) in
+    (i, sg \/ op_sets_globals op, App t op (REVERSE ys))) /\
+  (compile_exp cfg (Mat t x ps) =
+    let (i, sgx, y) = compile_exp cfg x in
+    let (j, sgp, ps2) = compile_match cfg ps in
+    let k = MAX i j + 2 in
+    let nm = enc_num_to_name k [] in
+    let v = Var_local t nm in
+    let r = Raise t (Con t (SOME (bind_tag, NONE)) []) in
+    let exp = compile_pats cfg sgp t k v r ps2 in
+    (k, sgx \/ sgp, Let t (SOME nm) y exp)) /\
+  (compile_exp cfg (Let t v x1 x2) =
+    let (i, sg1, y1) = compile_exp cfg x1 in
+    let (j, sg2, y2) = compile_exp cfg x2 in
+    let k = (case v of NONE => 0 | SOME vid => dec_name_to_num vid) in
+    (MAX i (MAX j k), sg1 \/ sg2, Let t v y1 y2)) /\
+  (compile_exp cfg (flatLang$Letrec t fs x) =
+    let ys = MAP (\(a,b,c). (a, b, compile_exp cfg c)) fs in
+    let (i, sgx, y) = compile_exp cfg x in
+    let j = list_max (MAP (\(_,_,(j,_,_)). j) ys) in
+    let sgfs = EXISTS (\(_,_,(_,sg,_)). sg) ys in
+    let fs2 = MAP (\(a, b, (_, _, exp)). (a, b, exp)) ys in
+    (MAX i j, sgfs \/ sgx, flatLang$Letrec t fs2 y)) /\
+  (compile_exp cfg (If t x1 x2 x3) =
+    let (i, sg1, y1) = compile_exp cfg x1 in
+    let (j, sg2, y2) = compile_exp cfg x2 in
+    let (k, sg3, y3) = compile_exp cfg x3 in
+    (MAX i (MAX j k), sg1 \/ sg2 \/ sg3, If t y1 y2 y3)) /\
+  (compile_exp cfg exp = (0, F, exp)) /\
+  (compile_exps cfg [] = (0, F, [])) /\
+  (compile_exps cfg (x::xs) =
+    let (i, sgx, y) = compile_exp cfg x in
+    let (j, sgy, ys) = compile_exps cfg xs in
+    (MAX i j, sgx \/ sgy, y :: ys)) /\
+  (compile_match cfg [] = (0, F, [])) /\
+  (compile_match cfg ((p, x)::ps) =
+    let (i, sgx, y) = compile_exp cfg x in
+    let j = max_dec_name (pat_bindings p []) in
+    let (k, sgp, ps2) = compile_match cfg ps in
+    (MAX i (MAX j k), sgx \/ sgp, ((p, y) :: ps2)))
+Termination
+  WF_REL_TAC `measure (\x. case x of INL (_, x) => exp_size x
+    | INR (INL (_, xs)) => exp6_size xs
+    | INR (INR (_, ps)) => exp3_size ps)`
+  \\ rw [flatLangTheory.exp_size_def]
+  \\ imp_res_tac flatLangTheory.exp_size_MEM
+  \\ fs []
+End
+
+Theorem LENGTH_compile_exps_IMP:
+  (!cfg x. let v = compile_exp cfg x in T) /\
+  (!cfg xs i sg ys. compile_exps cfg xs = (i, sg, ys) ==>
+    LENGTH ys = LENGTH xs) /\
+  (!cfg ps i sg ps2. compile_match cfg ps = (i, sg, ps2) ==>
+    LENGTH ps2 = LENGTH ps)
+Proof
+  ho_match_mp_tac compile_exp_ind \\ rw [compile_exp_def] \\ fs []
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs []
+QED
+
+Theorem LENGTH_SND_compile_exps:
+  LENGTH (SND (SND (compile_exps cfg xs))) = LENGTH xs /\
+  LENGTH (SND (SND (compile_match cfg ps))) = LENGTH ps
+Proof
+  Cases_on `SND (compile_exps cfg xs)` \\ Cases_on `SND (compile_match cfg ps)`
+  \\ Cases_on `compile_exps cfg xs` \\ Cases_on `compile_match cfg ps`
+  \\ rfs []
+  \\ imp_res_tac LENGTH_compile_exps_IMP \\ simp []
+QED
+
+Definition compile_dec_def:
+  compile_dec cfg (Dlet exp) =
+  (cfg, Dlet (SND (SND (compile_exp cfg exp))))
+  /\
+  compile_dec cfg (Dtype tid amap) =
+    (let new = FLAT (MAP (\(arity, max). MAP (\i. (i, arity)) (COUNT_LIST max))
+                (toAList amap)) in
+    (if NULL new then cfg
+        else cfg with type_map updated_by (insert tid new), Dtype tid amap)) /\
+  compile_dec cfg (Dexn n n') = (cfg, Dexn n n')
+End
+
+Definition compile_decs_def:
+  (compile_decs cfg [] = (cfg, [])) /\
+  (compile_decs cfg (d::ds) =
+    let (cfg1, e) = compile_dec cfg d in
+    let (cfg2, es) = compile_decs cfg1 ds in
+      (cfg2, e::es))
+End
+
+val _ = export_theory()
+
diff --git a/compiler/backend/flat_reorder_matchScript.sml b/compiler/backend/flat_reorder_matchScript.sml
deleted file mode 100644
index f644db141a..0000000000
--- a/compiler/backend/flat_reorder_matchScript.sml
+++ /dev/null
@@ -1,156 +0,0 @@
-(*
-  This compiler phase reorders patterns in pattern matches to improve
-  code quality.
-*)
-open preamble flatLangTheory
-
-val _ = new_theory"flat_reorder_match";
-val _ = set_grammar_ancestry ["flatLang"];
-val _ = temp_tight_equality ();
-
-val is_const_con_def = Define`
-  (is_const_con (Pcon (SOME tag) plist) = (plist = [])) /\
-  (is_const_con _  = F)`
-
-val isPvar_def = Define`
-  (isPvar (Pvar _) = T) /\
-  (isPvar Pany = T) /\
-  isPvar _ = F`
-
-val isPcon_def = Define`
-  (isPcon (Pcon (SOME _) _) = T) /\
-  isPcon _ = F`
-
-val same_con_def = Define`
-  (same_con (Pcon (SOME (t,_)) []) (Pcon (SOME (t',_)) []) ⇔ t = t') ∧
-  (same_con _ _ ⇔ F)`;
-
-val _ = export_rewrites ["isPvar_def","isPcon_def", "is_const_con_def", "same_con_def"]
-
-val const_cons_sep_def=Define `
-  (const_cons_sep [] a const_cons = (const_cons,a) ) /\
-  (const_cons_sep (b::c) a const_cons=
-      if (isPvar (FST b)) then
-          (const_cons,(b::a))
-      else if (is_const_con (FST b)) then
-              if EXISTS (same_con (FST b) o FST) const_cons then
-                   const_cons_sep c a const_cons
-              else const_cons_sep c a (b::const_cons)
-      else if isPcon (FST b) then
-          const_cons_sep c (b::a) const_cons
-      else (const_cons, REVERSE (b::c)++a))`
-
-val const_cons_fst_def = Define`
-    const_cons_fst pes =
-        let (const_cons, a) = const_cons_sep pes [] []
-        in const_cons ++ REVERSE a`
-
-Theorem const_cons_sep_MEM:
-  ! y z. ¬ (MEM x y ) /\ ¬ (MEM x z) /\
-         MEM x ((\(a,b). a ++ REVERSE b) (const_cons_sep pes y z)) ==>
-         MEM x pes
-Proof
-  Induct_on `pes`
-  \\ rw [const_cons_sep_def] \\ METIS_TAC [MEM]
-QED
-
-Theorem const_cons_fst_MEM:
-   MEM x (const_cons_fst pes) ==> MEM x pes
-Proof
-  rw [const_cons_fst_def]
-  \\ METIS_TAC [MEM, const_cons_sep_MEM]
-QED
-
-(*
- example:
- n.b. the constant constructors come in reverse order
- to fix this, const_cons_fst could REVERSE the const_cons accumulator
-EVAL ``
-const_cons_fst [
-  (Pcon 1 [Pvar "x"], e1);
-  (Pcon 3 [], e3);
-  (Pvar "z", ez);
-  (Pcon 2 [Pvar "y"], e2);
-  (Pcon 4 [], e4)]``;
-*)
-
-val compile_def = tDefine "compile" `
-    (compile [] = []) /\
-    (compile [Raise t e] = [Raise t (HD (compile [e]))]) /\
-    (compile [Handle t e pes] =  [Handle t (HD (compile [e])) (MAP (λ(p,e). (p,HD (compile [e]))) (const_cons_fst pes))]) /\
-    (compile [Lit t l] = [Lit t l]) /\
-    (compile [Con t n es] = [Con t n (compile es)] ) /\
-    (compile [Var_local t v] = [Var_local t v]) /\
-    (compile [Fun t v e] = [Fun t v (HD (compile [e]))]) /\
-    (compile [App t op es] = [App t op (compile es)]) /\
-    (compile [If t e1 e2 e3] = [If t (HD (compile [e1])) (HD (compile [e2])) (HD (compile [e3]))]) ∧
-    (compile [Mat t e pes] =  [Mat t (HD (compile [e])) (MAP (λ(p,e). (p,HD (compile [e]))) (const_cons_fst pes))]) /\
-    (compile [Let t vo e1 e2] = [Let t vo (HD (compile [e1])) (HD (compile [e2]))]) /\
-    (compile [Letrec t funs e] =
-        [Letrec t (MAP (\(a, b, e). (a,b, HD (compile [e]))) funs) (HD (compile [e]))]) /\
-    (compile (x::y::xs) = compile [x] ++ compile (y::xs))`
- (WF_REL_TAC `measure exp6_size`
-  \\ simp []
-  \\ conj_tac
-  >- (
-     gen_tac
-     \\ Induct_on `funs`
-     \\ rw [exp_size_def]
-     \\ rw [exp_size_def]
-     \\ res_tac \\ rw []
-     \\ qmatch_goalsub_rename_tac `tra_size t2`
-     \\ pop_assum (qspec_then `t2` mp_tac) \\ fs []
-  )
-  >- (
-     rpt strip_tac
-     \\ imp_res_tac const_cons_fst_MEM
-     \\ last_x_assum kall_tac
-     \\ Induct_on `pes`
-     \\ rw [exp_size_def]
-     \\ rw [exp_size_def]
-     \\ res_tac \\ rw []
-  ));
-
-val compile_ind = theorem"compile_ind";
-
-Theorem compile_length[simp]:
-   ! es. LENGTH (compile es) = LENGTH es
-Proof
-  ho_match_mp_tac compile_ind
-  \\ rw [compile_def]
-QED
-
-Theorem compile_sing:
-   ! e. ?e2. compile [e] = [e2]
-Proof
-  rw []
-  \\ qspec_then `[e]` mp_tac compile_length
-  \\ simp_tac(std_ss++listSimps.LIST_ss)[LENGTH_EQ_NUM_compute]
-QED
-
-val compile_nil = save_thm ("compile_nil[simp]", EVAL ``compile []``);
-
-Theorem compile_not_nil[simp]:
-   compile [x] <> []
-Proof
-  strip_tac \\ pop_assum (mp_tac o Q.AP_TERM `LENGTH`)
-  \\ fs [compile_length]
-QED
-
-Theorem compile_cons:
-   ! e es. compile (e::es) = HD (compile [e]) :: (compile es)
-Proof
-  rw []
-  \\ Cases_on `es`
-  \\ rw [compile_def]
-  \\ METIS_TAC [compile_sing, HD]
-QED
-
-val compile_decs_def = Define `
-  (compile_decs [] = []) /\
-  (compile_decs (d::ds) =
-    case d of
-      Dlet e => Dlet (HD (compile [e]))::compile_decs ds
-    | _ => d::compile_decs ds)`;
-
-val () = export_theory();
diff --git a/compiler/backend/flat_to_closScript.sml b/compiler/backend/flat_to_closScript.sml
new file mode 100644
index 0000000000..09340b975d
--- /dev/null
+++ b/compiler/backend/flat_to_closScript.sml
@@ -0,0 +1,232 @@
+(*
+  Compilation from flatLang to closLang. This compiler phase converts
+  explicit variable names of flatLang to de Bruijn indexing of
+  closLang. It also makes all division-by-zero and out-of-bounds
+  exceptions raised explicitly.
+*)
+open preamble flatLangTheory closLangTheory
+
+val _ = new_theory"flat_to_clos"
+
+val _ = set_grammar_ancestry ["flatLang","closLang","backend_common"];
+
+Definition dest_pat_def:
+  dest_pat [(Pvar v, h)] = SOME (v:string,h) /\
+  dest_pat _ = NONE
+End
+
+Theorem dest_pat_thm:
+  dest_pat pes = SOME (p_1,p_2) <=> pes = [(Pvar p_1, p_2)]
+Proof
+  Cases_on `pes` \\ fs [dest_pat_def]
+  \\ Cases_on `t` \\ fs [dest_pat_def]
+  \\ Cases_on `h` \\ fs [dest_pat_def]
+  \\ Cases_on `q` \\ fs [dest_pat_def]
+QED
+
+Definition compile_lit_def:
+  compile_lit t (IntLit i) = closLang$Op t (Const i) [] /\
+  compile_lit t (Char c) = closLang$Op t (Const (& (ORD c))) [] /\
+  compile_lit t (StrLit s) = closLang$Op t (String s) [] /\
+  compile_lit t (Word8 b) = closLang$Op t (Const (& (w2n b))) [] /\
+  compile_lit t (Word64 w) =
+    closLang$Op t WordFromInt [closLang$Op t (Const (& (w2n w))) []]
+End
+
+Definition arg1_def:
+  arg1 xs f =
+    case xs of [x] => f x | _ => closLang$Let None xs (Var None 0)
+End
+
+Definition arg2_def:
+  arg2 xs f =
+    case xs of [x; y] => f x y | _ => closLang$Let None xs (Var None 0)
+End
+
+Definition AllocGlobals_def:
+  AllocGlobals t n =
+    if n = 0 then Op t (Cons 0) [] else
+    if n = 1 then Op t AllocGlobal [] else
+      Let t [Op t AllocGlobal []] (AllocGlobals t (n-1:num))
+End
+
+fun var_fun m n = ``closLang$Var t ^(numSyntax.term_of_int(m-n))``;
+
+fun check1 tm var =
+``(If t (Op t Less [Op t (Const 0) []; ^(var 2)]) (Raise t (Op t (Cons subscript_tag) []))
+  (If t (Op t Less [Op t (Const 0) []; ^(var 1)]) (Raise t (Op t (Cons subscript_tag) []))
+  (If t (Op t (BoundsCheckByte T) [Op t Add [^(var 2); ^(var 1)]; ^(var 0)]) ^tm
+  (Raise t (Op t (Cons subscript_tag) [])))))``;
+
+val checkT = check1
+  ``(closLang$Op t (CopyByte T) [Var t 0; Var t 1; Var t 2])`` (var_fun 2);
+
+val checkF = check1
+``(If t (Op t Less [Op t (Const 0) []; Var t 0]) (Raise t (Op t (Cons subscript_tag) []))
+  (If t (Op t (BoundsCheckByte T) [Op t Add [Var t 2; Var t 0]; Var t 1])
+     (Op t (CopyByte F) [Var t 0; Var t 1; Var t 2; Var t 3; Var t 4])
+     (Raise t (Op t (Cons subscript_tag) []))))`` (var_fun 4);
+
+Definition CopyByteStr_def:
+  CopyByteStr t = ^checkT
+End
+
+Definition CopyByteAw8_def:
+  CopyByteAw8 t = ^checkF
+End
+
+Definition compile_op_def:
+  compile_op t op xs =
+    case op of
+    | Opapp => arg2 xs (\x f. closLang$App t NONE f [x])
+    | TagLenEq tag n => closLang$Op t (TagLenEq tag n) xs
+    | LenEq n => closLang$Op t (LenEq n) xs
+    | El n => arg1 xs (\x. Op t El [Op None (Const (& n)) []; x])
+    | Ord => arg1 xs (\x. x)
+    | Chr => Let t xs (If t (Op t Less [Op None (Const 0) []; Var t 0])
+                        (Raise t (Op t (Cons chr_tag) []))
+                        (If t (Op t Less [Var t 0; Op None (Const 255) []])
+                          (Raise t (Op t (Cons chr_tag) []))
+                          (Var t 0)))
+    | Chopb chop => Op t (case chop of
+                          | Lt => Less
+                          | Gt => Greater
+                          | Leq => LessEq
+                          | Geq => GreaterEq) xs
+    | Opassign => arg2 xs (\x y. Op t Update [x; Op None (Const 0) []; y])
+    | Opref => Op t Ref xs
+    | ConfigGC => Op t ConfigGC xs
+    | Opb l => Op t (case l of
+                     | Lt => Less
+                     | Gt => Greater
+                     | Leq => LessEq
+                     | Geq => GreaterEq) xs
+    | Opn Plus => Op t Add xs
+    | Opn Minus => Op t Sub xs
+    | Opn Times => Op t Mult xs
+    | Opn Divide => Let t xs (If t (Op t Equal [Var t 0; Op t (Const 0) []])
+                                    (Raise t (Op t (Cons div_tag) []))
+                                    (Op t Div [Var t 0; Var t 1]))
+    | Opn Modulus => Let t xs (If t (Op t Equal [Var t 0; Op t (Const 0) []])
+                                    (Raise t (Op t (Cons div_tag) []))
+                                    (Op t Mod [Var t 0; Var t 1]))
+    | GlobalVarAlloc n => Let t xs (AllocGlobals t n)
+    | GlobalVarInit n => Op t (SetGlobal n) xs
+    | GlobalVarLookup n => Op t (Global n) xs
+    | Equality => Op t Equal xs
+    | FFI n => Op t (FFI n) xs
+    | ListAppend => Op t ListAppend xs
+    | Vlength => Op t LengthBlock xs
+    | Alength => Op t Length xs
+    | Implode => Op t FromListByte xs
+    | Explode => Op t ToListByte xs
+    | Strlen => Op t LengthByteVec xs
+    | Strcat => Op t ConcatByteVec xs
+    | CopyStrStr => Let t xs (CopyByteStr t)
+    | CopyStrAw8 => Let t xs (CopyByteAw8 t)
+    | CopyAw8Str => Let t xs (CopyByteStr t)
+    | CopyAw8Aw8 => Let t xs (CopyByteAw8 t)
+    | VfromList => Op t (FromList 0) xs
+    | WordFromInt W64 => Op t WordFromInt xs
+    | WordToInt W64 => Op t WordToInt xs
+    | WordFromInt W8 => arg1 xs (\x. Op t Mod [Op t (Const 256) []; x])
+    | WordToInt W8 => arg1 xs (\x. x)
+    | Aw8length => Op t LengthByte xs
+    | Aalloc => Let t xs (If t (Op t Less [Op t (Const 0) []; Var t 1])
+                               (Raise t (Op t (Cons subscript_tag) []))
+                               (Op t RefArray [Var t 0; Var t 1]))
+    | Aw8alloc => Let t xs (If t (Op t Less [Op t (Const 0) []; Var t 1])
+                                 (Raise t (Op t (Cons subscript_tag) []))
+                                 (Op t (RefByte F) [Var t 0; Var t 1]))
+    | Vsub => Let t xs (If t (Op t BoundsCheckBlock [Var t 0; Var t 1])
+                             (Op t El [Var t 0; Var t 1])
+                             (Raise t (Op t (Cons subscript_tag) [])))
+    | Asub => Let t xs (If t (Op t BoundsCheckArray [Var t 0; Var t 1])
+                             (Op t El [Var t 0; Var t 1])
+                             (Raise t (Op t (Cons subscript_tag) [])))
+    | Asub_unsafe => Op t El xs
+    | Aupdate => Let t xs (If t (Op t BoundsCheckArray [Var t 1; Var t 2])
+                                (Op t Update [Var t 0; Var t 1; Var t 2])
+                                (Raise t (Op t (Cons subscript_tag) [])))
+    | Aupdate_unsafe => Op t Update xs
+    | Aw8sub => Let t xs (If t (Op t (BoundsCheckByte F) [Var t 0; Var t 1])
+                               (Op t DerefByte [Var t 0; Var t 1])
+                               (Raise t (Op t (Cons subscript_tag) [])))
+    | Aw8sub_unsafe => Op t DerefByte xs
+    | Aw8update => Let t xs (If t (Op t (BoundsCheckByte F) [Var t 1; Var t 2])
+                                  (Op t UpdateByte [Var t 0; Var t 1; Var t 2])
+                                  (Raise t (Op t (Cons subscript_tag) [])))
+    | Aw8update_unsafe => Op t UpdateByte xs
+    | Strsub => Let t xs (If t (Op t (BoundsCheckByte F) [Var t 0; Var t 1])
+                               (Op t DerefByteVec [Var t 0; Var t 1])
+                               (Raise t (Op t (Cons subscript_tag) [])))
+    | FP_cmp c => Op t (FP_cmp c) xs
+    | FP_uop c => Op t (FP_uop c) xs
+    | FP_bop c => Op t (FP_bop c) xs
+    | FP_top c => Op t (FP_top c) xs
+    | Shift x1 x2 x3 => Op t (WordShift x1 x2 x3) xs
+    | Opw x1 x2 => Op t (WordOp x1 x2) xs
+    | _ => Let None xs (Var None 0)
+End
+
+Definition compile_def:
+  (compile m [] = []) /\
+  (compile m (x::y::xs) = compile m [x] ++ compile m (y::xs)) /\
+  (compile m [flatLang$Raise t e] = [closLang$Raise t (HD (compile m [e]))]) /\
+  (compile m [Lit t l] = [compile_lit t l]) /\
+  (compile m [Var_local t v] = [Var t (findi (SOME v) m)]) /\
+  (compile m [Con t n es] =
+     let tag = (case n of SOME (t,_) => t | _ => 0) in
+       [Op t (Cons tag) (compile m (REVERSE es))]) /\
+  (compile m [App t op es] = [compile_op t op (compile m (REVERSE es))]) /\
+  (compile m [Fun t v e] = [Fn t NONE NONE 1 (HD (compile (SOME v::m) [e]))]) /\
+  (compile m [If t x1 x2 x3] =
+     [If t (HD (compile m [x1]))
+           (HD (compile m [x2]))
+           (HD (compile m [x3]))]) /\
+  (compile m [Let t vo e1 e2] =
+     [Let t (compile m [e1]) (HD (compile (vo::m) [e2]))]) /\
+  (compile m [Mat t e pes] = [Op t (Const 0) []]) /\
+  (compile m [Handle t e pes] =
+     case dest_pat pes of
+     | SOME (v,h) => [Handle t (HD (compile m [e])) (HD (compile (SOME v::m) [h]))]
+     | _ => compile m [e]) /\
+  (compile m [Letrec t funs e] =
+     let new_m = MAP (\n. SOME (FST n)) funs ++ m in
+       [Letrec t NONE NONE
+          (MAP ( \ (f,v,x). (1, HD (compile (SOME v :: new_m) [x]))) funs)
+          (HD (compile new_m [e]))])
+Termination
+  WF_REL_TAC `measure (flatLang$exp6_size o SND)` \\ rw []
+  \\ `!funs f v x. MEM (f,v,x) funs ==> exp_size x < flatLang$exp1_size funs` by
+    (Induct \\ fs [] \\ rw [] \\ fs [flatLangTheory.exp_size_def] \\ res_tac \\ fs [])
+  \\ res_tac \\ fs [dest_pat_thm] \\ fs [flatLangTheory.exp_size_def]
+End
+
+Definition compile_decs_def:
+  compile_decs [] = [] /\
+  compile_decs ((Dlet e)::xs) = compile [] [e] ++ compile_decs xs /\
+  compile_decs (_::xs) = compile_decs xs
+End
+
+Theorem LENGTH_compile:
+  !m xs. LENGTH (compile m xs) = LENGTH xs
+Proof
+  ho_match_mp_tac compile_ind \\ fs [compile_def]
+  \\ rw [] \\ every_case_tac \\ fs []
+QED
+
+Theorem compile_NOT_NIL[simp]:
+  compile m (x::xs) <> []
+Proof
+  rewrite_tac [GSYM LENGTH_NIL,LENGTH_compile] \\ fs []
+QED
+
+Theorem HD_compile[simp]:
+  [HD (compile m [x])] = compile m [x]
+Proof
+  qspecl_then [`m`,`[x]`] mp_tac (SIMP_RULE std_ss [] LENGTH_compile)
+  \\ Cases_on `compile m [x]` \\ fs []
+QED
+
+val _ = export_theory()
diff --git a/compiler/backend/flat_to_patScript.sml b/compiler/backend/flat_to_patScript.sml
deleted file mode 100644
index 52e589d539..0000000000
--- a/compiler/backend/flat_to_patScript.sml
+++ /dev/null
@@ -1,421 +0,0 @@
-(*
-  This phase performs pattern-match compilation.
-*)
-open preamble flatLangTheory patLangTheory
-open backend_commonTheory
-
-val _ = new_theory"flat_to_pat"
-val _ = set_grammar_ancestry ["flatLang", "patLang", "misc"];
-val _ = temp_tight_equality ();
-val _ = patternMatchesLib.ENABLE_PMATCH_CASES();
-
-val Bool_def = Define `
-  Bool t b = Con t (if b then true_tag else false_tag) []`;
-val Bool_eqns = save_thm("Bool_eqns[simp]",
-  [``Bool t T``,``Bool t F``]
-  |> List.map (SIMP_CONV(std_ss)[Bool_def])
-  |> LIST_CONJ)
-
-val isBool_def = Define`
-  isBool b e =
-  dtcase e of Con _ t [] => (b ⇒ t = true_tag) ∧ (¬b ⇒ t = false_tag) | _ => F`;
-val _ = export_rewrites["isBool_def"];
-
-Theorem isBool_pmatch:
-   isBool b e =
-   case e of Con _ t [] => (b ⇒ t = true_tag) ∧ (¬b ⇒ t = false_tag) | _ => F
-Proof
-  CONV_TAC (RAND_CONV patternMatchesLib.PMATCH_ELIM_CONV) \\
-  CASE_TAC \\ simp[]
-QED
-
-val sIf_def = Define `
-  sIf tra e1 e2 e3 =
-  if isBool T e2 ∧ isBool F e3
-    then e1
-  else
-    (dtcase e1 of
-     | Con _ t [] => if t = true_tag then e2 else e3
-     | _ => If tra e1 e2 e3)`;
-
-Theorem sIf_pmatch:
-  !e1 e2 e3.
-  sIf t e1 e2 e3 =
-  if isBool T e2 ∧ isBool F e3
-    then e1
-  else
-    (case e1 of
-     | Con _ t [] => if t = true_tag then e2 else e3
-     | _ => If t e1 e2 e3)
-Proof
-  rpt strip_tac
-  >> every_case_tac
-  >- fs[sIf_def]
-  >- (CONV_TAC(RAND_CONV patternMatchesLib.PMATCH_ELIM_CONV) >> every_case_tac >> fs[sIf_def])
-QED
-
-val _ = Define `
-  pure_op_op op ⇔
-    (op <> Opref) ∧
-    (op <> Opapp) ∧
-    (op <> Opassign) ∧
-    (op <> Aw8update) ∧
-    (op <> Aw8alloc) ∧
-    (op <> Aw8sub) ∧
-    (op <> Aw8update_unsafe) ∧
-    (op <> Aw8sub_unsafe) ∧
-    (op <> Vsub) ∧
-    (op <> Strsub) ∧
-    (op <> CopyStrStr) ∧
-    (op <> CopyStrAw8) ∧
-    (op <> CopyAw8Str) ∧
-    (op <> CopyAw8Aw8) ∧
-    (op <> Chr) ∧
-    (op <> Aupdate) ∧
-    (op <> Aalloc) ∧
-    (op <> Asub) ∧
-    (op <> Aupdate_unsafe) ∧
-    (op <> Asub_unsafe) ∧
-    (op <> (Opn Divide)) ∧
-    (op <> (Opn Modulo)) ∧
-    (!n. op <> (GlobalVarAlloc n)) ∧
-    (!n. op <> (GlobalVarInit n)) ∧
-    (!n. op <> FFI n)`;
-
-val _ = Define `
-  (pure_op (Op op) ⇔ pure_op_op op)
-  ∧
-  (pure_op (Tag_eq _ _) ⇔ T)
-  ∧
-  (pure_op (El _) ⇔ T)
-  ∧
-  (pure_op _ ⇔ F)`;
-
-val pure_def = Define `
-  (pure (Raise _ _) ⇔ F)
-  ∧
-  (pure (Handle _ e1 _) ⇔ pure e1)
-  ∧
-  (pure (Lit _ _) ⇔ T)
-  ∧
-  (pure (Con _ _ es) ⇔ pure_list es)
-  ∧
-  (pure (Var_local _ _) ⇔ T)
-  ∧
-  (pure (Fun _ _) ⇔ T)
-  ∧
-  (pure (App _ op es) ⇔ pure_list es ∧ pure_op op)
-  ∧
-  (pure (If _ e1 e2 e3) ⇔ pure e1 ∧ pure e2 ∧ pure e3)
-  ∧
-  (pure (Let _ e1 e2) ⇔ pure e1 ∧ pure e2)
-  ∧
-  (pure (Seq _ e1 e2) ⇔ pure e1 ∧ pure e2)
-  ∧
-  (pure (Letrec _ _ e) ⇔ pure e)
-  ∧
-  (pure_list [] ⇔ T)
-  ∧
-  (pure_list (e::es) ⇔ pure e ∧ pure_list es)`;
-
-Theorem pure_list_EVERY:
-   ∀ls. pure_list ls ⇔ EVERY pure ls
-Proof
-  Induct >> simp[pure_def]
-QED
-val _ = export_rewrites["pure_list_EVERY"]
-
-val ground_def = Define `
-  (ground n (Raise _ e) ⇔ ground n e)
-  ∧
-  (ground n (Handle _ e1 e2) ⇔ ground n e1 ∧ ground (n+1) e2)
-  ∧
-  (ground _ (Lit _ _) ⇔ T)
-  ∧
-  (ground n (Con _ _ es) ⇔ ground_list n es)
-  ∧
-  (ground n (Var_local _ k) ⇔ k < n)
-  ∧
-  (ground _ (Fun _ _) ⇔ F)
-  ∧
-  (ground n (App _ _ es) ⇔ ground_list n es)
-  ∧
-  (ground n (If _ e1 e2 e3) ⇔ ground n e1 ∧ ground n e2 ∧ ground n e3)
-  ∧
-  (ground n (Let _ e1 e2) ⇔ ground n e1 ∧ ground (n+1) e2)
-  ∧
-  (ground n (Seq _ e1 e2) ⇔ ground n e1 ∧ ground n e2)
-  ∧
-  (ground _ (Letrec _ _ _) ⇔ F)
-  ∧
-  (ground_list _ [] ⇔ T)
-  ∧
-  (ground_list n (e::es) ⇔ ground n e ∧ ground_list n es)`;
-
-val _ = export_rewrites["pure_op_op_def","pure_op_def","pure_def","ground_def"];
-
-Theorem ground_list_EVERY:
-   ∀n ls. ground_list n ls ⇔ EVERY (ground n) ls
-Proof
-  gen_tac >> Induct >> simp[]
-QED
-val _ = export_rewrites["ground_list_EVERY"]
-
-Theorem pure_op_op_eqn:
-    pure_op_op op =
-  dtcase op of
-    Opref => F
-  | Opapp => F
-  | Opassign => F
-  | Aw8update => F
-  | Aw8alloc => F
-  | Aw8sub => F
-  | Aw8update_unsafe => F
-  | Aw8sub_unsafe => F
-  | Vsub => F
-  | Strsub => F
-  | CopyStrStr => F
-  | CopyStrAw8 => F
-  | CopyAw8Str => F
-  | CopyAw8Aw8 => F
-  | Chr => F
-  | Aupdate => F
-  | Aalloc => F
-  | Asub => F
-  | Aupdate_unsafe => F
-  | Asub_unsafe => F
-  | Opn Divide => F
-  | Opn Modulo => F
-  | GlobalVarAlloc _ => F
-  | GlobalVarInit _ => F
-  | FFI _ => F
-  | _ => T
-Proof
-  Cases_on`op`>>fs[]>>
-  Cases_on`o'`>>fs[]
-QED
-
-Theorem pure_op_op_pmatch:
-    pure_op_op op =
-  case op of
-    Opref => F
-  | Opapp => F
-  | Opassign => F
-  | Aw8update => F
-  | Aw8alloc => F
-  | Aw8sub => F
-  | Aw8update_unsafe => F
-  | Aw8sub_unsafe => F
-  | Vsub => F
-  | Strsub => F
-  | CopyStrStr => F
-  | CopyStrAw8 => F
-  | CopyAw8Str => F
-  | CopyAw8Aw8 => F
-  | Chr => F
-  | Aupdate => F
-  | Aalloc => F
-  | Asub => F
-  | Aupdate_unsafe => F
-  | Asub_unsafe => F
-  | Opn Divide => F
-  | Opn Modulo => F
-  | GlobalVarAlloc _ => F
-  | GlobalVarInit _ => F
-  | FFI _ => F
-  | _ => T
-Proof
-  PURE_ONCE_REWRITE_TAC [pure_op_op_eqn]
-  >> CONV_TAC(RAND_CONV patternMatchesLib.PMATCH_ELIM_CONV)
-  >> REFL_TAC
-QED
-
-val sLet_def = Define `
-  sLet t e1 e2 =
-  dtcase e2 of
-     | Var_local _ 0 => e1
-     | _ =>
-         if ground 0 e2 then
-           if pure e1 then e2
-           else Seq t e1 e2
-         else Let t e1 e2`;
-
-Theorem sLet_pmatch:
-   sLet t e1 e2 =
-   case e2 of
-     | Var_local _ 0 => e1
-     | _ =>
-         if ground 0 e2 then
-           if pure e1 then e2
-           else Seq t e1 e2
-         else Let t e1 e2
-Proof
-  CONV_TAC(RAND_CONV patternMatchesLib.PMATCH_ELIM_CONV) \\
-  CASE_TAC \\ rw[sLet_def]
-QED
-
-(* bind elements 0..k of the variable n in reverse order above e (first element
- * becomes most recently bound) *)
-val _ = Define`
-  (Let_Els _ _ 0 e = e)
-  ∧
-  (Let_Els t n k e =
-   sLet (mk_cons t 1) (App (mk_cons t 2) (El (k-1)) [Var_local (mk_cons t 3) n])
-     (Let_Els (mk_cons t 4) (n+1) (k-1) e))`;
-
-(* return an expression that evaluates to whether the pattern matches the most
- * recently bound variable *)
-val _ = tDefine"compile_pat"`
-  (compile_pat t (Pvar _) =
-   Bool t T)
-  ∧
-  (compile_pat t Pany =
-   Bool t T)
-  ∧
-  (compile_pat t (Plit l) =
-   App (mk_cons t 1) (Op Equality) [Var_local (mk_cons t 2) 0; Lit (mk_cons t 3) l])
-  ∧
-  (compile_pat t (Pcon NONE _) =
-   Bool t F) (* should not happen *)
-  ∧
-  (compile_pat t (Pcon (SOME (tag,_)) []) =
-   App (mk_cons t 1) (Tag_eq tag 0) [Var_local (mk_cons t 2) 0])
-  ∧
-  (compile_pat t (Pcon (SOME (tag,_)) ps) =
-   sIf (mk_cons t 1) (App (mk_cons t 2) (Tag_eq tag (LENGTH ps)) [Var_local (mk_cons t 3) 0])
-     (Let_Els (mk_cons t 4) 0 (LENGTH ps) (compile_pats (mk_cons t 5) 0 ps))
-     (Bool (mk_cons t 6) F))
-  ∧
-  (compile_pat t (Pref p) =
-   sLet (mk_cons t 1) (App (mk_cons t 2) (Op Opderef) [Var_local (mk_cons t 3) 0])
-     (compile_pat (mk_cons t 4) p))
-  ∧
-(* return an expression that evaluates to whether all the m patterns match the
- * m most recently bound variables; n counts 0..m *)
-  (compile_pats t _ [] = Bool t T)
-  ∧
-  (compile_pats t n (p::ps) =
-   sIf (mk_cons t 1) (sLet (mk_cons t 2) (Var_local (mk_cons t 3) n)
-   (compile_pat (mk_cons t 4) p)) (compile_pats (mk_cons t 5) (n+1) ps) (Bool (mk_cons t 6) F))`
-  (WF_REL_TAC `inv_image $< (\x. dtcase x of INL (_,p) => pat_size p
-                                           | INR (_,n,ps) => pat1_size ps)`);
-
-(* given a pattern in a context of bound variables where the most recently
- * bound variable is the value to be matched, return a function that binds new
- * variables (including all the pattern variables) over an expression and the
- * new context of bound variables for the expression as well as the number of
- * newly bound variables *)
-val _ = tDefine"compile_row"`
-  (compile_row _ (NONE::bvs) (Pvar x) = ((SOME x::bvs), 0, I))
-  ∧
-  (compile_row _ bvs Pany = (bvs, 0, I))
-  ∧
-  (compile_row _ bvs (Plit _) = (bvs, 0, I))
-  ∧
-  (compile_row t bvs (Pcon _ ps) = compile_cols t bvs 0 0 ps)
-  ∧
-  (compile_row t bvs (Pref p) =
-   let (bvs,m,f) = (compile_row (mk_cons t 1) (NONE::bvs) p) in
-   (bvs,(1+m), (λe. sLet (mk_cons t 2) (App (mk_cons t 3) (Op Opderef) [Var_local (mk_cons t 4) 0]) (f e)))) ∧
-  (compile_row _ bvs _ = (bvs, 0, I)) (* should not happen *)
-  ∧
-  (compile_cols _ bvs _ _ [] = (bvs, 0, I))
-  ∧
-  (compile_cols t bvs n k (p::ps) =
-   let (bvs,m,f) = compile_row (mk_cons t 1) (NONE::bvs) p in
-   let (bvs,ms,fs) = compile_cols (mk_cons t 2) bvs ((n+1)+m) (k+1) ps in
-   (bvs,(1+m)+ms,
-    (λe. sLet (mk_cons t 3) (App (mk_cons t 4) (El k) [Var_local (mk_cons t 5) n]) (f (fs e)))))`
-  (WF_REL_TAC `inv_image $< (\x. dtcase x of INL (_,bvs,p) => pat_size p
-                                           | INR (_,bvs,n,k,ps) => pat1_size ps)`);
-
-(* translate under a context of bound variables *)
-(* compile_pes assumes the value being matched is most recently bound *)
-val compile_exp_def = tDefine"compile_exp" `
-  (compile_exp bvs (Raise t e) = Raise t (compile_exp bvs e))
-  ∧
-  (compile_exp bvs (Handle t e1 pes) =
-   Handle (mk_cons t 1) (compile_exp bvs e1) (compile_pes (mk_cons t 2) (NONE::bvs) pes))
-  ∧
-  (compile_exp _ (Lit t l) = Lit t l)
-  ∧
-  (compile_exp bvs (If t e1 e2 e3) =
-   sIf t (compile_exp bvs e1) (compile_exp bvs e2) (compile_exp bvs e3))
-  ∧
-  (compile_exp bvs (Con t NONE _) = Lit t (IntLit 0) (* should not happen *))
-  ∧
-  (compile_exp bvs (Con t (SOME (tag,_)) es) = Con t tag (compile_exps bvs es))
-  ∧
-  (compile_exp bvs (Var_local t x) =
-   (dtcase find_index (SOME x) bvs 0 of
-    | SOME k => Var_local t k
-    | NONE => Lit t (IntLit 0) (* should not happen *)))
-  ∧
-  (compile_exp bvs (Fun t x e) = Fun t (compile_exp (SOME x::bvs) e))
-  ∧
-  (compile_exp bvs (App t op es) = App t (Op op) (compile_exps bvs es))
-  ∧
-  (compile_exp bvs (Mat t e pes) =
-   sLet (mk_cons t 1) (compile_exp bvs e) (compile_pes (mk_cons t 2) (NONE::bvs) pes))
-  ∧
-  (compile_exp bvs (Let t (SOME x) e1 e2) =
-   sLet t (compile_exp bvs e1) (compile_exp (SOME x::bvs) e2))
-  ∧
-  (compile_exp bvs (Let t NONE e1 e2) =
-   Seq t (compile_exp bvs e1) (compile_exp bvs e2))
-  ∧
-  (compile_exp bvs (Letrec t funs e) =
-   let bvs = (MAP (SOME o FST) funs) ++ bvs in
-   Letrec t (compile_funs bvs funs) (compile_exp bvs e))
-  ∧
-  (compile_exps _ [] = [])
-  ∧
-  (compile_exps bvs (e::es) =
-   compile_exp bvs e :: compile_exps bvs es)
-  ∧
-  (compile_funs _ [] = [])
-  ∧
-  (compile_funs bvs ((_,x,e)::funs) =
-   compile_exp (SOME x::bvs) e :: compile_funs bvs funs)
-  ∧
-  (compile_pes tra bvs [(p,e)] =
-   (dtcase compile_row tra bvs p of (bvs,_,f) => f (compile_exp bvs e)))
-  ∧
-  (compile_pes tra bvs ((p,e)::pes) =
-   sIf (mk_cons tra 1) (compile_pat (mk_cons tra 2) p)
-     (dtcase compile_row (mk_cons tra 3) bvs p of (bvs,_,f) => f (compile_exp bvs e) )
-     (compile_pes (mk_cons tra 4) bvs pes))
-  ∧
-  (compile_pes t _ _ = Lit t (IntLit 0))`
-  (WF_REL_TAC `inv_image $< (\x. dtcase x of INL (bvs,e) => exp_size e
-                                         | INR (INL (bvs,es)) => exp6_size es
-                                         | INR (INR (INL (bvs,funs))) => exp1_size funs
-                                         | INR (INR (INR (_,bvs,pes))) =>
-                                             exp3_size pes)`);
-val _ = export_rewrites["compile_exp_def"];
-
-val compile_def = Define`
-  compile [] = [] ∧
-  compile ((Dlet exp)::decs) =
-    compile_exp [] exp :: compile decs ∧
-  compile (_::decs) = compile decs`;
-
-Theorem compile_funs_map:
-   ∀funs bvs. compile_funs bvs funs = MAP (λ(f,x,e). compile_exp (SOME x::bvs) e) funs
-Proof
-  Induct>>simp[pairTheory.FORALL_PROD]
-QED
-
-Theorem compile_exps_map:
-   ∀es. compile_exps a es = MAP (compile_exp a) es
-Proof
-  Induct >> simp[compile_exp_def]
-QED
-
-Theorem compile_exps_reverse:
-   compile_exps a (REVERSE ls) = REVERSE (compile_exps a ls)
-Proof
-  rw[compile_exps_map,rich_listTheory.MAP_REVERSE]
-QED
-
-val _ = export_theory()
diff --git a/compiler/backend/jsonLangScript.sml b/compiler/backend/jsonLangScript.sml
index fa155cd087..e72e66a595 100644
--- a/compiler/backend/jsonLangScript.sml
+++ b/compiler/backend/jsonLangScript.sml
@@ -5,15 +5,15 @@
   in {}, in which case it can be viewed as a key-value store of names
   (strings) and JSON objects.
 *)
-open preamble mlintTheory
+open preamble mlintTheory mlstringTheory
 
 val _ = new_theory"jsonLang";
 
 val _ = Datatype`
   obj =
-     Object (( string # obj ) list)
+     Object ((mlstring # obj ) list)
    | Array (obj list)
-   | String string
+   | String mlstring
    | Int int
    | Bool bool
    | Null`;
@@ -21,39 +21,49 @@ val _ = Datatype`
 Overload "++"[local] = ``Append``
 
 val concat_with_def = Define`
-  (concat_with [] c acc = acc) /\
-  (concat_with [s] c acc = acc ++ s) /\
-  (concat_with (s::ss) c acc = concat_with ss c (acc ++ s ++ c))`;
+  (concat_with [] c = List []) /\
+  (concat_with [s] c = s) /\
+  (concat_with (s::ss) c = s ++ (c ++ concat_with ss c))`;
 
-(* To output a string in the JSON such that, if the string would be printed
-* directly, it should look like the corresponding CakeML value. *)
-val escape_def = Define`
-  (escape "" = "")
-  /\
-  (* Output two backslashes in the JSON, followed by an "n", which will be
-  * printed as "\n". *)
-  (escape (#"\n"::s) = #"\\":: #"\\" :: #"n" ::escape s)
-  /\
-  (* Output four backslashes in the JSON, which will be printed as "\\". *)
-  (escape (#"\\"::s) = #"\\":: #"\\" :: #"\\":: #"\\" ::escape s)
-  /\
-  (escape (#"\""::s) = #"\\":: #"\"" ::escape s)
-  /\
-  (escape (h::s) = h::escape s)`;
+val printable_def = Define`
+  printable c <=> ORD c >= 32 /\ ORD c < 127 /\ c <> #"\"" /\ c <> #"\\"`;
+
+val num_to_hex_digit_def = Define `
+  num_to_hex_digit n =
+    if n < 10 then [CHR (48 + n)] else
+    if n < 16 then [CHR (55 + n)] else []`;
+
+val n_rev_hex_digs = Define `
+  n_rev_hex_digs 0 x = [] /\
+  n_rev_hex_digs (SUC n) x = (num_to_hex_digit (x MOD 16) ++
+    n_rev_hex_digs n (x DIV 16))`;
+
+val encode_str_def = Define`
+  encode_str unicode s =
+  let s2 = explode s in
+  if EVERY printable s2 then s
+  else concat (MAP (\c. if printable c then implode [c]
+    else if unicode then implode ("\\u" ++ REVERSE (n_rev_hex_digs 4 (ORD c)))
+    else concat [strlit "\\"; toString (ORD c)]) s2)`;
 
 val obj_size_def = fetch "-" "obj_size_def"
 
-val json_to_string_def = tDefine "json_to_string" `
-  (json_to_string obj =
+val json_to_mlstring_def = tDefine "json_to_mlstring" `
+  (json_to_mlstring obj =
     case obj of
-       | Object mems => List "{" ++ (concat_with (MAP mem_to_string mems) (List ",") (List "")) ++ List "}"
-       | Array obs => List "[" ++ (concat_with (MAP json_to_string obs) (List ",") (List "")) ++ List "]"
-       | String s => List "\"" ++ List (escape s) ++ List "\""
-       | Int i => List (explode (toString i))
-       | Bool b => if b then List "true" else List "false"
-       | Null => List "null")
+        | Object mems => List [strlit "{"] ++
+                concat_with (MAP mem_to_string mems) (List [strlit ","]) ++
+                List [strlit "}"]
+        | Array obs => List [strlit "["] ++
+                concat_with (MAP json_to_mlstring obs) (List [strlit ","]) ++
+                List [strlit "]"]
+       | String s => List ([strlit "\""; encode_str T s; strlit "\""])
+       | Int i => List [toString i]
+       | Bool b => if b then List [strlit "true"] else List [strlit "false"]
+       | Null => List [strlit "null"])
   /\
-  (mem_to_string (n, ob) = List "\"" ++ List n ++ List "\":" ++ (json_to_string ob))`
+  (mem_to_string n_obj = let (n, obj) = n_obj in
+        List [strlit "\""; n; strlit "\":"] ++ json_to_mlstring obj)`
   (WF_REL_TAC `measure (\x. case x of
        | INL obj => obj_size obj
        | INR p => obj2_size p)` \\ rw []
diff --git a/compiler/backend/patLangScript.sml b/compiler/backend/patLangScript.sml
deleted file mode 100644
index cf8a268094..0000000000
--- a/compiler/backend/patLangScript.sml
+++ /dev/null
@@ -1,48 +0,0 @@
-(*
-  The patLang intermediate language follows immediately after
-  pattern-match compilation from flatLang. The patLang language
-  differs from earlier languages in that it uses de Bruijn indices
-  for variable names.
-*)
-open preamble flatLangTheory;
-
-val _ = new_theory "patLang"
-val _ = set_grammar_ancestry ["flatLang"]
-
-val _ = Datatype`
-  op =
-   | Op (flatLang$op)
-   | Run (* TODO: will eventually be inherited from earlier languages via Op *)
-   | Tag_eq num num
-   | El num`;
-
-val _ = Datatype`
-  exp =
-   | Raise tra exp
-   | Handle tra exp exp
-   | Lit tra lit
-   | Con tra num (exp list)
-   | Var_local tra num
-   | Fun tra exp
-   | App tra op (exp list)
-   | If tra exp exp exp
-   | Let tra exp exp
-   | Seq tra exp exp
-   | Letrec tra (exp list) exp`;
-
-(*TODO: Verify that the introduction of traces wont mess exp_sizes *)
-val exp_size_def = definition"exp_size_def";
-
-Theorem exp1_size_APPEND[simp]:
-   patLang$exp1_size (e ++ e2) = exp1_size e + exp1_size e2
-Proof
-  Induct_on`e`>>simp[exp_size_def]
-QED
-
-Theorem exp1_size_REVERSE[simp]:
-   patLang$exp1_size (REVERSE es) = exp1_size es
-Proof
-  Induct_on`es`>>simp[exp_size_def]
-QED
-
-val _ = export_theory()
diff --git a/compiler/backend/pat_to_closScript.sml b/compiler/backend/pat_to_closScript.sml
deleted file mode 100644
index f94a35bbf5..0000000000
--- a/compiler/backend/pat_to_closScript.sml
+++ /dev/null
@@ -1,286 +0,0 @@
-(*
-  The translation from patLang to closLang is very simple.
-  Its main purpose is simplifying the semantics of some operations,
-  for example to explicitly raise an exception for Div so the semantics
-  in closLang can make more assumptions about the arguments.
-*)
-open preamble patLangTheory closLangTheory backend_commonTheory
-
-val _ = new_theory"pat_to_clos"
-val _ = set_grammar_ancestry ["patLang", "closLang", "backend_common"]
-
-val vector_tag_def = Define`vector_tag = 0:num`
-
-fun var_fun m n = ``closLang$Var (tra § ^(numSyntax.term_of_int(36+n))) ^(numSyntax.term_of_int(m-n))``;
-
-fun check1 tm var =
-``(If (tra§1) (Op (tra§2) Less [Op (tra§3) (Const 0) []; ^(var 2)]) (Raise (tra§4) (Op (tra§5) (Cons subscript_tag) []))
-  (If (tra§6) (Op (tra§7) Less [Op (tra§8) (Const 0) []; ^(var 1)]) (Raise (tra§9) (Op (tra§10) (Cons subscript_tag) []))
-  (If (tra§11) (Op (tra§12) (BoundsCheckByte T) [Op (tra§13) Add [^(var 2); ^(var 1)]; ^(var 0)]) ^tm
-  (Raise (tra§14) (Op (tra§15) (Cons subscript_tag) [])))))``;
-
-val checkT = check1
-  ``(closLang$Op (tra§16) (CopyByte T) [Var (tra§17) 0; Var (tra§18) 1; Var (tra§19) 2])`` (var_fun 2);
-
-val checkF = check1
-``(If (tra§16) (Op (tra§17) Less [Op (tra§18) (Const 0) []; Var (tra§19) 0]) (Raise (tra§20) (Op (tra§21) (Cons subscript_tag) []))
-  (If (tra§22) (Op (tra§23) (BoundsCheckByte T) [Op (tra§24) Add [Var (tra§25) 2; Var (tra§26) 0]; Var (tra§27) 1])
-     (Op (tra§28) (CopyByte F) [Var (tra§29) 0; Var (tra§30) 1; Var (tra§31) 2; Var (tra§32) 3; Var (tra§33) 4])
-     (Raise (tra§34) (Op (tra§35) (Cons subscript_tag) []))))`` (var_fun 4);
-
-val CopyByteStr_def = Define`CopyByteStr tra = ^checkT`;
-val CopyByteAw8_def = Define`CopyByteAw8 tra = ^checkF`;
-
-val dest_WordToInt_def = Define `
-  (dest_WordToInt w [App _ op [x]] =
-    (if op = Op (WordToInt w) then SOME x else NONE)) /\
-  (dest_WordToInt w _ = NONE)`
-
-val exp_size_def = patLangTheory.exp_size_def
-
-val MEM_exp1_size = prove(
-  ``!es. MEM a es ==> exp_size a < exp1_size es``,
-  Induct_on`es` >> simp[exp_size_def] >>
-  rw[] >> res_tac >> fs[] >> simp[exp_size_def] >>
-  Cases_on`es`>>fs[LENGTH_NIL,exp_size_def] >> simp[] >>
-  Cases_on`t`>>fs[exp_size_def] >> rw[] >> simp[]>>
-  Cases_on`t'`>>fs[exp_size_def] >> rw[] >> simp[]);
-
-val dest_WordToInt_exp_size = prove(
-  ``!w es e. (dest_WordToInt w es = SOME e) ==>
-             exp_size e < exp1_size es``,
-  ho_match_mp_tac (theorem "dest_WordToInt_ind")
-  \\ fs [dest_WordToInt_def] \\ fs [exp_size_def]);
-
-val compile_def = tDefine"compile" `
-  (compile (Raise tra e) =
-    Raise tra (compile e)) ∧
-  (compile (Handle tra e1 e2) =
-    Handle tra (compile e1) (compile e2)) ∧
-  (compile (Lit tra (IntLit i)) =
-    Op tra (Const i) []) ∧
-  (compile (Lit tra (Word8 w)) =
-    Op tra (Const (& (w2n w))) []) ∧
-  (compile (Lit tra (Word64 w)) =
-    Op (tra§0) WordFromInt [Op (tra§1) (Const (&(w2n w))) []]) ∧
-  (compile (Lit tra (Char c)) =
-    Op tra (Const (& ORD c)) []) ∧
-  (compile (Lit tra (StrLit s)) =
-    Op tra (String s) []) ∧
-  (compile (Con tra cn es) =
-    Op tra (Cons cn) (REVERSE (MAP compile es))) ∧
-  (compile (Var_local tra n) =
-    Var tra n) ∧
-  (compile (Fun tra e) =
-    Fn tra NONE NONE 1 (compile e)) ∧
-  (compile (App tra (Op Opapp) es) =
-    if LENGTH es ≠ 2 then Op tra Sub (REVERSE (MAP compile es)) else
-    App tra NONE (compile (EL 0 es)) [compile (EL 1 es)]) ∧
-  (compile (App tra (Op (Opn Plus)) es) =
-    Op tra Add (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Opn Minus)) es) =
-    Op tra Sub (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Opn Times)) es) =
-    Op tra Mult (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Opn Divide)) es) =
-    Let (tra§1) (REVERSE (MAP compile es))
-      (If (tra§2)
-        (Op (tra§3) Equal [Var (tra§4) 0;
-                           Op (tra§5) (Const 0) []])
-        (Raise (tra§6) (Op (tra§7) (Cons div_tag) []))
-        (Op (tra§8) Div [Var (tra§9) 0; Var (tra§10) 1]))) ∧
-  (compile (App tra (Op (Opn Modulo)) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (If (tra§1) (Op (tra§2) Equal [Var (tra§3) 0; Op (tra§4) (Const 0) []])
-          (Raise (tra§5) (Op (tra§6) (Cons div_tag) []))
-          (Op (tra§7) Mod [Var (tra§8) 0; Var (tra§9) 1]))) ∧
-  (compile (App tra (Op (Opw wz opw)) es) =
-      Op tra (WordOp wz opw) (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Shift wz sh n)) es) =
-      Op tra (WordShift wz sh n) (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Opb Lt)) es) =
-    Op tra Less (REVERSE (MAP compile es))) ∧
- (compile (App tra (Op (Opb Gt)) es) =
-    Op tra Greater (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Opb Leq)) es) =
-    Op tra LessEq (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Opb Geq)) es) =
-    Op tra GreaterEq (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Chopb Lt)) es) =
-    Op tra Less (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Chopb Gt)) es) =
-    Op tra Greater (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Chopb Leq)) es) =
-    Op tra LessEq (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (Chopb Geq)) es) =
-    Op tra GreaterEq (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op Equality) es) =
-    Op tra Equal (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op Opassign) es) =
-    if LENGTH es ≠ 2 then Op tra Sub (REVERSE (MAP compile es)) else
-      Op (tra§0) Update [compile (EL 1 es);
-                         Op (tra§1) (Const 0) [];
-                         compile (EL 0 es)]) ∧
-  (compile (App tra (Op Opderef) es) =
-    Op (tra§0) Deref ((Op (tra§1) (Const 0) [])::(REVERSE (MAP compile es)))) ∧
-  (compile (App tra (Op Opref) es) =
-    Op tra Ref (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (WordFromInt W8)) es) =
-      case dest_WordToInt W64 es of
-      | SOME e => Op tra (WordFromWord T) [compile e]
-      | NONE =>  Op (tra§0) Mod
-          ((Op (tra§1) (Const 256) [])::(REVERSE (MAP compile es)))) ∧
-  (compile (App tra (Op (WordFromInt W64)) es) =
-      case dest_WordToInt W8 es of
-      | SOME e => Op tra (WordFromWord F) [compile e]
-      | NONE => (Op tra WordFromInt (REVERSE (MAP compile es)))) ∧
-  (compile (App tra (Op (WordToInt W8)) es) =
-    if LENGTH es ≠ 1 then Op tra Sub (REVERSE (MAP compile es)) else
-                     compile (HD es)) ∧
-  (compile (App tra (Op (WordToInt W64)) es) =
-    Op tra WordToInt (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op Ord) es) =
-    if LENGTH es ≠ 1 then Op tra Sub (REVERSE (MAP compile es))
-    else compile (HD es)) ∧
-  (compile (App tra (Op Chr) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (If (tra§1) (Op (tra§2) Less [Op (tra§3) (Const 0) []; Var (tra§4) 0])
-        (Raise (tra§5) (Op (tra§6) (Cons chr_tag) []))
-        (If (tra§7) (Op (tra§8) Less [Var (tra§9) 0; Op (tra§10) (Const 255) []])
-          (Raise (tra§11) (Op (tra§12) (Cons chr_tag) []))
-          (Var (tra§13) 0)))) ∧
-  (compile (App tra (Op Aw8alloc) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (If (tra§1) (Op (tra§2) Less [Op (tra§3) (Const 0) []; Var (tra§4) 1])
-          (Raise (tra§5) (Op (tra§6) (Cons subscript_tag) []))
-          (Op (tra§7) (RefByte F) [Var (tra§8) 0; Var (tra§9) 1]))) ∧
-  (compile (App tra (Op Aw8sub) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (If (tra§1) (Op (tra§2) (BoundsCheckByte F) [Var (tra§3) 0; Var (tra§4) 1])
-         (Op (tra§5) DerefByte [Var (tra§6) 0; Var (tra§7) 1])
-         (Raise (tra§8) (Op (tra§9) (Cons subscript_tag) [])))) ∧
-  (compile (App tra (Op Aw8sub_unsafe) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (Op (tra§5) DerefByte [Var (tra§6) 0; Var (tra§7) 1])) ∧
-  (compile (App tra (Op Aw8length) es) =
-    Op tra LengthByte (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op Aw8update) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (If (tra§1) (Op (tra§2) (BoundsCheckByte F) [Var (tra§3) 1; Var (tra§4) 2])
-         (Let (tra§5) [Op (tra§6) UpdateByte [Var (tra§7) 0;
-                        Var (tra§8) 1; Var (tra§9) 2]]
-           (Op (tra§10) (Cons tuple_tag) []))
-         (Raise (tra§11) (Op (tra§12) (Cons subscript_tag) [])))) ∧
-  (compile (App tra (Op Aw8update_unsafe) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (Let (tra§5) [Op (tra§6) UpdateByte [Var (tra§7) 0;
-                    Var (tra§8) 1; Var (tra§9) 2]]
-        (Op (tra§10) (Cons tuple_tag) []))) ∧
-  (compile (App tra (Op Strsub) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (If (tra§1) (Op (tra§2) (BoundsCheckByte F) [Var (tra§3) 0; Var (tra§4) 1])
-         (Op (tra§5) DerefByteVec [Var (tra§6) 0; Var (tra§7) 1])
-         (Raise (tra§8) (Op (tra§9) (Cons subscript_tag) [])))) ∧
-  (compile (App tra (Op Implode) es) =
-    Op tra (FromListByte) (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op Explode) es) =
-    Op tra (ToListByte) (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op Strlen) es) =
-    Op tra LengthByteVec (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op Strcat) es) =
-    Op tra ConcatByteVec (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op CopyStrStr) es) =
-    Let (tra§0) (REVERSE (MAP compile es)) (CopyByteStr tra)) ∧
-  (compile (App tra (Op CopyStrAw8) es) =
-    Let (tra§0) (REVERSE (MAP compile es)) (CopyByteAw8 tra)) ∧
-  (compile (App tra (Op CopyAw8Str) es) =
-    Let (tra§0) (REVERSE (MAP compile es)) (CopyByteStr tra)) ∧
-  (compile (App tra (Op CopyAw8Aw8) es) =
-    Let (tra§0) (REVERSE (MAP compile es)) (CopyByteAw8 tra)) ∧
-  (compile (App tra (Op VfromList) es) =
-    Op tra (FromList vector_tag) (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op Vsub) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (If (tra§1) (Op (tra§2) BoundsCheckBlock [Var (tra§3) 0; Var (tra§4) 1])
-         (Op (tra§5) El [Var (tra§6) 0; Var (tra§7) 1])
-         (Raise (tra§8) (Op (tra§9) (Cons subscript_tag) [])))) ∧
-  (compile (App tra (Op Vlength) es) =
-    Op tra LengthBlock (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op Aalloc) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (If (tra§1) (Op (tra§2) Less [Op (tra§3) (Const 0) []; Var (tra§4) 1])
-          (Raise (tra§5) (Op (tra§6) (Cons subscript_tag) []))
-          (Op (tra§7) RefArray [Var (tra§8) 0; Var (tra§9) 1]))) ∧
-  (compile (App tra (Op Asub) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (If (tra§1) (Op (tra§2) BoundsCheckArray [Var (tra§3) 0; Var (tra§4) 1])
-         (Op (tra§5) Deref [Var (tra§6) 0; Var (tra§7) 1])
-         (Raise (tra§8) (Op (tra§9) (Cons subscript_tag) [])))) ∧
-  (compile (App tra (Op Asub_unsafe) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (Op (tra§5) Deref [Var (tra§6) 0; Var (tra§7) 1])) ∧
-  (compile (App tra (Op Alength) es) =
-    Op tra Length (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op Aupdate) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (If (tra§1) (Op (tra§2) BoundsCheckArray [Var (tra§3) 1; Var (tra§4) 2])
-         (Let (tra§5) [Op (tra§6) Update [Var (tra§7) 0;
-                        Var (tra§8) 1; Var (tra§9) 2]]
-            (Op (tra§10) (Cons tuple_tag) []))
-         (Raise (tra§11) (Op (tra§12) (Cons subscript_tag) [])))) ∧
-  (compile (App tra (Op Aupdate_unsafe) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (Let (tra§5) [Op (tra§6) Update [Var (tra§7) 0;
-                    Var (tra§8) 1; Var (tra§9) 2]]
-        (Op (tra§10) (Cons tuple_tag) []))) ∧
-  (compile (App tra (Op ConfigGC) es) =
-    Op tra ConfigGC (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (FFI n)) es) =
-    Op tra (FFI n) (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op (GlobalVarAlloc n)) es) =
-    Let (tra§0) (REVERSE (MAP compile es))
-      (Let (tra§1) (REPLICATE n (Op (tra§2) AllocGlobal []))
-         (Op (tra§3) (Cons tuple_tag) []))) ∧
-  (compile (App tra (Op (GlobalVarInit n)) es) =
-    Let (tra§0) [Op (tra§1) (SetGlobal n) (REVERSE (MAP compile es))]
-      (Op (tra§2) (Cons tuple_tag) [])) ∧
-  (compile (App tra (Op (GlobalVarLookup n)) es) =
-    Op tra (Global n) (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Op ListAppend) es) =
-    Op tra ListAppend (REVERSE (MAP compile es))) ∧
-  (compile (App tra (Tag_eq n l) es) =
-    Op tra (TagLenEq n l) (REVERSE (MAP compile es))) ∧
-  (compile (App tra (El n) es) =
-    if LENGTH es ≠ 1 then Op tra Sub (REVERSE (MAP compile es)) else
-      Op (tra§0) El [Op (tra§1) (Const &n) []; compile (HD es)]) ∧
-  (compile (App tra Run es) =
-    Op tra Install (REVERSE (MAP compile es))) ∧
-  (compile (If tra e1 e2 e3) =
-    If tra (compile e1) (compile e2) (compile e3)) ∧
-  (compile (Let tra e1 e2) =
-    Let tra [compile e1] (compile e2)) ∧
-  (compile (Seq tra e1 e2) =
-    Let (tra§0) [compile e1;compile e2] (Var (tra§1) 1)) ∧
-  (compile (Letrec tra es e) =
-    Letrec tra NONE NONE (MAP (λe. (1,compile e)) es) (compile e)) ∧
-  (compile (App tra (Op (FP_cmp cmp)) es) =
-    (Op tra (FP_cmp cmp) (REVERSE (MAP compile es)))) /\
-  (compile (App tra (Op (FP_uop u)) es) =
-    (Op tra (FP_uop u) (REVERSE (MAP compile es)))) /\
-  (compile (App tra (Op (FP_bop b)) es) =
-    (Op tra (FP_bop b) (REVERSE (MAP compile es)))) /\
-  (compile (App tra (Op (FP_top t)) es) =
-    (Op tra (FP_top t) (REVERSE (MAP compile es))))`
-  let
-    val exp_size_def = patLangTheory.exp_size_def
-  in
-    WF_REL_TAC `measure exp_size` >>
-    simp[exp_size_def] >>
-    rpt conj_tac >> rpt gen_tac >>
-    rw[] >> imp_res_tac MEM_exp1_size >> fs [] >>
-    fs [LENGTH_EQ_NUM_compute,exp_size_def] >>
-    imp_res_tac dest_WordToInt_exp_size >> fs []
-  end
-val _ = export_rewrites["compile_def"]
-
-val _ = export_theory()
diff --git a/compiler/backend/pattern_matching/Holmakefile b/compiler/backend/pattern_matching/Holmakefile
new file mode 100644
index 0000000000..87ca95cdf5
--- /dev/null
+++ b/compiler/backend/pattern_matching/Holmakefile
@@ -0,0 +1,9 @@
+INCLUDES = $(CAKEMLDIR)/misc $(CAKEMLDIR)/semantics
+
+all: $(DEFAULT_TARGETS) README.md
+.PHONY: all
+
+README_SOURCES = $(wildcard *Script.sml) $(wildcard *Lib.sml) $(wildcard *Syntax.sml)
+DIRS = $(wildcard */)
+README.md: $(CAKEMLDIR)/developers/readme_gen readmePrefix $(patsubst %,%readmePrefix,$(DIRS)) $(README_SOURCES)
+	$(protect $(CAKEMLDIR)/developers/readme_gen) $(README_SOURCES)
diff --git a/compiler/backend/pattern_matching/README.md b/compiler/backend/pattern_matching/README.md
new file mode 100644
index 0000000000..7b86a794cd
--- /dev/null
+++ b/compiler/backend/pattern_matching/README.md
@@ -0,0 +1,13 @@
+The CakeML pattern matching expressions compiler
+
+[pattern_commonScript.sml](pattern_commonScript.sml):
+Types common to some different parts of the pattern match compiler.
+
+[pattern_compScript.sml](pattern_compScript.sml):
+A simple pattern compiler that moves constant patterns upwards,
+checks for exhaustiveness, and then converts the pattern rows into
+an if-then-else decision tree.
+
+[pattern_semanticsScript.sml](pattern_semanticsScript.sml):
+The syntax and semantics of the input and output to the
+pattern-match compiler.
diff --git a/compiler/backend/pattern_matching/pattern_commonScript.sml b/compiler/backend/pattern_matching/pattern_commonScript.sml
new file mode 100644
index 0000000000..3aa721ad71
--- /dev/null
+++ b/compiler/backend/pattern_matching/pattern_commonScript.sml
@@ -0,0 +1,40 @@
+(*
+  Types common to some different parts of the pattern match compiler.
+*)
+
+open preamble;
+open numTheory listTheory arithmeticTheory;
+
+val _ = new_theory "pattern_common";
+
+(*
+A position describes a path to a sub-term in a term
+*)
+Datatype:
+  position =
+    EmptyPos
+  | Pos num position
+End
+
+(* Results of a pattern match or a multiple pattern match *)
+Datatype:
+  pmatchResult =
+    PMatchSuccess
+  | PMatchFailure
+  | PTypeFailure
+End
+
+(*
+  Pattern matching can return three results :
+    - Success, with the number of the right hand side that succeeded
+    - MatchFailure, when no branch has matched the value
+    - TypeFailure, when there was a type mismatch between the value
+      to be matched and the patterns
+*)
+Datatype:
+  matchResult =
+    MatchSuccess num
+  | MatchFailure
+End
+
+val _ = export_theory();
diff --git a/compiler/backend/pattern_matching/pattern_compScript.sml b/compiler/backend/pattern_matching/pattern_compScript.sml
new file mode 100644
index 0000000000..b292c5b3b7
--- /dev/null
+++ b/compiler/backend/pattern_matching/pattern_compScript.sml
@@ -0,0 +1,583 @@
+(*
+  A simple pattern compiler that moves constant patterns upwards,
+  checks for exhaustiveness, and then converts the pattern rows into
+  an if-then-else decision tree.
+*)
+open preamble astTheory semanticPrimitivesTheory pattern_commonTheory
+     pattern_semanticsTheory;
+
+val _ = new_theory "pattern_comp";
+
+val _ = set_grammar_ancestry
+  ["pattern_common", "semanticPrimitives", "pattern_semantics"];
+
+
+(* moving constant patterns up *)
+
+Definition is_const_row_def:
+  is_const_row (Cons _ pats, x) = NULL pats /\
+  is_const_row _ = F
+End
+
+Definition is_Any_def:
+  is_Any Any = T /\
+  is_Any (Or p1 p2) = (is_Any p1 \/ is_Any p2) /\
+  is_Any _ = F
+End
+
+Definition is_Or_row_def:
+  is_Or_row (Or p1 p2,_) = T /\
+  is_Or_row _ = F
+End
+
+Definition take_until_Any_def:
+  take_until_Any [] = [] /\
+  take_until_Any ((p,x)::xs) =
+    if is_Any p then [(p,x)] else (p,x)::take_until_Any xs
+End
+
+Definition move_const_up_def:
+  move_const_up rows =
+    let new_rows = take_until_Any rows in
+      if 5 <= LENGTH new_rows \/ EXISTS is_Or_row new_rows then
+        new_rows (* long pattern rows should not be changed *)
+      else
+        FILTER is_const_row new_rows ++
+        FILTER (\x. ~is_const_row x) new_rows
+End
+
+Theorem is_Any_pmatch:
+  !p. is_Any p ==> pmatch refs p v <> PMatchFailure
+Proof
+  ho_match_mp_tac is_Any_ind \\ fs [is_Any_def] \\ fs [pmatch_def]
+  \\ rw [] \\ every_case_tac \\ fs []
+QED
+
+Theorem match_take_until_Any:
+  !rows.
+    match refs rows v <> NONE ==>
+    match refs (take_until_Any rows) v = match refs rows v
+Proof
+  Induct \\ fs [take_until_Any_def,FORALL_PROD]
+  \\ fs [match_def] \\ rw []
+  THEN1
+   (fs [pmatch_def,match_def,CaseEq"option"]
+    \\ ‘pmatch refs p_1 v <> PMatchFailure’ by metis_tac [is_Any_pmatch]
+    \\ every_case_tac \\ fs [])
+  \\ fs [pmatch_def,match_def,CaseEq"pmatchResult"]
+  \\ Cases_on ‘pmatch refs p_1 v’ \\ fs []
+  \\ every_case_tac \\ fs []
+QED
+
+Theorem match_append:
+  !xs ys refs v.
+    match refs (xs ++ ys) v =
+    case match refs xs v of
+    | NONE => NONE
+    | SOME (MatchSuccess e) => if match refs ys v <> NONE
+                               then SOME (MatchSuccess e) else NONE
+    | SOME _ => match refs ys v
+Proof
+  Induct \\ fs [match_def,FORALL_PROD]
+  \\ rw [] \\ every_case_tac \\ fs []
+QED
+
+Triviality pmatchResult_case_NONE:
+  (case x of PMatchSuccess => NONE
+           | PMatchFailure => NONE
+           | PTypeFailure => K NONE NONE) = NONE
+Proof
+  Cases_on ‘x’ \\ fs []
+QED
+
+Theorem pmatchResult_case_NONE = pmatchResult_case_NONE |> REWRITE_RULE [K_THM];
+
+Theorem is_const_row_lemma:
+  (∀t. v ≠ Term t []) /\ is_const_row (p_1,p_2) /\
+  pmatch refs p_1 v <> PTypeFailure ==>
+  pmatch refs p_1 v = PMatchFailure
+Proof
+  Cases_on ‘p_1’ \\ fs [is_const_row_def]
+  \\ Cases_on ‘l’ \\ fs []
+  \\ Cases_on ‘v’ \\ fs [pmatch_def]
+  \\ Cases_on ‘l’ \\ fs [pmatch_def]
+  \\ Cases_on ‘o'’ \\ Cases_on ‘o''’ \\ fs [pmatch_def]
+  \\ Cases_on ‘x’ \\ Cases_on ‘x'’ \\ fs [pmatch_def,CaseEq"bool"]
+QED
+
+Theorem not_is_const_row:
+  ~is_const_row (p,x) /\ ~is_Or_row (p,x) /\ ~is_Any p ==>
+  pmatch refs p (Term t []) ≠ PMatchSuccess
+Proof
+  Cases_on ‘p’ \\ fs [pmatch_def,is_const_row_def,is_Or_row_def,is_Any_def]
+  \\ Cases_on ‘l’ \\ fs []
+  \\ Cases_on ‘o'’ \\ Cases_on ‘t’ \\ fs [pmatch_def]
+  \\ Cases_on ‘x’ \\ Cases_on ‘x'’ \\ fs [pmatch_def]
+  \\ every_case_tac \\ fs []
+QED
+
+Theorem EVERY_take_until_Any:
+  !rows. EVERY (\(x,y). ~is_Any x) (TL (REVERSE (take_until_Any (rows :(pat # num) list))))
+Proof
+  Induct
+  \\ fs [take_until_Any_def,FORALL_PROD] \\ rw []
+  \\ rename [‘xs ++ _’] \\ Cases_on ‘xs’ \\ fs []
+QED
+
+Theorem matdch_FILTER_NOT_NONE:
+  !xs. match refs xs v ≠ NONE ==>
+       match refs (FILTER P xs) v ≠ NONE
+Proof
+  Induct \\ fs [FORALL_PROD] \\ rw []
+  \\ fs [match_def] \\ every_case_tac \\ fs []
+QED
+
+Theorem match_move_const_up:
+  match refs rows v <> NONE ==>
+  match refs (move_const_up rows) v = match refs rows v
+Proof
+  rw [move_const_up_def]
+  \\ drule match_take_until_Any
+  \\ assume_tac (SPEC_ALL EVERY_take_until_Any)
+  \\ rename [‘_ xx v = _’] \\ fs []
+  \\ disch_then (assume_tac o GSYM) \\ fs []
+  \\ qpat_x_assum ‘match refs xx v ≠ NONE’ mp_tac
+  \\ qpat_x_assum ‘EVERY _ _’ mp_tac
+  \\ qpat_x_assum ‘EVERY _ _’ mp_tac
+  \\ rpt (pop_assum kall_tac)
+  \\ simp [match_def,match_append]
+  \\ reverse (Cases_on ‘?t. v = Term t []’)
+  THEN1
+   (disch_then kall_tac
+    \\ disch_then kall_tac
+    \\ strip_tac
+    \\ ‘match refs (FILTER is_const_row xx) v = SOME MatchFailure’ by
+         (Induct_on ‘xx’ \\ fs [match_def,FORALL_PROD]
+          \\ rw [] \\ fs [match_def]
+          \\ Cases_on ‘pmatch refs p_1 v’ \\ fs []
+          \\ Cases_on ‘match refs xx v’ \\ fs []
+          \\ Cases_on ‘p_1’ \\ fs [is_const_row_def]
+          \\ Cases_on ‘l’ \\ fs []
+          \\ Cases_on ‘v’ \\ fs [pmatch_def]
+          \\ Cases_on ‘l’ \\ fs []
+          \\ Cases_on ‘o'’ \\ Cases_on ‘o''’ \\ fs [pmatch_def]
+          \\ Cases_on ‘x'’ \\ Cases_on ‘x''’ \\ fs [pmatch_def,CaseEq"bool"])
+    \\ fs [] \\ pop_assum kall_tac
+    \\ Induct_on ‘xx’ \\ fs [match_def,FORALL_PROD]
+    \\ Cases_on ‘match refs xx v = NONE’ \\ fs []
+    THEN1 (rw [] \\ every_case_tac \\ fs [])
+    \\ reverse (rw []) \\ fs [match_def]
+    \\ Cases_on ‘pmatch refs p_1 v = PTypeFailure’ \\ fs []
+    \\ imp_res_tac is_const_row_lemma \\ fs [])
+  \\ fs [] \\ rveq \\ rw []
+  \\ Cases_on ‘match refs (FILTER is_const_row xx) (Term t [])’
+  \\ rfs [matdch_FILTER_NOT_NONE]
+  \\ ‘xx = [] ∨ ∃x l. xx = SNOC x l’ by metis_tac [SNOC_CASES]
+  THEN1 (fs [] \\ CASE_TAC \\ fs [])
+  \\ fs [REVERSE_APPEND] \\ rveq \\ fs [EVERY_REVERSE]
+  \\ Induct_on ‘l’
+  THEN1 (fs [] \\ rw [] \\ fs [match_def] \\ CASE_TAC \\ fs [])
+  \\ fs [FORALL_PROD]
+  \\ rw [] \\ fs []
+  THEN1
+   (fs [match_def] \\ Cases_on ‘pmatch refs p_1 (Term t [])’ \\ fs []
+    \\ Cases_on ‘match refs (l ++ [x']) (Term t [])’ \\ fs []
+    \\ Cases_on ‘match refs (FILTER is_const_row (l ++ [x'])) (Term t [])’ \\ fs []
+    \\ rveq \\ fs [])
+  \\ fs [match_def]
+  \\ qsuff_tac ‘pmatch refs p_1 (Term t []) <> PMatchSuccess’
+  THEN1 (Cases_on ‘pmatch refs p_1 (Term t [])’ \\ fs [])
+  \\ imp_res_tac not_is_const_row \\ fs []
+QED
+
+
+(* simple check for exhaustiveness, either:
+    - one row is a trivially exhaustive pattern (exh_pat)
+    - one top-level constructor (and its simblings)
+      with only trivially exhaustive subpatterns
+*)
+
+Definition exh_pat_def:
+  exh_pat Any = T /\
+  exh_pat (Or p1 p2) = (exh_pat p1 \/ exh_pat p2) /\
+  exh_pat (Cons NONE ps) = EVERY exh_pat ps /\
+  exh_pat _ = F
+Termination
+  WF_REL_TAC ‘measure pat_size’ \\ fs []
+  \\ Induct \\ fs [] \\ rw [] \\ res_tac \\ fs [pat_size_def]
+End
+
+Definition cons_exh_pat_def:
+  cons_exh_pat (Cons t ps) = EVERY exh_pat ps /\
+  cons_exh_pat _ = F
+End
+
+Definition sib_exists_def:
+  sib_exists [] (t:num,l:num) = F /\
+  sib_exists ((Cons (SOME (t1,_)) ps) :: xs) (t,l) =
+    ((if t = t1 /\ l = LENGTH ps then T else sib_exists xs (t,l))) /\
+  sib_exists _ _ = F
+End
+
+Definition exh_rows_def:
+  exh_rows rows =
+    let ps = MAP FST rows in
+      if EXISTS exh_pat ps then T else
+        EVERY cons_exh_pat ps /\
+        case ps of
+        | ((Cons (SOME (t,SOME sibs)) _) :: rest) => EVERY (sib_exists ps) sibs
+        | _ => F
+End
+
+Theorem exh_pat_thm:
+  !p v. exh_pat p ==> pmatch refs p v <> PMatchFailure
+Proof
+  ho_match_mp_tac exh_pat_ind \\ rw []
+  \\ fs [pmatch_def,exh_pat_def] \\ rfs []
+  THEN1 (every_case_tac \\ fs [] \\ rfs [])
+  THEN1 (every_case_tac \\ fs [] \\ rfs [])
+  \\ Cases_on ‘v’ \\ fs [pmatch_def]
+  \\ Cases_on ‘o'’ \\ fs [pmatch_def]
+  \\ rpt (pop_assum mp_tac)
+  \\ qid_spec_tac ‘l’
+  \\ Induct_on ‘ps’ \\ Cases_on ‘l’ \\ fs [pmatch_def]
+  \\ fs [EVERY_MEM] \\ rw []
+  \\ pop_assum mp_tac
+  \\ first_assum (qspec_then ‘h'’ mp_tac)
+  \\ rewrite_tac []
+  \\ disch_then drule
+  \\ disch_then (qspec_then ‘h’ assume_tac)
+  \\ Cases_on ‘pmatch refs h' h’ \\ fs []
+QED
+
+Theorem exh_pat_pmatch_list:
+  ∀l l'. EVERY exh_pat l /\ LENGTH l = LENGTH l' ==>
+         pmatch_list refs l l' <> PMatchFailure
+Proof
+  Induct \\ fs [pmatch_def,FORALL_PROD]
+  \\ rw [] \\ rename [‘_ = LENGTH xs’] \\ Cases_on ‘xs’  \\ fs []
+  \\ fs [pmatch_def]
+  \\ drule exh_pat_thm
+  \\ disch_then (qspecl_then [‘refs’,‘h'’] assume_tac)
+  \\ rename [‘LENGTH ts = _’]
+  \\ first_x_assum (qspec_then ‘t’ mp_tac)
+  \\ every_case_tac \\ fs []
+QED
+
+Theorem pmatch_list_LENGTH:
+  !ps vs. pmatch_list refs ps vs ≠ PTypeFailure ==> LENGTH vs = LENGTH ps
+Proof
+  Induct \\ Cases_on ‘vs’ \\ fs [pmatch_def]
+  \\ fs [CaseEq"pmatchResult"] \\ rw [] \\ res_tac \\ fs []
+  \\ Cases_on ‘pmatch refs h' h’ \\ fs []
+QED
+
+Theorem exh_rows_thm:
+  match refs rows v <> NONE /\ exh_rows rows ==>
+  match refs rows v <> SOME MatchFailure
+Proof
+  rw [exh_rows_def]
+  THEN1
+   (Induct_on ‘rows’ \\ fs [match_def,FORALL_PROD] \\ rw []
+    THEN1
+     (drule exh_pat_thm
+      \\ disch_then (qspecl_then [‘refs’,‘v’] assume_tac)
+      \\ Cases_on ‘pmatch refs p_1 v’ \\ fs []
+      \\ CASE_TAC \\ fs [])
+    \\ Cases_on ‘pmatch refs p_1 v’ \\ fs []
+    \\ TRY CASE_TAC \\ fs [])
+  \\ Cases_on ‘MAP FST rows’ \\ fs []
+  \\ Cases_on ‘h’ \\ fs []
+  \\ Cases_on ‘o'’ \\ fs []
+  \\ Cases_on ‘x’ \\ fs []
+  \\ Cases_on ‘r’ \\ fs []
+  \\ qabbrev_tac ‘ts = Cons (SOME (q,SOME x)) l::t’
+  \\ Cases_on ‘rows’ \\ fs [] THEN1 fs [Abbr‘ts’]
+  \\ PairCases_on ‘h’ \\ fs [Abbr‘ts’]
+  \\ rveq \\ fs []
+  \\ fs [match_def]
+  \\ Cases_on ‘pmatch refs (Cons (SOME (q,SOME x)) l) v’ \\ fs []
+  THEN1 (TOP_CASE_TAC \\ fs [])
+  \\ Cases_on ‘v’ \\ fs [pmatch_def]
+  \\ Cases_on ‘o'’ \\ fs [pmatch_def]
+  \\ fs [CaseEq"bool"] \\ rveq \\ fs []
+  THEN1 (fs [cons_exh_pat_def] \\ metis_tac [exh_pat_pmatch_list])
+  \\ fs [is_sibling_def]
+  \\ fs [EVERY_MEM]
+  \\ first_x_assum drule
+  \\ fs [sib_exists_def] \\ rw []
+  \\ Induct_on ‘t'’ \\ fs [sib_exists_def]
+  \\ fs [FORALL_PROD] \\ rw []
+  \\ fs [match_def]
+  \\ Cases_on ‘pmatch refs p_1 (Term (SOME x') l')’ \\ fs []
+  \\ TRY (TOP_CASE_TAC \\ fs [] \\ NO_TAC)
+  \\ Cases_on ‘p_1’ \\ fs [sib_exists_def]
+  \\ Cases_on ‘o'’ \\ fs [sib_exists_def]
+  \\ Cases_on ‘x''’ \\ fs [sib_exists_def] \\ rveq \\ fs []
+  \\ rfs [pmatch_def]
+  \\ rename [‘Cons (SOME (q1,r1)) l1’]
+  \\ first_x_assum (qspec_then ‘Cons (SOME (q1,r1)) l1’ assume_tac)
+  \\ fs [cons_exh_pat_def]
+  \\ imp_res_tac exh_pat_pmatch_list
+  \\ rename [‘pmatch_list refs t5 t6 = PMatchFailure’]
+  \\ rpt (first_x_assum (qspec_then ‘t6’ assume_tac))
+  \\ rfs [] \\ fs []
+QED
+
+(* replace last pattern with Any (used if rows are exhaustive) *)
+
+Definition insert_Any_def:
+  insert_Any [] = [] /\
+  insert_Any [(p,x)] = [(Any,x)] /\
+  insert_Any (x::xs) = x :: insert_Any xs
+End
+
+Theorem match_insert_Any:
+  !rows.
+    match refs rows v <> NONE ==>
+    match refs (insert_Any rows) v <> NONE /\
+    (match refs rows v <> SOME MatchFailure ==>
+     match refs (insert_Any rows) v = match refs rows v)
+Proof
+  Induct \\ fs [match_def,insert_Any_def]
+  \\ Cases_on ‘rows’ \\ Cases
+  \\ fs [insert_Any_def]
+  \\ fs [match_def,pmatch_def,CaseEq"pmatchResult"]
+  \\ Cases_on ‘pmatch refs q v’ \\ fs []
+  \\ TOP_CASE_TAC \\ fs []
+  \\ TOP_CASE_TAC \\ fs []
+QED
+
+
+(* turning the pattern rows into code *)
+
+Definition is_True_def:
+  is_True True = T /\
+  is_True _ = F
+End
+
+Definition mk_Disj_def:
+  mk_Disj p q = if is_True p \/ is_True q then True else Disj p q
+End
+
+Definition mk_Conj_def:
+  mk_Conj p q =
+    if is_True p then q else
+    if is_True q then p else Conj p q
+End
+
+Definition mk_If_def:
+  mk_If g p q = if is_True g then p else If g p q
+End
+
+Definition get_pos_def:
+  get_pos [] = EmptyPos /\
+  get_pos (n::ns) = Pos n (get_pos ns)
+End
+
+Definition pat_to_guard_def:
+  pat_to_guard l Any = True /\
+  pat_to_guard l (Lit r) = PosTest (get_pos (REVERSE l)) (LitEq r) /\
+  pat_to_guard l (Cons NONE pats) = pats_to_guard l 0 pats /\
+  pat_to_guard l (Cons (SOME (t,_)) pats) =
+    mk_Conj (PosTest (get_pos (REVERSE l))
+      (TagLenEq t (LENGTH pats))) (pats_to_guard l 0 pats) /\
+  pat_to_guard l (Or p1 p2) = mk_Disj (pat_to_guard l p1) (pat_to_guard l p2) /\
+  pat_to_guard l (Ref p) = pat_to_guard (0::l) p /\
+  pats_to_guard l k [] = True /\
+  pats_to_guard l k [p] = pat_to_guard (k::l) p /\
+  pats_to_guard l k (p::ps) = mk_Conj (pat_to_guard (k::l) p) (pats_to_guard l (k+1) ps)
+Termination
+  WF_REL_TAC ‘measure (\x. case x of INL (_,p) => pat_size p
+                           | INR (_,k,p) => pat1_size p)’
+End
+
+Definition pats_to_code_def:
+  pats_to_code [] = Fail /\
+  pats_to_code ((p,x)::rows) =
+    mk_If (pat_to_guard [] p) (Leaf x) (pats_to_code rows)
+End
+
+Definition walk_def:
+  walk [] x refs = SOME x /\
+  walk (n::ns) x refs =
+    (case x of
+     | (Term t xs) => (if n < LENGTH xs then walk ns (EL n xs) refs else NONE)
+     | (RefPtr p) => (if n <> 0 then NONE else
+                      case FLOOKUP refs p of SOME y => walk ns y refs | _ => NONE)
+     | _ => NONE)
+End
+
+Definition walk_list_def:
+  walk_list ns x refs =
+    case walk ns x refs of SOME (Term _ vs) => SOME vs | _ => NONE
+End
+
+Theorem app_pos_Pos:
+  !n xs.
+    n < LENGTH xs ==>
+    app_pos refs (Pos n x) (Term t xs) = app_pos refs x (EL n xs)
+Proof
+  Induct \\ Cases \\ fs [app_pos_def]
+QED
+
+Theorem walk_thm:
+  !l v refs x.
+    walk l v refs = SOME x ==>
+    app_pos refs (get_pos l) v = SOME x
+Proof
+  Induct \\ fs [walk_def,get_pos_def,app_pos_def]
+  \\ fs [CaseEq"option",CaseEq"bool",CaseEq"term"]
+  \\ rw [] \\ fs [] \\ rw []
+  \\ fs [app_pos_Pos] \\ fs [app_pos_def]
+QED
+
+Theorem walk_append:
+  !xs ys v refs.
+    walk (xs ++ ys) v refs =
+    case walk xs v refs of
+    | NONE => NONE
+    | SOME v => walk ys v refs
+Proof
+  Induct \\ fs [walk_def]
+  \\ Cases_on ‘v’ \\ fs [] \\ rw []
+  \\ CASE_TAC \\ fs []
+QED
+
+Triviality is_True_thm:
+  is_True t <=> t = True
+Proof
+  Cases_on `t` \\ fs [is_True_def]
+QED
+
+Triviality dt_eval_guard_mk_Conj:
+  dt_eval_guard refs v (mk_Conj p q) =
+  dt_eval_guard refs v (Conj p q)
+Proof
+  rw [mk_Conj_def] \\ fs [is_True_thm,dt_eval_guard_def]
+  \\ rveq \\ fs [] \\ every_case_tac \\ fs []
+QED
+
+Theorem dt_eval_guard_pat_to_guard:
+  (!l p x.
+    pmatch refs p x <> PTypeFailure /\
+    walk (REVERSE l) v refs = SOME x ==>
+    dt_eval_guard refs v (pat_to_guard l p) =
+      SOME (pmatch refs p x = PMatchSuccess)) /\
+  (!l k ps xs ys.
+    pmatch_list refs ps xs <> PTypeFailure /\ LENGTH ys = k /\
+    walk_list (REVERSE l) v refs = SOME (ys ++ xs) /\ LENGTH xs = LENGTH ps ==>
+    dt_eval_guard refs v (pats_to_guard l k ps) =
+      SOME (pmatch_list refs ps xs = PMatchSuccess))
+Proof
+  ho_match_mp_tac pat_to_guard_ind \\ rw []
+  THEN1 fs [pmatch_def,pat_to_guard_def,dt_eval_guard_def]
+  THEN1
+   (Cases_on ‘x’ \\ fs [pmatch_def,CaseEq"bool"]
+    \\ fs [pat_to_guard_def,dt_eval_guard_def]
+    \\ imp_res_tac walk_thm \\ fs [] \\ EVAL_TAC
+    \\ Cases_on ‘r’ \\ Cases_on ‘l'’ \\ fs [lit_same_type_def])
+  THEN1
+   (Cases_on ‘x’ \\ fs [pmatch_def] \\ Cases_on ‘o'’ \\ fs [pmatch_def]
+    \\ fs [walk_list_def,pat_to_guard_def]
+    \\ imp_res_tac pmatch_list_LENGTH \\ fs [])
+  THEN1
+   (Cases_on ‘x’ \\ fs [pmatch_def] \\ Cases_on ‘o'’ \\ fs [pmatch_def]
+    \\ fs [walk_list_def,pat_to_guard_def]
+    \\ imp_res_tac pmatch_list_LENGTH \\ fs [dt_eval_guard_mk_Conj]
+    \\ fs [CaseEq"bool"] \\ rveq \\ fs [dt_eval_guard_def,dt_test_def]
+    \\ imp_res_tac walk_thm \\ fs [dt_test_def]
+    \\ IF_CASES_TAC \\ fs [])
+  THEN1
+   (fs [pat_to_guard_def,dt_eval_guard_def,pmatch_def]
+    \\ Cases_on ‘pmatch refs p x ≠ PTypeFailure’ \\ fs []
+    \\ Cases_on ‘pmatch refs p' x ≠ PTypeFailure’ \\ fs []
+    \\ Cases_on ‘pmatch refs p x’ \\ fs []
+    \\ Cases_on ‘pmatch refs p' x’ \\ fs []
+    \\ res_tac \\ fs []
+    \\ rw [mk_Disj_def,dt_eval_guard_def]
+    \\ fs [is_True_thm,dt_eval_guard_def])
+  THEN1
+   (Cases_on ‘x’ \\ fs [pat_to_guard_def,pmatch_def]
+    \\ fs [CaseEq"option"]
+    \\ Cases_on ‘FLOOKUP refs n’ \\ fs []
+    \\ fs [pmatch_def]
+    \\ first_x_assum match_mp_tac \\ fs []
+    \\ fs [walk_append]
+    \\ fs [walk_def])
+  THEN1 fs [pat_to_guard_def,pmatch_def,dt_eval_guard_def]
+  THEN1
+   (Cases_on ‘xs’ \\ fs [pmatch_def]
+    \\ rveq \\ fs [pmatch_def,CaseEq"pmatchResult"]
+    \\ Cases_on ‘pmatch refs p h’ \\ fs []
+    \\ fs [walk_list_def,CaseEq"option",CaseEq"term"]
+    \\ rveq \\ fs [pat_to_guard_def]
+    \\ first_x_assum (qspec_then ‘h’ assume_tac) \\ rfs []
+    \\ rfs [walk_def,walk_append] \\ rfs [rich_listTheory.EL_LENGTH_APPEND])
+  THEN1
+   (Cases_on ‘xs’ \\ fs [pmatch_def]
+    \\ Cases_on ‘pmatch refs p h ≠ PTypeFailure’ \\ fs []
+    \\ rename [‘pmatch_list refs (n::ns) t’]
+    \\ Cases_on ‘pmatch_list refs (n::ns) t = PTypeFailure’
+    THEN1 (fs [CaseEq"pmatchResult"] \\ Cases_on ‘pmatch refs p h’ \\ fs [])
+    \\ fs []
+    \\ first_x_assum drule \\ strip_tac
+    \\ first_x_assum drule \\ strip_tac
+    \\ rfs [walk_append,walk_def]
+    \\ rfs [walk_def,walk_list_def,CaseEq"option",CaseEq"term"]
+    \\ rfs [] \\ rveq \\ fs []
+    \\ fs [pat_to_guard_def,dt_eval_guard_def,dt_eval_guard_mk_Conj]
+    \\ rpt (pop_assum mp_tac)
+    \\ rewrite_tac [APPEND,GSYM APPEND_ASSOC]
+    \\ rfs [rich_listTheory.EL_LENGTH_APPEND]
+    \\ rewrite_tac [APPEND,GSYM APPEND_ASSOC]
+    \\ rfs [rich_listTheory.EL_LENGTH_APPEND]
+    \\ IF_CASES_TAC \\ fs []
+    \\ fs [CaseEq"pmatchResult"])
+QED
+
+Triviality mk_If_thm:
+  dt_eval refs v (mk_If g p q) = dt_eval refs v (If g p q)
+Proof
+  rw [mk_If_def] \\ fs [is_True_thm,dt_eval_def,dt_eval_guard_def]
+QED
+
+Theorem pat_to_code_thm:
+  !rows.
+    match refs rows v <> NONE ==>
+    dt_eval refs v (pats_to_code rows) = match refs rows v
+Proof
+  Induct
+  \\ fs [match_def,pats_to_code_def,dt_eval_def,FORALL_PROD,mk_If_thm]
+  \\ fs [CaseEq"pmatchResult",CaseEq"option",GSYM IMP_DISJ_THM]
+  \\ rw [] \\ fs [dt_eval_def]
+  \\ Cases_on ‘pmatch refs p_1 v <> PTypeFailure’ \\ fs []
+  \\ drule (dt_eval_guard_pat_to_guard |> CONJUNCT1)
+  \\ disch_then (qspecl_then [‘v’,‘[]’] assume_tac) \\ fs [walk_def]
+  \\ Cases_on ‘pmatch refs p_1 v = PMatchSuccess’ \\ fs []
+  THEN1 (Cases_on ‘match refs rows v’ \\ fs [dt_eval_def])
+  \\ Cases_on ‘pmatch refs p_1 v = PMatchFailure’ \\ fs []
+  \\ Cases_on ‘pmatch refs p_1 v’ \\ fs []
+QED
+
+
+(* plug all the parts together *)
+
+Definition comp_def:
+  comp rows =
+    let rows0 = move_const_up rows in
+    let rows1 = (if exh_rows rows0 then insert_Any rows0 else rows0) in
+      pats_to_code rows1
+End
+
+Theorem comp_thm:
+  match refs rows v <> NONE ==>
+  dt_eval refs v (comp rows) = match refs rows v
+Proof
+  fs [comp_def] \\ strip_tac
+  \\ drule match_move_const_up
+  \\ disch_then (assume_tac o GSYM) \\ fs []
+  \\ metis_tac [pat_to_code_thm,exh_rows_thm,match_insert_Any]
+QED
+
+val _ = export_theory();
diff --git a/compiler/backend/pattern_matching/pattern_semanticsScript.sml b/compiler/backend/pattern_matching/pattern_semanticsScript.sml
new file mode 100644
index 0000000000..05781b1e1e
--- /dev/null
+++ b/compiler/backend/pattern_matching/pattern_semanticsScript.sml
@@ -0,0 +1,166 @@
+(*
+  The syntax and semantics of the input and output to the
+  pattern-match compiler.
+*)
+open preamble astTheory semanticPrimitivesTheory pattern_commonTheory;
+
+val _ = new_theory "pattern_semantics";
+
+val _ = set_grammar_ancestry ["pattern_common", "semanticPrimitives"];
+
+
+Type kind[local] = ``:num``
+Type tag[local] = ``:num``
+Type siblings[local] = ``:((num # num) list) option``
+
+(* input syntax *)
+
+Datatype:
+  pat =
+    Any
+  | Cons ((tag # siblings) option) (pat list)
+  | Or pat pat
+  | Lit ast$lit
+  | Ref pat
+End
+
+(* output syntax *)
+
+Datatype:
+  dTest = TagLenEq num num | LitEq ast$lit
+End
+
+Datatype:
+  dGuard = PosTest position dTest
+         | Not dGuard | Conj dGuard dGuard | Disj dGuard dGuard | True
+End
+
+Datatype:
+  dTree =
+    Leaf num
+  | Fail
+  | TypeFail
+  | If dGuard dTree dTree
+End
+
+(* semantic values *)
+
+Datatype:
+  term = Term (tag option) (term list)
+       | Litv ast$lit
+       | RefPtr num
+       | Other
+End
+
+(* semantics of input *)
+Definition is_sibling_def:
+  is_sibling x NONE = T /\
+  is_sibling x (SOME l) = MEM x l
+End
+
+Definition pmatch_def:
+  (pmatch refs Any t = PMatchSuccess) /\
+  (pmatch refs (Lit l) (Litv l') =
+     if ~lit_same_type l l' then PTypeFailure else
+     if l = l' then PMatchSuccess else PMatchFailure) /\
+  (pmatch refs (Cons (SOME (tag,siblings)) pargs) (Term (SOME t) targs) =
+    if tag = t /\ LENGTH pargs = LENGTH targs then pmatch_list refs pargs targs else
+    if is_sibling (t,LENGTH targs) siblings
+    then PMatchFailure else PTypeFailure) /\
+  (pmatch refs (Cons NONE pargs) (Term NONE targs) =
+    pmatch_list refs pargs targs) /\
+  (pmatch refs (Ref p) (RefPtr r) =
+    case FLOOKUP refs r of
+    | NONE => PTypeFailure
+    | SOME v => pmatch refs p v) /\
+  (pmatch refs (Or p1 p2) t =
+    case pmatch refs p1 t of
+       PMatchSuccess => (case pmatch refs p2 t of
+                           PTypeFailure => PTypeFailure
+                         | _ => PMatchSuccess)
+     | PMatchFailure => pmatch refs p2 t
+     | PTypeFailure => PTypeFailure) /\
+  (pmatch refs _ _ = PTypeFailure) /\
+  (pmatch_list refs [] [] = PMatchSuccess) /\
+  (pmatch_list refs [] ts = PTypeFailure) /\
+  (pmatch_list refs ps [] = PTypeFailure) /\
+  (pmatch_list refs (p::ps) (t::ts) =
+    case pmatch refs p t of
+      PMatchSuccess => pmatch_list refs ps ts
+    | PMatchFailure => (case pmatch_list refs ps ts of
+                           PTypeFailure => PTypeFailure
+                         | _ => PMatchFailure)
+    | PTypeFailure => PTypeFailure)
+Termination
+  WF_REL_TAC `measure (\x. case x of INL (r,p,_) => pat_size p
+                                   | INR (r,ps,_) => pat1_size ps)`
+End
+
+Definition match_def:
+  (match refs [] v = SOME MatchFailure) /\
+  (match refs ((p,e)::rows) v =
+    case pmatch refs p v of
+       PMatchSuccess =>
+         (case match refs rows v of
+           NONE => NONE
+         | SOME _ => SOME (MatchSuccess e))
+     | PMatchFailure => match refs rows v
+     | PTypeFailure => NONE)
+End
+
+(* semantics of output *)
+
+Definition dt_test_def:
+  dt_test (TagLenEq t l) (Term (SOME c) args) =
+    SOME (t = c /\ l = LENGTH args) /\
+  dt_test (LitEq l1) (Litv l2) =
+    (if lit_same_type l1 l2 then SOME (l1 = l2) else NONE) /\
+  dt_test _ _ = NONE
+End
+
+Definition app_pos_def:
+  (app_pos refs EmptyPos v = SOME v) /\
+  (app_pos refs (Pos 0 pos) (RefPtr r) =
+     case FLOOKUP refs r of
+     | NONE => NONE
+     | SOME v => app_pos refs pos v) /\
+  (app_pos refs (Pos 0 pos) (Term c (x::xs)) = app_pos refs pos x) /\
+  (app_pos refs (Pos (SUC n) pos) (Term c (x::xs)) =
+    app_pos refs (Pos n pos) (Term c xs)) /\
+  (app_pos refs (Pos _ _) _ = NONE)
+End
+
+Definition dt_eval_guard_def:
+  (dt_eval_guard refs v True =
+     SOME T) /\
+  (dt_eval_guard refs v (PosTest pos test) =
+     case app_pos refs pos v of
+     | NONE => NONE
+     | SOME x => dt_test test x) /\
+  (dt_eval_guard refs v (Not g) =
+     case dt_eval_guard refs v g of
+     | NONE => NONE
+     | SOME b => SOME (~b)) /\
+  (dt_eval_guard refs v (Conj g1 g2) =
+     case dt_eval_guard refs v g1 of
+     | NONE => NONE
+     | SOME T => dt_eval_guard refs v g2
+     | SOME F => SOME F) /\
+  (dt_eval_guard refs v (Disj g1 g2) =
+     case dt_eval_guard refs v g1 of
+     | NONE => NONE
+     | SOME T => SOME T
+     | SOME F => dt_eval_guard refs v g2)
+End
+
+Definition dt_eval_def:
+  (dt_eval refs _ (Leaf k) = SOME (MatchSuccess k)) /\
+  (dt_eval refs _ Fail = SOME (MatchFailure)) /\
+  (dt_eval refs _ TypeFail = NONE) /\
+  (dt_eval refs v (If guard dt1 dt2) =
+     case dt_eval_guard refs v guard of
+     | NONE => NONE
+     | SOME b => dt_eval refs v (if b then dt1 else dt2))
+End
+
+val _ = export_theory();
diff --git a/compiler/backend/pattern_matching/readmePrefix b/compiler/backend/pattern_matching/readmePrefix
new file mode 100644
index 0000000000..21453fd36e
--- /dev/null
+++ b/compiler/backend/pattern_matching/readmePrefix
@@ -0,0 +1 @@
+The CakeML pattern matching expressions compiler
\ No newline at end of file
diff --git a/compiler/backend/presLangScript.sml b/compiler/backend/presLangScript.sml
index 4ac032ae7f..c842a246f4 100644
--- a/compiler/backend/presLangScript.sml
+++ b/compiler/backend/presLangScript.sml
@@ -3,7 +3,7 @@
   into displayLang representations.
 *)
 open preamble astTheory mlintTheory
-open flatLangTheory patLangTheory closLangTheory
+open flatLangTheory closLangTheory
      displayLangTheory source_to_flatTheory
      wordLangTheory;
 
@@ -14,14 +14,11 @@ val _ = new_theory"presLang";
 val empty_item_def = Define`
   empty_item name = Item NONE name []`;
 
-val string_to_display_def = Define`
-  string_to_display s = empty_item (concat [strlit "\""; s; strlit "\""])`;
-
-val string_to_display2_def = Define`
-  string_to_display2 s = string_to_display (implode s)`;
-
 val num_to_display_def = Define`
-  num_to_display (n : num) = string_to_display (toString n)`;
+  num_to_display (n : num) = String (toString n)`;
+
+val string_imp_def = Define`
+  string_imp s = String (implode s)`;
 
 val item_with_num_def = Define`
   item_with_num name n = Item NONE name [num_to_display n]`;
@@ -32,11 +29,6 @@ val item_with_nums_def = Define`
 val bool_to_display_def = Define`
   bool_to_display b = empty_item (if b then strlit "True" else strlit "False")`;
 
-val num_to_hex_digit_def = Define `
-  num_to_hex_digit n =
-    if n < 10 then [CHR (48 + n)] else
-    if n < 16 then [CHR (55 + n)] else []`;
-
 val num_to_hex_def = Define `
   num_to_hex n =
     (if n < 16 then [] else num_to_hex (n DIV 16)) ++
@@ -75,7 +67,7 @@ val lit_to_display_def = Define`
     Item NONE (strlit "Char") [empty_item (implode ("#\"" ++ [c] ++ "\""))])
   /\
   (lit_to_display (StrLit s) =
-    Item NONE (strlit "StrLit") [string_to_display2 s])
+    Item NONE (strlit "StrLit") [string_imp s])
   /\
   (lit_to_display (Word8 w) =
     Item NONE (strlit "Word8") [display_word_to_hex_string w])
@@ -180,8 +172,7 @@ val opt_con_to_display_def = Define `
 val flat_pat_to_display_def = tDefine "flat_pat_to_display" `
   flat_pat_to_display p =
     case p of
-       | flatLang$Pvar varN => Item NONE (strlit "Pvar")
-            [string_to_display2 varN]
+       | flatLang$Pvar varN => Item NONE (strlit "Pvar") [string_imp varN]
        | Pany => empty_item (strlit "Pany")
        | Plit lit => Item NONE (strlit "Plit") [lit_to_display lit]
        | flatLang$Pcon id pats => Item NONE (strlit "Pcon")
@@ -209,7 +200,6 @@ val flat_op_to_display_def = Define `
     | Opapp => empty_item (strlit "Opapp")
     | Opassign => empty_item (strlit "Opassign")
     | Opref => empty_item (strlit "Opref")
-    | Opderef => empty_item (strlit "Opderef")
     | Aw8alloc => empty_item (strlit "Aw8alloc")
     | Aw8sub => empty_item (strlit "Aw8sub")
     | Aw8sub_unsafe => empty_item (strlit "Aw8sub_unsafe")
@@ -243,10 +233,13 @@ val flat_op_to_display_def = Define `
     | Aupdate_unsafe => empty_item (strlit "Aupdate_unsafe")
     | ListAppend => empty_item (strlit "ListAppend")
     | ConfigGC => empty_item (strlit "ConfigGC")
-    | FFI s => Item NONE (strlit "FFI") [string_to_display2 s]
+    | FFI s => Item NONE (strlit "FFI") [string_imp s]
     | GlobalVarAlloc n => item_with_num (strlit "GlobalVarAlloc") n
     | GlobalVarInit n => item_with_num (strlit "GlobalVarInit") n
     | GlobalVarLookup n => item_with_num (strlit "GlobalVarLookup") n
+    | TagLenEq n1 n2 => item_with_nums (strlit "TagLenEq") [n1; n2]
+    | LenEq n1 => item_with_nums (strlit "LenEq") [n1]
+    | El n => item_with_num (strlit "El") n
     `
 
 val MEM_funs_size = prove(
@@ -279,10 +272,10 @@ val flat_to_display_def = tDefine"flat_to_display" `
         :: MAP flat_to_display exps))
   /\
   (flat_to_display (Var_local tra varN) =
-    Item (SOME tra) (strlit "Var_local") [string_to_display2 varN])
+    Item (SOME tra) (strlit "Var_local") [string_imp varN])
   /\
   (flat_to_display (Fun tra varN exp) =
-    Item (SOME tra) (strlit "Fun") [string_to_display2 varN; flat_to_display exp])
+    Item (SOME tra) (strlit "Fun") [string_imp varN; flat_to_display exp])
   /\
   (flat_to_display (App tra op exps) =
     Item (SOME tra) (strlit "App") (flat_op_to_display op :: MAP flat_to_display exps))
@@ -296,12 +289,12 @@ val flat_to_display_def = tDefine"flat_to_display" `
         :: MAP (\(pat,exp). displayLang$Tuple [flat_pat_to_display pat; flat_to_display exp]) pes))
   /\
   (flat_to_display (Let tra varN_opt exp1 exp2) =
-    Item (SOME tra) (strlit "Let") [option_to_display string_to_display2 varN_opt;
+    Item (SOME tra) (strlit "Let") [option_to_display string_imp varN_opt;
         flat_to_display exp1; flat_to_display exp2])
   /\
   (flat_to_display (Letrec tra funs exp) =
     Item (SOME tra) (strlit "Letrec")
-        [List (MAP (\(v1,v2,e). Tuple [string_to_display2 v1; string_to_display2 v2;
+        [List (MAP (\(v1,v2,e). Tuple [string_imp v1; string_imp v2;
               flat_to_display e]) funs); flat_to_display exp]
   )`
   (WF_REL_TAC `inv_image $< (flatLang$exp_size)`
@@ -329,76 +322,7 @@ val num_to_varn_def = tDefine "num_to_varn" `
   (WF_REL_TAC `measure I` \\ rw [] \\ fs [DIV_LT_X]);
 
 val display_num_as_varn_def = Define `
-  display_num_as_varn n = string_to_display2 (num_to_varn n)`;
-
-val pat_op_to_display_def = Define `
-  pat_op_to_display op = case op of
-    | patLang$Op op2 => flat_op_to_display op2
-    | Run => empty_item (strlit "Run")
-    | Tag_eq n1 n2 => item_with_nums (strlit "Tag_eq") [n1; n2]
-    | El num => item_with_num (strlit "El") num
-  `
-
-val MEM_pat_exps_size = prove(
-  ``!exps e. MEM a exps ==> patLang$exp_size a < exp1_size exps``,
-  Induct \\ fs [patLangTheory.exp_size_def] \\ rw []
-  \\ fs [patLangTheory.exp_size_def] \\ res_tac \\ fs []);
-
-(* The constructors in pat differ a bit because of de bruijn indices. This is
-* solved with the argument h, referring to head of our indexing. Combined with
-* num_to_varn this means we create varNs to match the presLang-constructors
-* where either nums or no name at all were provided. *)
-
-val pat_to_display_def = tDefine "pat_to_display" `
-  (pat_to_display h (patLang$Raise t e) =
-    Item (SOME t) (strlit "Raise") [pat_to_display h e])
-  /\
-  (pat_to_display h (Handle t e1 e2) =
-    Item (SOME t) (strlit "Handle")
-        [pat_to_display h e1; pat_to_display (h+1) e2])
-  /\
-  (pat_to_display h (Lit t lit) =
-    Item (SOME t) (strlit "Lit") [lit_to_display lit])
-  /\
-  (pat_to_display h (Con t num es) =
-    Item (SOME t) (strlit "Con") (num_to_display num :: MAP (pat_to_display h) es))
-  /\
-  (pat_to_display h (Var_local t var_index) =
-    Item (SOME t) (strlit "Var_local") [display_num_as_varn (h-var_index-1)])
-  /\
-  (pat_to_display h (Fun t e) =
-    Item (SOME t) (strlit "Fun") [display_num_as_varn h; pat_to_display (h+1) e])
-  /\
-  (pat_to_display h (App t op es) =
-    Item (SOME t) (strlit "App") (pat_op_to_display op :: MAP (pat_to_display h) es))
-  /\
-  (pat_to_display h (If t e1 e2 e3) =
-    Item (SOME t) (strlit "If") [pat_to_display h e1; pat_to_display h e2;
-        pat_to_display h e3])
-  /\
-  (pat_to_display h (Let t e1 e2) =
-    Item (SOME t) (strlit "Let") [display_num_as_varn h;
-        pat_to_display h e1; pat_to_display (h+1) e2])
-  /\
-  (pat_to_display h (Seq t e1 e2) =
-    Item (SOME t) (strlit "Seq") [pat_to_display h e1; pat_to_display h e2])
-  /\
-  (pat_to_display h (Letrec t es e) =
-    (let len = LENGTH es in Item (SOME t) (strlit "Letrec")
-        [List (pat_to_display_rec_tups h (len-1) len es);
-            pat_to_display (h+len) e]))
-  /\
-  (* Gives letrec functions names and variable names. *)
-  (pat_to_display_rec_tups _ _ _ [] = [])
-  /\
-  (pat_to_display_rec_tups h i len (e::es) =
-    Tuple [display_num_as_varn (h+i); display_num_as_varn (h+len);
-        pat_to_display (h+len+1) e]
-        :: pat_to_display_rec_tups h (i-1) len es)`
- (WF_REL_TAC `measure (\x. case x of INL (_,e) => exp_size e
-                                   | INR (_,_,_,es) => exp1_size es)`
-  \\ rw [patLangTheory.exp_size_def]
-  \\ imp_res_tac MEM_pat_exps_size \\ fs []);
+  display_num_as_varn n = string_imp (num_to_varn n)`;
 
 (* clos to displayLang *)
 
@@ -428,18 +352,18 @@ val clos_op_to_display_def = Define `
     | CopyByte b => Item NONE (strlit "CopyByte") [bool_to_display b]
     | ListAppend => empty_item (strlit "ListAppend")
     | FromList num => item_with_num (strlit "FromList") num
-    | closLang$String s => Item NONE (strlit "String") [string_to_display2 s]
+    | closLang$String s => Item NONE (strlit "String") [string_imp s]
     | FromListByte => empty_item (strlit "FromListByte")
     | ToListByte => empty_item (strlit "ToListByte")
     | LengthByteVec => empty_item (strlit "LengthByteVec")
     | DerefByteVec => empty_item (strlit "DerefByteVec")
     | TagLenEq n1 n2 => item_with_nums (strlit "TagLenEq") [n1; n2]
+    | LenEq num => item_with_num (strlit "LenEq") num
     | TagEq num => item_with_num (strlit "TagEq") num
     | Ref => empty_item (strlit "Ref")
-    | Deref => empty_item (strlit "Deref")
     | Update => empty_item (strlit "Update")
     | Label num => item_with_num (strlit "Label") num
-    | FFI s => Item NONE (strlit "FFI") [string_to_display2 s]
+    | FFI s => Item NONE (strlit "FFI") [string_imp s]
     | Equal => empty_item (strlit "Equal")
     | EqualInt i => empty_item (strlit "EqualIntWithMissingData")
     | Const i => empty_item (strlit "ConstWithMissingData")
@@ -510,7 +434,7 @@ val clos_to_display_def = tDefine "clos_to_display" `
     Item (SOME t) (strlit "Fn")
         [option_to_display num_to_display n1;
          option_to_display (list_to_display num_to_display) n2;
-         list_to_display string_to_display2 (num_to_varn_list h vn);
+         list_to_display string_imp (num_to_varn_list h vn);
          clos_to_display h x]) /\
   (clos_to_display h (closLang$Letrec t n1 n2 es e) =
     Item (SOME t) (strlit "Letrec'")
@@ -527,7 +451,7 @@ val clos_to_display_def = tDefine "clos_to_display" `
   (clos_to_display_letrecs h i len [] = []) /\
   (clos_to_display_letrecs h i len ((vn,e)::es) =
     Tuple [display_num_as_varn (h+i);
-        list_to_display string_to_display2 (num_to_varn_list (h+len-1) vn);
+        list_to_display string_imp (num_to_varn_list (h+len-1) vn);
         clos_to_display (h+len+vn) e]
     :: clos_to_display_letrecs h (i-1) len es)`
  (WF_REL_TAC `measure (\x. case x of
@@ -701,7 +625,7 @@ val word_prog_to_display_def = tDefine "word_prog_to_display" `
   (word_prog_to_display (DataBufferWrite n1 n2) =
     item_with_nums (strlit "DataBufferWrite") [n1; n2]) /\
   (word_prog_to_display (FFI nm n1 n2 n3 n4 ns) =
-    Item NONE (strlit "FFI") (string_to_display2 nm :: MAP num_to_display [n1; n2; n3; n4]
+    Item NONE (strlit "FFI") (string_imp nm :: MAP num_to_display [n1; n2; n3; n4]
         ++ [num_set_to_display ns])) /\
   (word_prog_to_display_ret NONE = empty_item (strlit "NONE")) /\
   (word_prog_to_display_ret (SOME (n1, ns, prog, n2, n3)) =
@@ -731,8 +655,8 @@ val word_progs_to_display_def = Define`
 val lang_to_json_def = Define`
   lang_to_json langN func =
     \ p . Object [
-      ("lang", String langN);
-      ("prog", display_to_json (func p))]`;
+      (strlit "lang", String langN);
+      (strlit "prog", display_to_json (func p))]`;
 
 (* tap configuration. which bits of compilation should we save?
    top-level code for assembling the tapped data. *)
@@ -772,13 +696,12 @@ val add_tap_def = Define `
   add_tap conf nm (to_display : 'a -> displayLang$sExp) (v : 'a) tds
     = if should_tap conf nm
     then Tap_Data (tap_name conf nm)
-            (\_. lang_to_json (explode nm) to_display v) :: tds
+            (\_. lang_to_json nm to_display v) :: tds
     else tds`;
 
-val tap_data_strings_def = Define `
-  tap_data_strings td = case td of
-    | Tap_Data nm json_f => (nm,
-        implode (misc$append (json_to_string (json_f ()))))`;
+val tap_data_mlstrings_def = Define `
+  tap_data_mlstrings td = case td of
+    | Tap_Data nm json_f => (nm, json_to_mlstring (json_f ()))`;
 
 val tap_flat_def = Define `
   tap_flat conf v = add_tap conf (strlit "flat") flat_to_display_decs v`;
@@ -786,10 +709,6 @@ val tap_flat_def = Define `
 val tap_word_def = Define `
   tap_word conf v = add_tap conf (strlit "word") word_progs_to_display v`;
 
-val tap_pat_def = Define`
-  tap_pat conf v = add_tap conf (strlit "pat")
-    (list_to_display (pat_to_display 0)) v`;
-
 val tap_clos_def = Define`
   tap_clos conf v = add_tap conf (strlit "clos")
     (list_to_display (clos_to_display 0)) v`;
diff --git a/compiler/backend/proofs/README.md b/compiler/backend/proofs/README.md
index 600fbda384..33de3bd57a 100644
--- a/compiler/backend/proofs/README.md
+++ b/compiler/backend/proofs/README.md
@@ -87,17 +87,11 @@ Part of the correctness proof for data_to_word
 [flat_elimProofScript.sml](flat_elimProofScript.sml):
 Correctness proof for flatLang dead code elimination
 
-[flat_exh_matchProofScript.sml](flat_exh_matchProofScript.sml):
-Correctness proof for flat_exh_match
+[flat_patternProofScript.sml](flat_patternProofScript.sml):
+Correctness proof for flat_pattern
 
-[flat_reorder_matchProofScript.sml](flat_reorder_matchProofScript.sml):
-Correctness proof for flat_reorder_match
-
-[flat_to_patProofScript.sml](flat_to_patProofScript.sml):
-Correctness proof for flat_to_pat
-
-[flat_uncheck_ctorsProofScript.sml](flat_uncheck_ctorsProofScript.sml):
-Correctness proof for uncheck_ctors
+[flat_to_closProofScript.sml](flat_to_closProofScript.sml):
+Correctness proof for flat_to_clos
 
 [lab_filterProofScript.sml](lab_filterProofScript.sml):
 Correctness proof for lab_filter
@@ -105,9 +99,6 @@ Correctness proof for lab_filter
 [lab_to_targetProofScript.sml](lab_to_targetProofScript.sml):
 Correctness proof for lab_to_target
 
-[pat_to_closProofScript.sml](pat_to_closProofScript.sml):
-Correctness proof for pat_to_clos
-
 [source_to_flatProofScript.sml](source_to_flatProofScript.sml):
 Correctness proof for source_to_flat
 
diff --git a/compiler/backend/proofs/backendProofScript.sml b/compiler/backend/proofs/backendProofScript.sml
index d082f750f8..64f2cd0817 100644
--- a/compiler/backend/proofs/backendProofScript.sml
+++ b/compiler/backend/proofs/backendProofScript.sml
@@ -4,8 +4,7 @@
 open preamble primSemEnvTheory semanticsPropsTheory
      backendTheory
      source_to_flatProofTheory
-     flat_to_patProofTheory
-     pat_to_closProofTheory
+     flat_to_closProofTheory
      clos_to_bvlProofTheory
      bvl_to_bviProofTheory
      bvi_to_dataProofTheory
@@ -161,8 +160,7 @@ Overload bvl_const_compile[local] = ``bvl_const$compile``
 Overload bvl_handle_compile[local] = ``bvl_handle$compile``
 Overload bvl_inline_compile_inc[local] = ``bvl_inline$compile_inc``
 Overload bvl_to_bvi_compile_exps[local] = ``bvl_to_bvi$compile_exps``
-Overload pat_to_clos_compile[local] = ``pat_to_clos$compile``
-Overload flat_to_pat_compile[local] = ``flat_to_pat$compile``
+Overload flat_to_clos_compile[local] = ``flat_to_clos$compile_decs``
 Overload stack_remove_prog_comp[local] = ``stack_remove$prog_comp``
 Overload stack_alloc_prog_comp[local] = ``stack_alloc$prog_comp``
 Overload stack_names_prog_comp[local] = ``stack_names$prog_comp``
@@ -172,43 +170,24 @@ Overload obeys_max_app[local] = ``closProps$obeys_max_app``
 Overload no_Labels[local] = ``closProps$no_Labels``
 Overload every_Fn_SOME[local] = ``closProps$every_Fn_SOME``
 Overload code_locs[local] = ``closProps$code_locs``
+Overload no_mti[local] = ``closProps$no_mti``
 
-(* TODO re-define syntax_ok on terms of things in closPropsTheory
- * (invent new properties), and prove elsewhere
- * that the pat_to_clos compiler satisfies these things.*)
-Theorem syntax_ok_pat_to_clos:
-   !e. clos_mtiProof$syntax_ok [pat_to_clos$compile e]
+Theorem no_mti_IMP_obeys_max_app:
+  !m exp. 0 < m /\ no_mti exp ==> obeys_max_app m exp
 Proof
-  ho_match_mp_tac pat_to_closTheory.compile_ind
-  \\ rw [pat_to_closTheory.compile_def,
-         clos_mtiProofTheory.syntax_ok_def,
-         pat_to_closTheory.CopyByteStr_def,
-         pat_to_closTheory.CopyByteAw8_def]
-  \\ rw [Once clos_mtiProofTheory.syntax_ok_cons]
-  \\ fs [clos_mtiProofTheory.syntax_ok_MAP, clos_mtiProofTheory.syntax_ok_def,
-         clos_mtiProofTheory.syntax_ok_REPLICATE, EVERY_MAP, EVERY_MEM]
-  \\ PURE_CASE_TAC \\ fs []
-  \\ rw [clos_mtiProofTheory.syntax_ok_def,
-         Once clos_mtiProofTheory.syntax_ok_cons,
-         clos_mtiProofTheory.syntax_ok_REVERSE,
-         clos_mtiProofTheory.syntax_ok_MAP]
-QED
-
-Theorem syntax_ok_MAP_pat_to_clos:
-   !xs. clos_mtiProof$syntax_ok (MAP pat_to_clos_compile xs)
-Proof
-  Induct \\ fs [clos_mtiProofTheory.syntax_ok_def]
-  \\ once_rewrite_tac [clos_mtiProofTheory.syntax_ok_cons]
-  \\ fs [syntax_ok_pat_to_clos]
+  ho_match_mp_tac closPropsTheory.obeys_max_app_ind
+  \\ rpt conj_tac
+  \\ simp [closPropsTheory.no_mti_def, ETA_THM]
+  \\ rw [EVERY_MAP]
+  \\ fs [EVERY_MEM, FORALL_PROD, MEM_MAP, PULL_EXISTS]
+  \\ rw []
+  \\ res_tac
 QED
 
-Theorem syntax_ok_IMP_obeys_max_app:
-   !e3. 0 < m /\ clos_mtiProof$syntax_ok e3 ==> EVERY (obeys_max_app m) e3
+Theorem EVERY_no_mti_IMP_obeys_max_app:
+  !e3. 0 < m /\ EVERY no_mti exps ==> EVERY (obeys_max_app m) exps
 Proof
-  ho_match_mp_tac clos_mtiProofTheory.syntax_ok_ind \\ rpt strip_tac \\ fs []
-  \\ pop_assum mp_tac \\ once_rewrite_tac [clos_mtiProofTheory.syntax_ok_def]
-  \\ fs [] \\ fs [EVERY_MEM,MEM_MAP,FORALL_PROD,PULL_EXISTS]
-  \\ rw [] \\ res_tac
+  metis_tac [EVERY_MONOTONIC, no_mti_IMP_obeys_max_app]
 QED
 
 (* TODO: move these *)
@@ -217,7 +196,7 @@ Theorem compile_common_syntax:
       clos_to_bvl$compile_common cf e3 = (cf1,e4) ==>
       (EVERY no_Labels e3 ==>
        EVERY no_Labels (MAP (SND o SND) e4)) /\
-      (0 < cf.max_app /\ clos_mtiProof$syntax_ok e3 ==>
+      (0 < cf.max_app /\ EVERY no_mti e3 ==>
        EVERY (obeys_max_app cf.max_app) (MAP (SND o SND) e4)) /\
       every_Fn_SOME (MAP (SND o SND) e4)
 Proof
@@ -244,13 +223,13 @@ Proof
     \\ fs [EVERY_MEM,FORALL_PROD,MEM_MAP,PULL_EXISTS]
     \\ rw [] \\ res_tac \\ fs [])
   THEN1 (* obeys_max_app *)
-   (old_drule (clos_numberProofTheory.renumber_code_locs_obeys_max_app
+   (drule (clos_numberProofTheory.renumber_code_locs_obeys_max_app
            |> CONJUNCT1 |> GEN_ALL)
     \\ disch_then (qspec_then `cf.max_app` mp_tac)
     \\ impl_tac THEN1
      (Cases_on `cf.do_mti` \\ fs [clos_mtiTheory.compile_def]
       \\ fs [clos_mtiProofTheory.intro_multi_obeys_max_app]
-      \\ match_mp_tac syntax_ok_IMP_obeys_max_app \\ fs[])
+      \\ simp [EVERY_no_mti_IMP_obeys_max_app])
     \\ strip_tac
     \\ `EVERY (obeys_max_app cf.max_app) es'` by
       (Cases_on `cf.known_conf` THEN1 (fs [clos_knownTheory.compile_def] \\ rfs [])
@@ -292,10 +271,6 @@ Proof
   \\ match_mp_tac clos_to_bvlProofTheory.chain_exps_every_Fn_SOME \\ fs []
 QED
 
-Overload esgc_free = ``patProps$esgc_free``
-Overload elist_globals = ``flatProps$elist_globals``
-Overload set_globals = ``flatProps$set_globals``
-
 Theorem word_list_exists_imp:
    dm = stack_removeProof$addresses a n /\
     dimindex (:'a) DIV 8 * n < dimword (:'a) ∧ good_dimindex (:'a) ⇒
@@ -305,8 +280,7 @@ Proof
 QED
 
 val semantics_thms = [source_to_flatProofTheory.compile_semantics,
-  flat_to_patProofTheory.compile_semantics,
-  pat_to_closProofTheory.compile_semantics,
+  flat_to_closProofTheory.compile_semantics,
   clos_to_bvlProofTheory.compile_semantics,
   bvl_to_bviProofTheory.compile_semantics,
   bvi_to_dataProofTheory.compile_prog_semantics,
@@ -317,7 +291,6 @@ val semantics_thms = [source_to_flatProofTheory.compile_semantics,
 val _ = Datatype `progs =
   <| source_prog : ast$dec list
    ; flat_prog : flatLang$dec list
-   ; pat_prog : patLang$exp list
    ; clos_prog : closLang$exp list
    ; bvl_prog : (num # num # bvl$exp) list
    ; bvi_prog : (num # num # bvi$exp) list
@@ -331,7 +304,7 @@ val _ = Datatype `progs =
 
 val empty_progs_def = Define `
   empty_progs = <| source_prog := []; flat_prog := [];
-    pat_prog := []; clos_prog := []; bvl_prog := []; bvi_prog := [];
+    clos_prog := []; bvl_prog := []; bvi_prog := [];
     data_prog := []; word_prog := []; stack_prog := []; cur_bm := [];
     lab_prog := []; target_prog := ([], []) |>`;
 
@@ -392,11 +365,9 @@ val compile_inc_progs_def = Define`
     let (c',p) = source_to_flat$compile c.source_conf p in
     let ps = ps with <| flat_prog := p |> in
     let c = c with source_conf := c' in
-    let p = flat_to_pat$compile p in
-    let ps = ps with <| pat_prog := p |> in
-    let p = (MAP pat_to_clos$compile p, []) in
-    let ps = ps with <| clos_prog := FST p |> in
-    let (c',p) = clos_to_bvl_compile_inc c.clos_conf p in
+    let p = flat_to_clos_compile p in
+    let ps = ps with <| clos_prog := p |> in
+    let (c',p) = clos_to_bvl_compile_inc c.clos_conf (p, []) in
     let c = c with clos_conf := c' in
     let ps = ps with <| bvl_prog := p |> in
     let (c', p) = bvl_to_bvi_compile_inc_all c.bvl_conf p in
@@ -594,12 +565,9 @@ Theorem cake_orac_eqs:
     (cake_orac c' src config_tuple1 (\ps. ps.source_prog)) =
   cake_orac c' src (SND o config_tuple1) (\ps. ps.flat_prog)
   /\
-  pure_co flat_to_pat$compile o cake_orac c' src f1 (\ps. ps.flat_prog) =
-  cake_orac c' src f1 (\ps. ps.pat_prog)
-  /\
-  pure_co (λe. (MAP pat_to_clos_compile e,[])) o
-    cake_orac c' src f2 (\ps. ps.pat_prog) =
-  cake_orac c' src f2 (\ps. (ps.clos_prog, []))
+  pure_co (\p. (flat_to_clos_compile p, []))
+    o cake_orac c' src f1 (\ps. ps.flat_prog) =
+  cake_orac c' src f1 (\ps. (ps.clos_prog, []))
   /\ (
   compile c prog = SOME (b,bm,c') /\ clos_c = c.clos_conf ==>
   pure_co (clos_to_bvlProof$compile_inc clos_c.max_app) o
@@ -678,13 +646,13 @@ Proof
   )
 QED
 
-val [source_to_flat_orac_eq, flat_to_pat_orac_eq, pat_to_clos_orac_eq,
+val [source_to_flat_orac_eq, flat_to_clos_orac_eq,
     clos_to_bvl_orac_eq, bvl_to_bvi_orac_eq, bvi_to_data_orac_eq,
     data_to_word_orac_eq, word_to_stack_orac_eq, stack_to_lab_orac_eq] =
         map GEN_ALL (CONJUNCTS cake_orac_eqs);
 
-val simple_orac_eqs = LIST_CONJ [source_to_flat_orac_eq, flat_to_pat_orac_eq,
-    pat_to_clos_orac_eq, bvi_to_data_orac_eq];
+val simple_orac_eqs = LIST_CONJ [source_to_flat_orac_eq, flat_to_clos_orac_eq,
+    bvi_to_data_orac_eq];
 
 Theorem cake_orac_0:
   cake_orac c' src f g 0 = (f c', g (SND (compile_inc_progs c' (src 0))))
@@ -775,68 +743,33 @@ val from_EXS = [
     from_stack_conf_EX,
     from_lab_conf_EX]
 
-Theorem MAP_compile_contains_App_SOME:
-  0 < max_app ==> ¬ closProps$contains_App_SOME max_app (MAP pat_to_clos_compile xs)
-Proof
-  REWRITE_TAC [Once closPropsTheory.contains_App_SOME_EXISTS, EXISTS_MAP]
-  \\ simp_tac bool_ss [pat_to_closProofTheory.compile_contains_App_SOME]
-  \\ simp [o_DEF]
-QED
-
-Theorem MAP_compile_esgc_free:
-  EVERY esgc_free es
-    ==> EVERY closProps$esgc_free (MAP pat_to_clos_compile es)
-Proof
-  rw [EVERY_EL, EL_MAP]
-  \\ fs [pat_to_closProofTheory.compile_esgc_free]
-QED
-
-Theorem MAP_compile_every_Fn_vs_NONE:
-  closProps$every_Fn_vs_NONE (MAP pat_to_clos_compile es)
-Proof
-  REWRITE_TAC [Once closPropsTheory.every_Fn_vs_NONE_EVERY, EVERY_MAP]
-  \\ simp_tac bool_ss [pat_to_closProofTheory.compile_every_Fn_vs_NONE]
-  \\ simp []
-QED
-
+(*
 Theorem MAP_compile_distinct_setglobals:
-  BAG_ALL_DISTINCT (patProps$elist_globals es) ⇒
-  BAG_ALL_DISTINCT (closProps$elist_globals (MAP pat_to_clos_compile es))
+  BAG_ALL_DISTINCT (flatProps$elist_globals es) ⇒
+  BAG_ALL_DISTINCT (closProps$elist_globals (flat_to_clos_compile m es))
 Proof
   fs [closPropsTheory.elist_globals_FOLDR, MAP_MAP_o, o_DEF,
     GSYM pat_to_closProofTheory.set_globals_eq, ETA_THM,
     patPropsTheory.elist_globals_FOLDR]
 QED
+*)
 
-Theorem oracle_monotonic_globals_pat_to_clos:
-  oracle_monotonic (SET_OF_BAG ∘ patProps$elist_globals ∘ SND) $<
-    (SET_OF_BAG (patProps$elist_globals p))
-    orac ==>
-  oracle_monotonic (SET_OF_BAG ∘ closProps$elist_globals ∘ FST ∘ SND) $<
-    (SET_OF_BAG (closProps$elist_globals (MAP pat_to_clos_compile p)))
-    (pure_co (λes. (MAP pat_to_clos_compile es,[])) o orac)
-Proof
-  match_mp_tac backendPropsTheory.oracle_monotonic_subset
-  \\ simp [syntax_to_full_oracle_def, pure_co_progs_def,
-        closPropsTheory.elist_globals_FOLDR, MAP_MAP_o, o_DEF,
-        GSYM pat_to_closProofTheory.set_globals_eq]
-  \\ simp [patPropsTheory.elist_globals_FOLDR, ETA_THM]
-QED
-
-Theorem oracle_monotonic_globals_flat_to_pat:
-  oracle_monotonic (SET_OF_BAG ∘ flatProps$elist_globals ∘
-        MAP flatProps$dest_Dlet ∘ FILTER flatProps$is_Dlet ∘ SND) $<
+Theorem oracle_monotonic_globals_flat_to_clos:
+  flatProps$no_Mat_decs p /\
+  (!n. flatProps$no_Mat_decs (SND (orac n))) /\
+  oracle_monotonic (SET_OF_BAG ∘ flatProps$elist_globals
+        ∘ MAP flatProps$dest_Dlet ∘ FILTER flatProps$is_Dlet ∘ SND) $<
     (SET_OF_BAG (flatProps$elist_globals
-        (MAP flatProps$dest_Dlet (FILTER flatProps$is_Dlet p))))
+      (MAP flatProps$dest_Dlet (FILTER flatProps$is_Dlet p))))
     orac ==>
-  oracle_monotonic (SET_OF_BAG ∘ patProps$elist_globals ∘ SND) $<
-    (SET_OF_BAG (patProps$elist_globals (flat_to_pat_compile p)))
-    (pure_co flat_to_pat_compile o orac)
+  oracle_monotonic (SET_OF_BAG ∘ closProps$elist_globals ∘ FST ∘ SND) $<
+    (SET_OF_BAG (closProps$elist_globals (compile_decs p)))
+    (pure_co (λp. (compile_decs p,[])) ∘ orac)
 Proof
-  match_mp_tac backendPropsTheory.oracle_monotonic_subset
-  \\ simp [syntax_to_full_oracle_def, pure_co_progs_def]
-  \\ metis_tac [bagTheory.SUB_BAG_SET,
-        flat_to_patProofTheory.elist_globals_compile]
+  rw []
+  \\ pop_assum mp_tac
+  \\ match_mp_tac backendPropsTheory.oracle_monotonic_subset
+  \\ simp [PULL_FORALL, compile_decs_set_globals]
 QED
 
 Theorem cake_orac_invariant:
@@ -857,7 +790,7 @@ Theorem source_to_flat_SND_compile_esgc_free =
 
 Theorem compile_globals_BAG_ALL_DISTINCT:
   source_to_flat$compile conf prog = (conf', prog') /\ conf' = conf'' ==>
-  BAG_ALL_DISTINCT (elist_globals (MAP flatProps$dest_Dlet
+  BAG_ALL_DISTINCT (flatProps$elist_globals (MAP flatProps$dest_Dlet
     (FILTER flatProps$is_Dlet prog')))
 Proof
   rw []
@@ -865,9 +798,8 @@ Proof
         source_to_flatTheory.compile_prog_def]
   \\ rpt (pairarg_tac \\ fs [])
   \\ rveq \\ fs []
-  \\ irule (
-        MATCH_MP (REWRITE_RULE [GSYM AND_IMP_INTRO] BAG_ALL_DISTINCT_SUB_BAG)
-            (compile_flat_sub_bag))
+  \\ drule_then assume_tac compile_flat_sub_bag
+  \\ drule_then irule BAG_ALL_DISTINCT_SUB_BAG
   \\ fs [source_to_flatTheory.glob_alloc_def, flatPropsTheory.op_gbag_def]
   \\ imp_res_tac compile_decs_elist_globals
   \\ fs [LIST_TO_BAG_DISTINCT]
@@ -879,6 +811,18 @@ Theorem compile_SND_globals_BAG_ALL_DISTINCT =
   GEN_ALL compile_globals_BAG_ALL_DISTINCT
     |> SIMP_RULE bool_ss [PAIR_FST_SND_EQ, FST, SND]
 
+Theorem source_to_flat_compile_no_Mat:
+  flatProps$no_Mat_decs (SND (compile c prog))
+Proof
+  fs [source_to_flatTheory.compile_def,
+        source_to_flatTheory.compile_prog_def,
+        source_to_flatTheory.compile_flat_def]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs []
+  \\ drule flat_patternProofTheory.compile_decs_no_Mat
+  \\ simp []
+QED
+
 fun conseq xs = ConseqConv.CONSEQ_REWRITE_TAC (xs, [], [])
 
 fun qsubpat_x_assum tac = let
@@ -1157,6 +1101,14 @@ Proof
   \\ metis_tac []
 QED
 
+Theorem cake_orac_SND_clos_prog_nil:
+  SND (cake_orac c' syntax g (\ps. (ps.clos_prog, [])) n) =
+  (SND (cake_orac c' syntax g (\ps. ps.clos_prog) n), [])
+Proof
+  rw [cake_orac_def]
+  \\ rpt (pairarg_tac \\ fs [])
+QED
+
 Theorem cake_orac_clos_syntax_oracle_ok:
   compile (c : 's config) prog = SOME (b, bm, c') /\
   compile c2 clos_prog = (clos_c', clos_prog') /\
@@ -1168,39 +1120,32 @@ Theorem cake_orac_clos_syntax_oracle_ok:
      (cake_orac c' syntax (SND ∘ config_tuple1) (λps. (ps.clos_prog,[])))
 Proof
   rw []
-  \\ simp [to_clos_def, to_pat_def, to_flat_def]
+  \\ simp [to_clos_def, to_flat_def, flatPropsTheory.elist_globals_REVERSE]
   \\ rpt (pairarg_tac \\ fs [])
   \\ rveq \\ fs []
   \\ simp [syntax_oracle_ok_def, to_clos_def]
   \\ simp [backendPropsTheory.FST_state_co, cake_orac_0,
-      config_tuple1_def]
-  \\ conseq [syntax_ok_MAP_pat_to_clos]
+      config_tuple1_def, compile_decs_syntactic_props]
   \\ simp [clos_knownProofTheory.syntax_ok_def]
   \\ simp [GSYM simple_orac_eqs]
-  \\ csimp [MAP_compile_every_Fn_vs_NONE]
-  \\ conseq [MAP_compile_contains_App_SOME,
-      MAP_compile_esgc_free, syntax_ok_MAP_pat_to_clos,
-      MAP_compile_distinct_setglobals,
-      flat_to_patProofTheory.compile_esgc_free]
-  \\ conseq [MATCH_MP
-          (REWRITE_RULE [GSYM AND_IMP_INTRO] BAG_ALL_DISTINCT_SUB_BAG)
-          (SPEC_ALL elist_globals_compile)]
+  \\ csimp [compile_decs_syntactic_props]
+  \\ simp [PULL_FORALL] \\ rpt gen_tac
+  \\ conseq [compile_decs_esgc_free,
+    oracle_monotonic_globals_flat_to_clos]
+  \\ DEP_REWRITE_TAC [compile_decs_set_globals]
+  \\ csimp []
   \\ fs [PAIR_FST_SND_EQ |> Q.ISPEC `source_to_flat$compile c p`, SND_state_co]
   \\ rveq
-  \\ conseq [source_to_flat_SND_compile_esgc_free,
-        compile_SND_globals_BAG_ALL_DISTINCT]
+  \\ simp [compile_SND_globals_BAG_ALL_DISTINCT, source_to_flat_SND_compile_esgc_free]
+  \\ simp [source_to_flat_compile_no_Mat]
   \\ simp [Q.prove (`prim_config.source_conf.mod_env.v = nsEmpty`, EVAL_TAC)]
-  \\ simp [GSYM simple_orac_eqs]
-  \\ conseq [oracle_monotonic_globals_pat_to_clos,
-        oracle_monotonic_globals_flat_to_pat]
   \\ qpat_assum `compile c _ = SOME _`
     (assume_tac o REWRITE_RULE [compile_eq_from_source])
-  \\ fs [from_source_def, from_pat_def, from_flat_def,
-        to_clos_def, to_pat_def, to_flat_def]
+  \\ fs [from_source_def, from_flat_def,
+        to_clos_def, to_flat_def]
   \\ rpt (pairarg_tac \\ fs [])
   \\ rveq \\ fs []
   \\ drule_then (fn t => conseq [t]) monotonic_globals_state_co_compile
-  \\ simp [Q.prove (`prim_config.source_conf.mod_env.v = nsEmpty`, EVAL_TAC)]
   \\ simp [cake_orac_0, config_tuple1_def]
   \\ rename [`compile _.source_conf _ = (source_conf',_)`]
   \\ `source_conf' = c'.source_conf` by (
@@ -1507,7 +1452,7 @@ Proof
   \\ rveq \\ fs []
   \\ drule_then irule bvl_to_bviProofTheory.compile_distinct_names
   \\ drule_then (fn t => simp [t]) compile_all_distinct_locs
-  \\ fs [to_clos_def, to_pat_def, to_flat_def]
+  \\ fs [to_clos_def, to_flat_def]
   \\ rpt (pairarg_tac \\ fs [])
   \\ rveq \\ fs []
   \\ fs [backend_config_ok_def]
@@ -1814,7 +1759,7 @@ Proof
     \\ rpt (pairarg_tac \\ fs [])
     \\ drule_then strip_assume_tac attach_bitmaps_SOME
     \\ simp [to_stack_def, to_word_def, to_data_def, to_bvi_def, to_bvl_def,
-        to_clos_def, to_pat_def, to_flat_def, to_lab_def]
+        to_clos_def, to_flat_def, to_lab_def]
     \\ fs[lab_to_targetTheory.compile_def]
     \\ drule compile_lab_domain_labels
     \\ `domain c.lab_conf.labels = {}` by fs [backend_config_ok_def]
@@ -1985,7 +1930,7 @@ Proof
     \\ rw []
     \\ TRY (qpat_x_assum `_ < SUC _` mp_tac \\ EVAL_TAC \\ simp [])
     \\ fs [backendTheory.compile_def, backendTheory.compile_tap_def,
-          to_bvi_def, to_bvl_def, to_clos_def, to_pat_def, to_flat_def,
+          to_bvi_def, to_bvl_def, to_clos_def, to_flat_def,
           bvl_to_bviTheory.compile_def]
     \\ rpt (pairarg_tac \\ fs [])
     \\ drule_then assume_tac attach_bitmaps_SOME
@@ -2031,7 +1976,7 @@ Proof
     \\ simp [FST_state_co, pred_setTheory.IN_PREIMAGE, cake_orac_0,
             config_tuple2_def]
     \\ fs [backendTheory.compile_def, backendTheory.compile_tap_def,
-          to_bvi_def, to_bvl_def, to_clos_def, to_pat_def, to_flat_def,
+          to_bvi_def, to_bvl_def, to_clos_def, to_flat_def,
           bvl_to_bviTheory.compile_def]
     \\ rpt (pairarg_tac \\ fs [])
     \\ drule_then assume_tac attach_bitmaps_SOME
@@ -2074,7 +2019,7 @@ Proof
   \\ drule attach_bitmaps_SOME
   \\ rw []
   \\ drule_then drule (GEN_ALL cake_orac_clos_syntax_oracle_ok)
-  \\ simp [to_clos_def, to_pat_def, to_flat_def]
+  \\ simp [to_clos_def, to_flat_def]
   \\ disch_then (qspec_then `syntax` mp_tac)
   \\ impl_tac >- (
     fs [backend_config_ok_def] \\ metis_tac []
@@ -2087,7 +2032,7 @@ Proof
   \\ drule_then (fn t => simp [t]) clos_to_bvl_orac_eq
   \\ match_mp_tac backendPropsTheory.oracle_monotonic_subset
   \\ simp [cake_orac_0, config_tuple1_def]
-  \\ simp [to_bvl_def, to_clos_def, to_pat_def, to_flat_def]
+  \\ simp [to_bvl_def, to_clos_def, to_flat_def]
   \\ fs [clos_to_bvlTheory.compile_def]
   \\ rpt (pairarg_tac \\ fs [])
   \\ rveq \\ fs []
@@ -2464,7 +2409,6 @@ Proof
      to_bvi_def,
      to_bvl_def,
      to_clos_def,
-     to_pat_def,
      to_flat_def]
   \\ unabbrev_all_tac
   \\ rpt (CHANGED_TAC (srw_tac[][] >> full_simp_tac(srw_ss())[] >> srw_tac[][] >> rev_full_simp_tac(srw_ss())[]))
@@ -2490,7 +2434,6 @@ Proof
      to_bvi_def,
      to_bvl_def,
      to_clos_def,
-     to_pat_def,
      to_flat_def]
   \\ rpt (CHANGED_TAC (srw_tac[][] >> full_simp_tac(srw_ss())[] >> srw_tac[][] >> rev_full_simp_tac(srw_ss())[]))
   \\ rpt (pairarg_tac \\ fs []) \\ rveq \\ rfs []
@@ -2706,11 +2649,13 @@ Proof
     metis_tac[semantics_prog_deterministic] ) >>
   qunabbrev_tac`sem2` >>
 
-  (flat_to_patProofTheory.compile_semantics
+
+
+  (
+   flat_to_closProofTheory.compile_semantics
    |> Q.GEN`cc`
    |> (
      ``
-     backendProps$pure_cc (λes. (MAP pat_to_clos$compile es, [])) (
       clos_to_bvlProof$compile_common_inc (c:'a config).clos_conf
          (backendProps$pure_cc (clos_to_bvlProof$compile_inc c.clos_conf.max_app)
            (bvl_to_bviProof$full_cc c.bvl_conf (backendProps$pure_cc bvi_to_data_compile_prog
@@ -2734,36 +2679,27 @@ Proof
                             cfg (MAP (λp. full_compile_single mc.target.config.two_reg_arith (mc.target.config.reg_count - (LENGTH mc.target.config.avoid_regs + 5))
                             c.word_to_word_conf.reg_alg
                             (mc:('a,'b,'c)machine_config).target.config (p,NONE)) progs)) o
-                            MAP (compile_part (ensure_fp_conf_ok mc.target.config c.data_conf)))))))``
+                            MAP (compile_part (ensure_fp_conf_ok mc.target.config c.data_conf))))))``
      |> ISPEC)
    |> Q.GEN`co`
-   |> Q.GEN`k0`
    |> Q.GEN`c`
+   |> Q.GEN`ds`
+   |> Q.GEN`ffi`
    |> old_drule)
 
-  \\ disch_then(qspecl_then[`c`, `TODO_clock`,
-        `cake_orac c' TODO_syntax (SND o config_tuple1) (\ps. ps.flat_prog)`]
+  \\ disch_then (first_assum o mp_then (Pat `_ <> Fail`) mp_tac)
+
+  \\ simp [source_to_flat_compile_no_Mat]
+
+  \\ disch_then(qspecl_then[`c`,
+        `cake_orac c' TODO_syntax (SND o config_tuple1)
+            (\ps. ((ps.clos_prog, []) : clos_prog))`]
     (strip_assume_tac o SYM)) >>
 
-  qhdtm_x_assum`from_pat`mp_tac >>
-  srw_tac[][from_pat_def] >>
-  pop_assum mp_tac >> BasicProvers.LET_ELIM_TAC >>
-  qmatch_abbrev_tac`_ ⊆ _ { patSem$semantics [] (st4 (pure_cc pc cc3) st3) es3 }` >>
-  (pat_to_closProofTheory.compile_semantics
-   |> Q.GENL[`cc`,`st`,`es`,`max_app`]
-   |> qispl_then[`cc3`,`st4 (pure_cc pc cc3) st3`,`es3`]mp_tac) >>
-  simp[Abbr`es3`] >>
-  disch_then old_drule >>
-  impl_tac >- (
-    fs[Abbr`st3`, flat_to_patProofTheory.compile_state_def, Abbr`st4`]
-    \\ EVAL_TAC ) >>
-  disch_then(strip_assume_tac o SYM) >> fs[] >>
   qhdtm_x_assum`from_clos`mp_tac >>
   srw_tac[][from_clos_def] >>
   pop_assum mp_tac >> BasicProvers.LET_ELIM_TAC >>
-  qunabbrev_tac`st4` >>
-  simp[flat_to_patProofTheory.compile_state_def] >>
-  simp[Abbr`st3`,flatSemTheory.initial_state_def] >>
+  simp[flatSemTheory.initial_state_def] >>
   qmatch_abbrev_tac`_ ⊆ _ { closSem$semantics _ _ _ co3 cc3 e3 }` >>
   qmatch_asmsub_abbrev_tac`clos_to_bvlProof$compile_common_inc cf (pure_cc (clos_to_bvlProof$compile_inc _) cc)`
   \\ Q.ISPECL_THEN[`co3`,`cc`,`e3`,`ffi`,`cf`]mp_tac
@@ -2771,7 +2707,6 @@ Proof
   \\ simp[]
 
   \\ qunabbrev_tac `co3`
-  \\ qunabbrev_tac `pc`
   \\ qunabbrev_tac `cf`
   \\ DEP_REWRITE_TAC (map GEN_ALL (CONJUNCTS cake_orac_eqs))
   \\ rpt (conj_tac >- (asm_exists_tac \\ simp [] \\ NO_TAC))
@@ -2780,12 +2715,11 @@ Proof
     rpt (qsubpat_x_assum kall_tac `patSem$semantics []`)
     \\ conj_tac
     >- (
-      fs[flat_to_patProofTheory.compile_state_def,
-         flatSemTheory.initial_state_def,Abbr`s`,
+      fs[flatSemTheory.initial_state_def,Abbr`s`,
          cake_orac_eqs] )
     \\ drule_then irule cake_orac_clos_syntax_oracle_ok
     \\ unabbrev_all_tac
-    \\ simp [to_clos_def, to_pat_def, to_flat_def]
+    \\ simp [to_clos_def, to_flat_def]
     \\ EVERY (map imp_res_tac from_EXS)
     \\ rveq \\ fs []
     \\ simp [clos_to_bvlTheory.config_component_equality]
@@ -2888,7 +2822,7 @@ Proof
 
   rewrite_tac [is_safe_for_space_def] \\
   `SND(to_data c prog) = p4 /\ SND(to_word c prog) = p5` by
-    fs[to_word_def,to_data_def,to_bvi_def,to_bvl_def,to_clos_def,to_pat_def,to_flat_def] \\
+    fs[to_word_def,to_data_def,to_bvi_def,to_bvl_def,to_clos_def,to_flat_def] \\
   pop_assum (fn th => rewrite_tac [th]) \\
   pop_assum (fn th => rewrite_tac [th,LET_THM]) \\
   simp_tac std_ss [] \\
diff --git a/compiler/backend/proofs/bvi_to_dataProofScript.sml b/compiler/backend/proofs/bvi_to_dataProofScript.sml
index 51df6082b3..0aab283e23 100644
--- a/compiler/backend/proofs/bvi_to_dataProofScript.sml
+++ b/compiler/backend/proofs/bvi_to_dataProofScript.sml
@@ -501,6 +501,10 @@ Proof
   >- (Cases_on `t.tstamps`
      \\ rw [data_to_bvi_v_def,MAP_TAKE,MAP_DROP]
      \\ METIS_TAC [])
+  >- (`Num i < LENGTH l`
+      by ((drule o GEN_ALL o GSYM) integerTheory.NUM_LT \\ strip_tac \\ fs [])
+      \\ Cases_on `z` \\ fs [data_to_bvi_ref_def]
+      \\ rw [EL_MAP] \\ fs [] \\ rw [EL_MAP] \\ fs [])
   >- (Cases_on `z` \\ fs [data_to_bvi_ref_def,data_to_bvi_v_def])
   >- (Cases_on `z` \\ fs [data_to_bvi_ref_def,data_to_bvi_v_def])
   >- (rw [data_to_bvi_ref_def] \\ rfs [refs_rel_LEAST_eq,lookup_map])
@@ -522,9 +526,6 @@ Proof
      \\ rw [data_to_bvi_v_def,MAP_TAKE,MAP_DROP]
      \\ METIS_TAC [])
   >- (rw [data_to_bvi_ref_def] \\ rfs [refs_rel_LEAST_eq,lookup_map,map_replicate])
-  >- (Cases_on `z` \\ fs [data_to_bvi_ref_def,data_to_bvi_v_def] \\ rfs []
-     \\ DEP_REWRITE_TAC [EL_MAP] \\ rfs [] \\ drule integerTheory.NUM_LT
-     \\ disch_then (qspec_then `&LENGTH l'` mp_tac) \\ rw [])
   >- (Cases_on `z` \\ fs [data_to_bvi_ref_def,data_to_bvi_v_def]
      \\ rfs [data_to_bvi_v_def,Unit_def,bvlSemTheory.Unit_def]
      \\ rw [data_to_bvi_ref_def]
diff --git a/compiler/backend/proofs/bvl_to_bviProofScript.sml b/compiler/backend/proofs/bvl_to_bviProofScript.sml
index 3ce107def4..b7afe2aee1 100644
--- a/compiler/backend/proofs/bvl_to_bviProofScript.sml
+++ b/compiler/backend/proofs/bvl_to_bviProofScript.sml
@@ -222,6 +222,12 @@ val do_app_ok_lemma = Q.prove(
    (rw [] \\ fs [bvlSemTheory.do_app_def,bvlSemTheory.do_install_def,
       case_eq_thms,UNCURRY] \\ rveq \\ fs [state_ok_def]
     \\ fs [bv_ok_def])
+  \\ Cases_on `op = El` THEN1
+   (full_simp_tac(srw_ss())[bvlSemTheory.do_app_def]
+    \\ BasicProvers.EVERY_CASE_TAC \\ rw [] \\ fs []
+    \\ imp_res_tac integerTheory.NUM_POSINT_EXISTS \\ rveq \\ fs []
+    \\ fs [bv_ok_def,EVERY_EL,state_ok_def]
+    \\ first_x_assum (qspec_then `n` mp_tac) \\ fs [])
   \\ Cases_on `op` \\ full_simp_tac(srw_ss())[bvlSemTheory.do_app_def]
   \\ BasicProvers.EVERY_CASE_TAC
   \\ TRY (full_simp_tac(srw_ss())[] \\ SRW_TAC [] [bv_ok_def]
@@ -359,12 +365,6 @@ val do_app_ok_lemma = Q.prove(
     \\ TRY (asm_exists_tac \\ fs [] \\ fs [SUBSET_DEF])
     \\ every_case_tac \\ fs[FAPPLY_FUPDATE_THM]
     \\ every_case_tac \\ fs[LEAST_NOTIN_FDOM] \\ rw[] )
-  THEN1
-   (rename1 `_ () = Deref`
-    \\ full_simp_tac(srw_ss())[state_ok_def]
-    \\ Q.PAT_X_ASSUM `!k:num. bbb` (MP_TAC o Q.SPEC `n`) \\ full_simp_tac(srw_ss())[]
-    \\ full_simp_tac(srw_ss())[EVERY_EL] \\ REPEAT STRIP_TAC \\ RES_TAC
-    \\ SRW_TAC [] [] \\ Cases_on `i` \\ full_simp_tac(srw_ss())[])
   THEN1
    (rename1 `_ () = Update`
     \\ full_simp_tac(srw_ss())[state_ok_def] \\ SRW_TAC [] [] THEN1
@@ -1154,10 +1154,18 @@ val do_app_adjust = Q.prove(
   \\ SIMP_TAC std_ss [Once bEvalOp_def,iEvalOp_def,do_app_aux_def]
   \\ Cases_on `op = El` \\ fs [] THEN1
    (BasicProvers.EVERY_CASE_TAC \\ full_simp_tac(srw_ss())[adjust_bv_def,bEvalOp_def]
-    \\ every_case_tac >> full_simp_tac(srw_ss())[]
-    \\ SRW_TAC [] []
+    \\ imp_res_tac integerTheory.NUM_POSINT_EXISTS \\ rveq \\ fs [] \\ rfs []
+    \\ rveq \\ fs [listTheory.SWAP_REVERSE_SYM] \\ rveq \\ fs []
+    \\ fs [EL_MAP]
     \\ full_simp_tac(srw_ss())[adjust_bv_def,MAP_EQ_f,bvl_to_bvi_id,
-         bEvalOp_def,EL_MAP] \\ SRW_TAC [] [])
+         bEvalOp_def,EL_MAP] \\ SRW_TAC [] [] \\ fs []
+    \\ REPEAT STRIP_TAC \\ SRW_TAC [] [adjust_bv_def]
+    \\ CCONTR_TAC \\ fs [] \\ rveq \\ fs []
+    \\ `FLOOKUP t2.refs (b2 n) = SOME(ValueArray(MAP (adjust_bv b2) l))` by (
+        full_simp_tac(srw_ss())[state_rel_def] >>
+        last_x_assum(qspec_then`n`mp_tac) >>
+        simp[] ) >> fs [CaseEq"bool"] >> rveq
+    \\ rfs [EL_MAP,bvl_to_bvi_id])
   \\ Cases_on `op = ListAppend` \\ fs []
   >-
    (fs [case_eq_thms, case_elim_thms, PULL_EXISTS, SWAP_REVERSE_SYM]
@@ -1198,25 +1206,6 @@ val do_app_adjust = Q.prove(
     full_simp_tac(srw_ss())[state_rel_def] >>
     last_x_assum(qspec_then`n`mp_tac) >> simp[] >>
     spose_not_then strip_assume_tac >> full_simp_tac(srw_ss())[])
-  \\ Cases_on `op = Deref` \\ fs [] THEN1
-   (Cases_on `REVERSE a` \\ full_simp_tac(srw_ss())[]
-    \\ Cases_on `t` \\ full_simp_tac(srw_ss())[]
-    \\ Cases_on `h'` \\ full_simp_tac(srw_ss())[]
-    \\ Cases_on `h` \\ full_simp_tac(srw_ss())[]
-    \\ Cases_on `t'` \\ full_simp_tac(srw_ss())[]
-    \\ Cases_on `FLOOKUP s5.refs n` \\ full_simp_tac(srw_ss())[]
-    \\ Cases_on `x` \\ full_simp_tac(srw_ss())[]
-    \\ REPEAT STRIP_TAC \\ SRW_TAC [] [adjust_bv_def]
-    \\ full_simp_tac(srw_ss())[bEvalOp_def]
-    \\ Q.EXISTS_TAC `t2` \\ full_simp_tac(srw_ss())[]
-    \\ `FLOOKUP t2.refs (b2 n) = SOME(ValueArray(MAP (adjust_bv b2) l))` by (
-        full_simp_tac(srw_ss())[state_rel_def] >>
-        last_x_assum(qspec_then`n`mp_tac) >>
-        simp[] )
-    \\ simp[]
-    \\ IF_CASES_TAC >> full_simp_tac(srw_ss())[] >> full_simp_tac(srw_ss())[]
-    \\ `Num i < LENGTH l` by METIS_TAC[integerTheory.INT_OF_NUM,integerTheory.INT_LT]
-    \\ simp[EL_MAP,bvl_to_bvi_id])
   \\ Cases_on `op = Update` \\ fs [] THEN1
    (Cases_on `REVERSE a` \\ full_simp_tac(srw_ss())[]
     \\ Cases_on `t` \\ full_simp_tac(srw_ss())[]
diff --git a/compiler/backend/proofs/clos_knownProofScript.sml b/compiler/backend/proofs/clos_knownProofScript.sml
index a4f2bffab2..c600f181b9 100644
--- a/compiler/backend/proofs/clos_knownProofScript.sml
+++ b/compiler/backend/proofs/clos_knownProofScript.sml
@@ -757,7 +757,10 @@ Proof
     irule EVERY_DROP >>
     simp []
     >- intLib.ARITH_TAC)
-  >- (simp[PULL_FORALL] >> metis_tac[EVERY_MEM, MEM_EL])
+  >- (simp[PULL_FORALL] \\ rw []
+      \\ fs [ssgc_free_def] \\ res_tac
+      \\ imp_res_tac integerTheory.NUM_POSINT_EXISTS \\ rveq \\ fs []
+      \\ fs [EVERY_EL] \\ rw [] \\ res_tac \\ fs [])
   >- (simp[ssgc_free_def] >>
       rpt (disch_then strip_assume_tac ORELSE gen_tac) >> rpt conj_tac
       >- first_assum MATCH_ACCEPT_TAC >> fs[] >>
@@ -789,9 +792,6 @@ Proof
   >- (rw [] \\ rpt (pop_assum kall_tac)
       \\ Induct_on `bs` \\ fs [list_to_v_def])
   >- (dsimp[ssgc_free_def, FLOOKUP_UPDATE, bool_case_eq] >> metis_tac[])
-  >- (dsimp[ssgc_free_def] >>
-      metis_tac[MEM_EL, EVERY_MEM, integerTheory.INT_INJ,
-                integerTheory.INT_OF_NUM, integerTheory.INT_LT])
   >- (dsimp[ssgc_free_def, FLOOKUP_UPDATE, bool_case_eq] >>
       rpt strip_tac
       >- metis_tac[]
diff --git a/compiler/backend/proofs/clos_mtiProofScript.sml b/compiler/backend/proofs/clos_mtiProofScript.sml
index 02f3b1fd52..adde75e489 100644
--- a/compiler/backend/proofs/clos_mtiProofScript.sml
+++ b/compiler/backend/proofs/clos_mtiProofScript.sml
@@ -12,92 +12,14 @@ fun bring_fwd_ctors th ty = map ((fn s=> Parse.bring_to_front_overload s {Name =
 
 val _ = bring_fwd_ctors "closLang" ``:closLang$exp``
 
-(* well-formed syntax *)
-
-val closLang_exp_size_lemma = prove(
-  ``!funs. MEM (p_1,p_2) funs ==> closLang$exp_size p_2 < exp3_size (MAP SND funs)``,
-  Induct \\ fs [closLangTheory.exp_size_def,FORALL_PROD]
-  \\ rw [] \\ fs []);
-
-val syntax_ok_def = tDefine "syntax_ok" `
-  (syntax_ok [] <=> T) ∧
-  (syntax_ok (e1::e2::es) <=>
-    syntax_ok [e1] /\
-    syntax_ok (e2::es)) /\
-  (syntax_ok [Var t n] = T) ∧
-  (syntax_ok [If t e1 e2 e3] <=>
-    syntax_ok [e1] /\
-    syntax_ok [e2] /\
-    syntax_ok [e3]) ∧
-  (syntax_ok [Let t es e] <=>
-    syntax_ok es /\
-    syntax_ok [e]) ∧
-  (syntax_ok [Raise t e] <=>
-    syntax_ok [e]) ∧
-  (syntax_ok [Handle t e1 e2] <=>
-    syntax_ok [e1] /\
-    syntax_ok [e2]) ∧
-  (syntax_ok [Tick t e] <=>
-    syntax_ok [e]) ∧
-  (syntax_ok [Call t ticks n es] = F) /\
-  (syntax_ok [App t opt e es] <=>
-    LENGTH es = 1 /\ opt = NONE /\
-    syntax_ok es /\
-    syntax_ok [e]) ∧
-  (syntax_ok [Fn t opt1 opt2 num_args e] <=>
-    num_args = 1 /\ opt1 = NONE /\ opt2 = NONE /\
-    syntax_ok [e]) /\
-  (syntax_ok [Letrec t opt1 opt2 funs e] <=>
-    syntax_ok [e] /\ opt1 = NONE /\ opt2 = NONE /\
-    EVERY (\x. FST x = 1 /\ syntax_ok [SND x]) funs) ∧
-  (syntax_ok [Op t op es] <=>
-    syntax_ok es)`
-  (WF_REL_TAC `measure exp3_size` \\ rw []
-   \\ imp_res_tac closLang_exp_size_lemma \\ fs []);
-
-Theorem syntax_ok_cons:
-   syntax_ok (x::xs) <=> syntax_ok [x] /\ syntax_ok xs
-Proof
-  Cases_on `xs` \\ fs [syntax_ok_def]
-QED
-
-Theorem syntax_ok_append[simp]:
-   !xs ys. syntax_ok (xs ++ ys) <=> syntax_ok xs /\ syntax_ok ys
-Proof
-  Induct \\ fs [syntax_ok_def]
-  \\ once_rewrite_tac [syntax_ok_cons]
-  \\ fs [syntax_ok_def] \\ rw [] \\ eq_tac \\ rw[]
-QED
-
-Theorem syntax_ok_REVERSE[simp]:
-   !xs. syntax_ok (REVERSE xs) <=> syntax_ok xs
-Proof
-  ho_match_mp_tac (theorem "syntax_ok_ind")
-  \\ rw [syntax_ok_def]
-  \\ metis_tac []
-QED
-
-Theorem syntax_ok_MAP:
-   !xs. (!x. MEM x xs ==> syntax_ok [f x]) ==> syntax_ok (MAP f xs)
-Proof
-  Induct
-  \\ rw [syntax_ok_def]
-  \\ rw [Once syntax_ok_cons]
-QED
-
-Theorem syntax_ok_REPLICATE:
-   syntax_ok [x] ==> syntax_ok (REPLICATE n x)
-Proof
-  Induct_on `n`
-  \\ rw [syntax_ok_def]
-  \\ rw [Once syntax_ok_cons]
-QED
-
 (* code relation *)
 
+Theorem no_mti_def = closPropsTheory.no_mti_def
+    |> CONV_RULE (DEPTH_CONV ETA_CONV)
+
 val code_rel_def = Define `
   code_rel max_app e1 e2 <=>
-    syntax_ok e1 /\ (e2 = intro_multi max_app e1)`
+    EVERY no_mti e1 /\ (e2 = intro_multi max_app e1)`
 
 Theorem code_rel_IMP_LENGTH:
    code_rel max_app xs ys ==> LENGTH ys = LENGTH xs
@@ -122,7 +44,7 @@ Theorem code_rel_CONS_CONS:
    code_rel m (x1::x2::xs) (y1::y2::ys) <=>
     code_rel m [x1] [y1] /\ code_rel m (x2::xs) (y2::ys)
 Proof
-  fs [code_rel_def,syntax_ok_def,intro_multi_def]
+  fs [code_rel_def,intro_multi_def]
   \\ `?t1. intro_multi m [x1] = [t1]` by metis_tac [intro_multi_sing]
   \\ `?t2. intro_multi m [x2] = [t2]` by metis_tac [intro_multi_sing]
   \\ fs [] \\ eq_tac \\ rw []
@@ -139,7 +61,7 @@ val mk_Fns_def = Define `
 val f_rel_def = Define `
   f_rel max_app (a1,e1) (a2,e2) <=>
     ?b1 ts.
-      code_rel max_app [b1] [e2] /\ a2 <= max_app /\ syntax_ok [b1] /\
+      code_rel max_app [b1] [e2] /\ a2 <= max_app /\ no_mti b1 /\
       a1 = 1n /\ e1 = mk_Fns ts b1 /\ a2 = LENGTH ts + 1`
 
 Inductive v_rel:
@@ -212,7 +134,7 @@ QED
 val state_rel_def = Define `
   state_rel (s:('c,'ffi) closSem$state) (t:('c,'ffi) closSem$state) <=>
     (!n. SND (SND (s.compile_oracle n)) = [] /\
-         syntax_ok (FST (SND (s.compile_oracle n)))) /\
+         EVERY no_mti (FST (SND (s.compile_oracle n)))) /\
     s.code = FEMPTY /\ t.code = FEMPTY /\
     t.max_app = s.max_app /\ 1 <= s.max_app /\
     t.clock = s.clock /\
@@ -237,9 +159,8 @@ QED
 
 Theorem collect_args_ok_IMP:
    !max_app k e num_args e2.
-      collect_args max_app k e = (num_args,e2) /\ syntax_ok [e] ==>
-      ?ts. e = mk_Fns ts e2 ∧ num_args = k + LENGTH ts /\
-           syntax_ok [e2]
+      collect_args max_app k e = (num_args,e2) /\ no_mti e ==>
+      ?ts. e = mk_Fns ts e2 ∧ num_args = k + LENGTH ts /\ no_mti e2
 Proof
   recInduct collect_args_ind
   \\ rw [] \\ fs []
@@ -250,7 +171,7 @@ Proof
   \\ TRY (fs [collect_args_def] \\ rveq
           \\ qexists_tac `[]` \\ fs [mk_Fns_def] \\ NO_TAC)
   \\ first_x_assum drule
-  \\ fs [syntax_ok_def] \\ rveq
+  \\ fs [no_mti_def] \\ rveq
   \\ strip_tac \\ fs [] \\ rveq
   \\ qexists_tac `t::ts` \\ fs [mk_Fns_def]
 QED
@@ -304,27 +225,28 @@ val mk_Apps_def = Define `
   mk_Apps e [] = e /\
   mk_Apps e ((t,other)::ts) = App t NONE (mk_Apps e ts) [other]`
 
-Theorem collect_apps_IMP_mk_Apps = Q.prove(`
-  !es max_app (acc:closLang$exp list) e other e3.
-      collect_apps max_app [] e = (other,e3) /\ syntax_ok es /\ es = [e] ==>
+Theorem collect_apps_IMP_mk_Apps:
+  !e max_app (acc:closLang$exp list) other e3.
+      collect_apps max_app [] e = (other,e3) /\ no_mti e ==>
       ?ts. e = mk_Apps e3 (ZIP (ts, other)) /\ LENGTH other = LENGTH ts /\
-           LENGTH other <= max_app`,
-  recInduct (theorem "syntax_ok_ind") \\ fs [] \\ rw []
+           LENGTH other <= max_app
+Proof
+  Induct \\ fs [] \\ rw []
   \\ fs [collect_apps_def] \\ rveq
   \\ TRY (qexists_tac `[]` \\ fs [mk_Apps_def]
           \\ FULL_CASE_TAC \\ fs [] \\ rveq \\ fs [mk_Apps_def] \\ NO_TAC)
-  \\ fs [syntax_ok_def] \\ rveq
+  \\ fs [no_mti_def] \\ rveq
   \\ fs [collect_apps_def] \\ rveq
   \\ FULL_CASE_TAC \\ fs [] \\ rveq
   \\ TRY (qexists_tac `[]` \\ fs [mk_Apps_def] \\ NO_TAC)
-  \\ fs [syntax_ok_def]
-  \\ Cases_on `es` \\ fs [] \\ rveq
+  \\ fs [no_mti_def]
   \\ imp_res_tac collect_apps_acc \\ rveq \\ fs []
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_1] \\ rveq \\ fs []
   \\ drule (GEN_ALL collect_apps_cons) \\ fs []
   \\ strip_tac \\ first_x_assum drule
   \\ strip_tac \\ rveq \\ fs []
-  \\ qexists_tac `t::ts` \\ fs [ZIP,mk_Apps_def])
-  |> SIMP_RULE std_ss [];
+  \\ qexists_tac `t::ts` \\ fs [ZIP,mk_Apps_def]
+QED
 
 val mk_Apps_err_1 = prove(
   ``∀ts other env1 s1 e3.
@@ -352,15 +274,15 @@ val mk_Apps_err_2 = prove(
   \\ rveq \\ fs [] \\ fs [evaluate_def]
   \\ imp_res_tac evaluate_SING \\ rveq \\ fs []);
 
-Theorem collect_apps_syntax_ok:
+Theorem collect_apps_no_mti:
    !k aux e res e1.
       collect_apps k aux e = (res,e1) /\
-      syntax_ok [e] /\ syntax_ok aux ==>
-      syntax_ok res /\ syntax_ok [e1]
+      no_mti e /\ EVERY no_mti aux ==>
+      EVERY no_mti res /\ no_mti e1
 Proof
   recInduct collect_apps_ind
   \\ rw [collect_apps_def] \\ fs []
-  \\ fs [syntax_ok_def]
+  \\ fs [no_mti_def, ETA_THM]
 QED
 
 val evaluate_mk_Apps_err = prove(
@@ -676,7 +598,7 @@ Proof
   THEN1 (* Var *)
    (Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs []
     \\ fs [evaluate_def]
     \\ imp_res_tac LIST_REL_LENGTH \\ fs []
@@ -685,7 +607,7 @@ Proof
   THEN1 (* If *)
    (Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs []
     \\ reverse (fs [evaluate_def,case_eq_thms,pair_case_eq] \\ rveq)
     \\ fs [HD_intro_multi]
@@ -714,7 +636,7 @@ Proof
   THEN1 (* Let *)
    (Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs [evaluate_def,HD_intro_multi]
     \\ reverse (fs [evaluate_def,case_eq_thms,pair_case_eq] \\ rveq)
     \\ first_x_assum drule \\ fs []
@@ -728,7 +650,7 @@ Proof
   THEN1 (* Raise *)
    (Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs []
     \\ fs [evaluate_def,case_eq_thms,pair_case_eq] \\ rveq
     \\ fs [HD_intro_multi]
@@ -740,7 +662,7 @@ Proof
   THEN1 (* Handle *)
    (Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs [evaluate_def,HD_intro_multi]
     \\ reverse (fs [evaluate_def,case_eq_thms,pair_case_eq] \\ rveq)
     \\ first_x_assum drule \\ fs []
@@ -753,7 +675,7 @@ Proof
   THEN1 (* Op *)
    (Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs [evaluate_def,HD_intro_multi]
     \\ reverse (fs [evaluate_def,case_eq_thms,pair_case_eq] \\ rveq)
     \\ first_x_assum drule
@@ -795,7 +717,7 @@ Proof
   THEN1 (* Fn *)
    (Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs [] \\ rveq
     \\ `1 <= s1.max_app` by fs [state_rel_def]
     \\ fs [evaluate_def]
@@ -809,7 +731,7 @@ Proof
   THEN1 (* Letrec *)
    (Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs [] \\ rveq \\ fs []
     \\ fs [evaluate_def]
     \\ reverse IF_CASES_TAC
@@ -843,15 +765,14 @@ Proof
   THEN1 (* App *)
    (Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs [] \\ rveq \\ fs []
     \\ fs [intro_multi_length]
     \\ fs [DECIDE ``n > 0n <=> n <> 0``]
     \\ imp_res_tac collect_apps_acc \\ rveq
     \\ `?x. l = [x]` by (Cases_on `l` \\ fs [] \\ Cases_on `t`) \\ rveq \\ fs []
-    \\ `syntax_ok other /\ syntax_ok (x::other) /\ syntax_ok [e']` by
-     (drule collect_apps_syntax_ok \\ fs []
-      \\ once_rewrite_tac [syntax_ok_cons] \\ fs [])
+    \\ `EVERY no_mti other /\ no_mti x /\ no_mti e'` by
+     (drule collect_apps_no_mti \\ fs [])
     \\ drule collect_apps_cons
     \\ impl_tac THEN1 fs [state_rel_def] \\ strip_tac
     \\ drule collect_apps_IMP_mk_Apps \\ fs []
@@ -899,7 +820,7 @@ Proof
    (`t1.clock = s1.clock` by fs [state_rel_def]
     \\ Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs []
     \\ fs [evaluate_def,case_eq_thms]
     \\ IF_CASES_TAC \\ fs [] \\ rveq \\ fs []
@@ -913,7 +834,7 @@ Proof
   THEN1 (* Call *)
    (Cases_on `xs` \\ fs [] \\ rveq
     \\ Cases_on `h` \\ fs [code_rel_def,intro_multi_def] \\ rveq \\ fs []
-    \\ fs [syntax_ok_def] \\ rveq \\ fs [intro_multi_def]
+    \\ fs [no_mti_def] \\ rveq \\ fs [intro_multi_def]
     \\ TRY pairarg_tac \\ fs [])
   THEN1 (* app NIL *)
    (fs [evaluate_def,evaluate_apps_def] \\ rveq \\ fs [])
@@ -1242,7 +1163,7 @@ QED
 
 Theorem intro_multi_correct:
    !xs env1 (s1:('c,'ffi) closSem$state) res1 s2 env2 t2 t1.
-      evaluate (xs,env1,s1) = (res1,s2) /\ syntax_ok xs /\
+      evaluate (xs,env1,s1) = (res1,s2) /\ EVERY no_mti xs /\
       LIST_REL (v_rel s1.max_app) env1 env2 /\ state_rel s1 t1 ==>
       ?res2 t2.
         evaluate (intro_multi s1.max_app xs,env2,t1) = (res2,t2) /\
@@ -1494,28 +1415,31 @@ Proof
   Cases>>fs[clos_mtiTheory.compile_def,intro_multi_preserves_esgc_free]
 QED
 
+Theorem EVERY_intro_multi:
+  !m xs. EVERY P (intro_multi m xs) = EVERY (\x. P (HD (intro_multi m [x]))) xs
+Proof
+  ho_match_mp_tac intro_multi_ind
+  \\ simp [intro_multi_def]
+  \\ rw []
+  \\ rpt (pairarg_tac \\ fs [])
+QED
+
 Theorem intro_multi_obeys_max_app:
-   !m xs. m ≠ 0 /\ syntax_ok xs ==> EVERY (obeys_max_app m) (intro_multi m xs)
+   !m xs. m ≠ 0 /\ EVERY no_mti xs ==>
+   EVERY (obeys_max_app m) (intro_multi m xs)
 Proof
   ho_match_mp_tac intro_multi_ind \\ rw []
-  \\ fs [intro_multi_def,syntax_ok_def]
-  \\ TRY (pop_assum mp_tac
-    \\ once_rewrite_tac [syntax_ok_cons]
-    \\ strip_tac \\ fs []
-    \\ `∃x.  intro_multi m [e]  = [x]` by fs [intro_multi_sing]
-    \\ `∃x1. intro_multi m [e1] = [x1]` by fs [intro_multi_sing]
-    \\ `∃x2. intro_multi m [e2] = [x2]` by fs [intro_multi_sing]
-    \\ `∃x3. intro_multi m [e3] = [x3]` by fs [intro_multi_sing]
-    \\ fs [] \\ NO_TAC)
-  \\ TRY pairarg_tac \\ fs []
-  \\ fs [intro_multi_length]
+  \\ fs [intro_multi_def,no_mti_def]
+  \\ fs [EVERY_intro_multi]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ fs [EVERY_intro_multi, intro_multi_length]
   THEN1
    (fs [quantHeuristicsTheory.LIST_LENGTH_1] \\ rveq \\ fs []
     \\ imp_res_tac collect_apps_acc \\ rveq \\ fs []
     \\ drule collect_apps_cons \\ fs [] \\ strip_tac
     \\ drule collect_apps_IMP_mk_Apps \\ fs [] \\ strip_tac
     \\ rveq \\ fs []
-    \\ drule collect_apps_syntax_ok \\ fs [syntax_ok_def]
+    \\ drule collect_apps_no_mti \\ fs [no_mti_def]
     \\ `∃x.  intro_multi m [e']  = [x]` by fs [intro_multi_sing] \\ fs [])
   THEN1
    (drule collect_args_ok_IMP \\ fs []
@@ -1579,8 +1503,8 @@ QED
 Theorem semantics_intro_multi:
    semantics (ffi:'ffi ffi_state) max_app FEMPTY
      co (pure_cc (compile_inc max_app) cc) xs <> Fail ==>
-   (∀n. SND (SND (co n)) = [] ∧ syntax_ok (FST (SND (co n)))) ∧
-   1 <= max_app /\ syntax_ok xs ==>
+   (∀n. SND (SND (co n)) = [] ∧ EVERY no_mti (FST (SND (co n)))) ∧
+   1 <= max_app /\ EVERY no_mti xs ==>
    semantics (ffi:'ffi ffi_state) max_app FEMPTY
      (pure_co (compile_inc max_app) ∘ co) cc
      (intro_multi max_app xs) =
@@ -1607,7 +1531,8 @@ Theorem semantics_compile:
    semantics ffi max_app FEMPTY co cc1 xs ≠ Fail ∧
    cc1 = (if do_mti then pure_cc (compile_inc max_app) else I) cc ∧
    co1 = (if do_mti then pure_co (compile_inc max_app) else I) o co ∧
-   (do_mti ⇒ (∀n. SND (SND (co n)) = [] ∧ syntax_ok (FST (SND (co n)))) ∧ 1 ≤ max_app ∧ syntax_ok xs) ⇒
+   (do_mti ⇒ (∀n. SND (SND (co n)) = [] ∧ EVERY no_mti (FST (SND (co n)))) ∧
+        1 ≤ max_app ∧ EVERY no_mti xs) ⇒
    semantics ffi max_app FEMPTY co1 cc (compile do_mti max_app xs) =
    semantics ffi max_app FEMPTY co cc1 xs
 Proof
diff --git a/compiler/backend/proofs/clos_to_bvlProofScript.sml b/compiler/backend/proofs/clos_to_bvlProofScript.sml
index 248784b0e5..1bbbf8e7f6 100644
--- a/compiler/backend/proofs/clos_to_bvlProofScript.sml
+++ b/compiler/backend/proofs/clos_to_bvlProofScript.sml
@@ -17,7 +17,6 @@ open
   clos_annotateProofTheory
   clos_callProofTheory
   clos_fvsProofTheory
-  patSemTheory
 in end
 
 val _ = new_theory"clos_to_bvlProof";
@@ -659,9 +658,11 @@ val evaluate_mk_cl_simpl = Q.prove (
    evaluate ([mk_cl_call (Var 0) (GENLIST (λn. Var (n + 1)) (LENGTH args' − (n + 1)))],
                                v::(args' ++ [Block tag (CodePtr p::Number (&n)::xs)]),
                                st')`,
+
   srw_tac[][mk_cl_call_def, evaluate_def, do_app_def] >>
-  Cases_on `v` >>
+  reverse (Cases_on `v`) >>
   srw_tac[][] >>
+  TRY (Cases_on `FLOOKUP st'.refs n'` \\ fs []) >>
   BasicProvers.FULL_CASE_TAC >>
   srw_tac[][evaluate_APPEND] >>
   ntac 2 (pop_assum (mp_tac o GSYM)) >>
@@ -1454,7 +1455,7 @@ val do_app = Q.prove(
     \\ strip_tac
     \\ `do_eq t1.refs y1 y2 = Eq_val b` by metis_tac [] \\ fs [])
   \\ Cases_on `op = ToListByte` THEN1
-   (fs [] \\ rveq \\ fs [do_app_def,patSemTheory.do_app_def]
+   (fs [] \\ rveq \\ fs [do_app_def]
     \\ Cases_on `xs` \\ fs [closSemTheory.do_app_def,bvlSemTheory.do_app_def]
     \\ Cases_on `h` \\ fs [] \\ Cases_on `t` \\ fs []
     \\ strip_tac \\ rveq \\ fs []
@@ -1485,8 +1486,35 @@ val do_app = Q.prove(
     >- intLib.ARITH_TAC >>
     irule EVERY2_APPEND_suff >>
     simp [] >>
-    metis_tac [EVERY2_TAKE, EVERY2_DROP])
-  >> Cases_on`op`>>fs[]>>srw_tac[][closSemTheory.do_app_def,bvlSemTheory.do_app_def,
+    metis_tac [EVERY2_TAKE, EVERY2_DROP]) >>
+  Cases_on `?l. op = LenEq l`
+  >- (
+    fs [closSemTheory.do_app_def,bvlSemTheory.do_app_def,bvlSemTheory.do_eq_def] >>
+    Cases_on`xs`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
+    Cases_on `h` >> fs []>>
+    Cases_on `t` >> fs []>>
+    rpt strip_tac >> rveq \\ fs [] >>
+    fs[v_rel_SIMP] \\ rw[] >>
+    rveq \\ fs [listTheory.LIST_REL_EL_EQN]) >>
+  Cases_on `op = El`
+  >- (
+    fs [closSemTheory.do_app_def,bvlSemTheory.do_app_def,bvlSemTheory.do_eq_def] >>
+    Cases_on`xs`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
+    Cases_on `h` >> fs []>>
+    Cases_on `t` >> fs []>>
+    Cases_on `h` >> fs []>>
+    Cases_on `t'` >> fs [CaseEq"bool",PULL_EXISTS]>>
+    rpt strip_tac >> rveq \\ fs [] >>
+    fs[v_rel_SIMP] \\ rw[] >>
+    imp_res_tac integerTheory.NUM_POSINT_EXISTS >>
+    rveq \\ fs [listTheory.LIST_REL_EL_EQN] >>
+    every_case_tac >> full_simp_tac(srw_ss())[v_rel_SIMP] >> srw_tac[][v_rel_SIMP] >>
+    full_simp_tac(srw_ss())[state_rel_def] >> res_tac >>
+    full_simp_tac(srw_ss())[v_rel_SIMP] >>
+    srw_tac[][] >> full_simp_tac(srw_ss())[LIST_REL_EL_EQN] >>
+    srw_tac[][]>>full_simp_tac(srw_ss())[] >>
+    first_x_assum match_mp_tac >> intLib.COOPER_TAC) >>
+  Cases_on`op`>>fs[]>>srw_tac[][closSemTheory.do_app_def,bvlSemTheory.do_app_def,
                             bvlSemTheory.do_eq_def]
   >- (
     imp_res_tac state_rel_globals >>
@@ -1558,14 +1586,6 @@ val do_app = Q.prove(
     every_case_tac \\ fs[v_rel_SIMP] \\ rw[]
     \\ full_simp_tac(srw_ss())[state_rel_def] >> res_tac >> full_simp_tac(srw_ss())[v_rel_SIMP] >>
     rw[] \\ fs[LIST_REL_EL_EQN])
-  >- (
-    Cases_on`xs`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
-    Cases_on`t`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
-    Cases_on`h`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
-    rw[v_rel_SIMP] >> fs[LIST_REL_EL_EQN]>>
-    every_case_tac \\ fs[v_rel_SIMP] \\ rw[]
-    \\ full_simp_tac(srw_ss())[state_rel_def] >> res_tac >> full_simp_tac(srw_ss())[v_rel_SIMP] >>
-    rw[] \\ fs[LIST_REL_EL_EQN])
   >- (
     Cases_on`xs`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
     Cases_on`t`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
@@ -1607,18 +1627,6 @@ val do_app = Q.prove(
     \\ Cases_on`h`\\fs[]
     \\ rw[] \\ fs[v_rel_SIMP]
     \\ metis_tac[clos_tag_shift_inj,LIST_REL_LENGTH])
-  >- (
-    Cases_on`xs`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
-    Cases_on`t`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
-    Cases_on`h`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
-    Cases_on`t'`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
-    Cases_on`h'`>>full_simp_tac(srw_ss())[v_rel_SIMP]>>
-    every_case_tac >> full_simp_tac(srw_ss())[v_rel_SIMP] >> srw_tac[][v_rel_SIMP] >>
-    full_simp_tac(srw_ss())[state_rel_def] >> res_tac >>
-    full_simp_tac(srw_ss())[v_rel_SIMP] >>
-    srw_tac[][] >> full_simp_tac(srw_ss())[LIST_REL_EL_EQN] >>
-    srw_tac[][]>>full_simp_tac(srw_ss())[] >>
-    first_x_assum match_mp_tac >> intLib.COOPER_TAC)
   \\ rpt (pop_assum mp_tac)
   \\ rpt (TOP_CASE_TAC \\ fs [])
   \\ full_simp_tac(srw_ss())[v_rel_SIMP] \\ srw_tac[][v_rel_SIMP]
@@ -2269,12 +2277,12 @@ val cl_rel_run_tac =
   srw_tac[][] >>
   metis_tac [list_rel_IMP_env_rel, APPEND_ASSOC, LASTN_LENGTH_ID, env_rel_APPEND, LIST_REL_def, cl_rel_run_lemma3];
 
-val genlist_deref = Q.prove (
+val genlist_el = Q.prove (
   `!skip st r xs args p n env ys.
     FLOOKUP st.refs r = SOME (ValueArray (ys++xs)) ∧
     skip = LENGTH ys
     ⇒
-    bvlSem$evaluate (GENLIST (λi. Op Deref [Op (Const (&(i + skip))) []; Var 0]) (LENGTH xs),
+    bvlSem$evaluate (GENLIST (λi. Op El [Op (Const (&(i + skip))) []; Var 0]) (LENGTH xs),
            RefPtr r:: (args ++ Block closure_tag [CodePtr p; Number (&n); RefPtr r]::env),
            st)
     =
@@ -2306,7 +2314,7 @@ val evaluate_code_for_recc_case = Q.prove (
               by (srw_tac[][] >> intLib.ARITH_TAC) >>
   imp_res_tac evaluate_genlist_vars >>
   full_simp_tac(srw_ss())[] >>
-  mp_tac (Q.SPEC `0` genlist_deref) >>
+  mp_tac (Q.SPEC `0` genlist_el) >>
   simp [LENGTH_NIL_SYM] >>
   srw_tac[][TAKE_LENGTH_APPEND]);
 
@@ -2575,10 +2583,14 @@ val mk_call_simp2 = Q.prove(
   Cases_on `v` >>
   simp [] >>
   srw_tac[][] >>
-  Cases_on`EL 1 l`>>simp[]>>
+  TRY (rename [`FLOOKUP t.refs rrr`] \\ Cases_on `FLOOKUP t.refs rrr` \\ fs []
+       \\ Cases_on `x`\\ fs [] \\ IF_CASES_TAC \\ fs []) >>
+  srw_tac[][] >>
+  Cases_on`EL 1 l`>>simp[do_eq_def]>>
   simp[bEval_APPEND] >>
-  qspecl_then [`0`, `TAKE n args ++ [Block n' l] ++ stuff`, `n`]mp_tac evaluate_genlist_vars >>
-  qspecl_then [`1`, `Block n' l::(args ++ stuff')`, `n`]mp_tac evaluate_genlist_vars >>
+  rename [`TAKE n args ++ [xxx] ++ stuff`] >>
+  qspecl_then [`0`, `TAKE n args ++ [xxx] ++ stuff`, `n`]mp_tac evaluate_genlist_vars >>
+  qspecl_then [`1`, `xxx::(args ++ stuff')`, `n`]mp_tac evaluate_genlist_vars >>
   srw_tac [ARITH_ss] [ETA_THM, bEval_def, bEvalOp_def, el_take_append] >>
   srw_tac[][] >>
   `n+1 ≤ SUC (LENGTH args + LENGTH stuff')` by decide_tac >>
@@ -6570,8 +6582,8 @@ Theorem semantics_cond_mti_compile_inc:
         (pure_cc (cond_mti_compile_inc do_mti max_app) cc) xs ≠ Fail ∧
     (do_mti ⇒
          (∀n. SND (SND (co n)) = [] ∧
-             clos_mtiProof$syntax_ok (FST (SND (co n)))) ∧
-             1 <= max_app ∧ clos_mtiProof$syntax_ok xs) ⇒
+             EVERY no_mti (FST (SND (co n)))) ∧
+             1 <= max_app ∧ EVERY no_mti xs) ⇒
      semantics ffi max_app FEMPTY
          (pure_co (cond_mti_compile_inc do_mti max_app) o co) cc
          (compile do_mti max_app xs) =
@@ -6966,8 +6978,8 @@ Theorem compile_common_semantics:
     (compile_common_inc c cc) es1 ≠ Fail ∧
    compile_common c es1 = (c', code2) ∧
    (∀n. SND (SND (co1 n)) = []) ∧
-   (c.do_mti ⇒ 1 ≤ c.max_app ∧ clos_mtiProof$syntax_ok es1 ∧
-     (∀n. clos_mtiProof$syntax_ok (FST(SND(co1 n))))) ∧
+   (c.do_mti ⇒ 1 ≤ c.max_app ∧ EVERY no_mti es1 ∧
+     (∀n. EVERY no_mti (FST(SND(co1 n))))) ∧
    (c.do_call ⇒ every_Fn_vs_NONE es1 /\
        is_state_oracle clos_callProof$compile_inc
            (clos_knownProof$known_co c.known_conf
@@ -7213,8 +7225,8 @@ QED
 val syntax_oracle_ok_def = Define`
   syntax_oracle_ok c c' es co ⇔
    (∀n. SND (SND (co n)) = []) ∧
-   (c.do_mti ⇒ 1 ≤ c.max_app ∧ clos_mtiProof$syntax_ok es ∧
-     (∀n. clos_mtiProof$syntax_ok (FST(SND(co n))))) ∧
+   (c.do_mti ⇒ 1 ≤ c.max_app ∧ EVERY no_mti es ∧
+     (∀n. EVERY no_mti (FST(SND(co n))))) ∧
    (?v. FST (co 0) = (c'.next_loc,
        clos_knownProof$option_val_approx_spt c'.known_conf, FST c'.call_state, v)) ∧
    (c.do_call ⇒ every_Fn_vs_NONE es ∧
diff --git a/compiler/backend/proofs/data_to_word_assignProofScript.sml b/compiler/backend/proofs/data_to_word_assignProofScript.sml
index 42e634d5f6..db8aff4651 100644
--- a/compiler/backend/proofs/data_to_word_assignProofScript.sml
+++ b/compiler/backend/proofs/data_to_word_assignProofScript.sml
@@ -6513,6 +6513,129 @@ Proof
   \\ TRY (match_mp_tac memory_rel_Boolv_F) \\ fs []
 QED
 
+Theorem all_ones_get_addr:
+  all_ones (c.len_bits + (c.tag_bits + 1)) 0 &&
+  get_addr c ptr (Word (ptr_bits c tag2 len2)) =
+  ptr_bits c tag2 len2 || 1w
+Proof
+  fs [get_addr_def,get_lowerbits_def,small_shift_length_def]
+  \\ fs [WORD_LEFT_AND_OVER_OR]
+  \\ `1w && all_ones (c.len_bits + (c.tag_bits + 1)) 0 = 1w` by
+   (fs [fcpTheory.CART_EQ,fcpTheory.FCP_BETA,word_and_def,word_slice_def]
+    \\ once_rewrite_tac [n2w_def]
+    \\ fs [fcpTheory.CART_EQ,fcpTheory.FCP_BETA,word_and_def,word_slice_def]
+    \\ rw[] \\ eq_tac \\ rw []
+    \\ asm_simp_tac std_ss [all_ones_def,word_slice_def,
+          fcpTheory.FCP_BETA,word_1comp_def,n2w_def] \\ fs [])
+  \\ fs [] \\ pop_assum kall_tac
+  \\ `all_ones (c.len_bits + (c.tag_bits + 1)) 0 && n2w ptr ≪ shift_length c = 0w` by
+   (fs [fcpTheory.CART_EQ,fcpTheory.FCP_BETA,word_and_def,n2w_def,word_lsl_def]
+    \\ rw [] \\ CCONTR_TAC \\ fs []
+    \\ imp_res_tac all_ones_bit \\ fs [shift_length_def])
+  \\ fs [] \\ pop_assum kall_tac
+  \\ `all_ones (c.len_bits + (c.tag_bits + 1)) 0 &&
+        (c.len_bits + c.tag_bits -- 0) (ptr_bits c tag2 len2) =
+      (c.len_bits + c.tag_bits -- 0) (ptr_bits c tag2 len2)` by
+   (fs [fcpTheory.CART_EQ,fcpTheory.FCP_BETA,word_and_def,n2w_def,word_lsl_def,
+        all_ones_bit,word_bits_def]
+    \\ rw [] \\ eq_tac \\ rw [])
+  \\ fs []
+  \\ qsuff_tac `(c.len_bits + c.tag_bits -- 0) (ptr_bits c tag2 len2) =
+                (ptr_bits c tag2 len2):'a word` \\ fs []
+  \\ fs [ptr_bits_def]
+  \\ fs [fcpTheory.CART_EQ,word_bits_def,fcpTheory.FCP_BETA,word_or_def]
+  \\ rw [] \\ eq_tac \\ rw []
+  \\ imp_res_tac maxout_bits_bit \\ fs []
+QED
+
+Theorem MULT_TWO_EXP_LESS_dimword:
+  !b  l n.
+    b + l <= dimindex (:α) /\ n < 2 ** b ==>
+    n * 2 ** l < dimword (:α)
+Proof
+  rw []
+  \\ match_mp_tac LESS_LESS_EQ_TRANS
+  \\ qexists_tac `2 ** (b + l)`
+  \\ reverse conj_tac
+  THEN1 fs [dimword_def]
+  \\ rewrite_tac [EXP_ADD] \\ fs []
+QED
+
+Theorem maxout_bits_eq:
+  b + l <= dimindex (:'a) /\ n' < 2 ** b - 1 ==>
+  (maxout_bits n b l = (maxout_bits n' b l:'a word) <=> n = n')
+Proof
+  Cases_on `n = n'` \\ fs [] \\ strip_tac
+  \\ `(n' * 2 ** l) < dimword (:α)` by
+   (match_mp_tac MULT_TWO_EXP_LESS_dimword
+    \\ asm_exists_tac \\ fs [])
+  \\ fs [maxout_bits_def] \\ rw []
+  \\ fs [WORD_MUL_LSL,word_mul_n2w,all_ones_n2w]
+  THEN1
+   (qsuff_tac `(n * 2 ** l) < dimword (:α)` \\ fs []
+    \\ match_mp_tac MULT_TWO_EXP_LESS_dimword
+    \\ asm_exists_tac \\ fs [])
+  \\ qsuff_tac `((2 ** b - 1) * 2 ** l) < dimword (:α)` \\ fs []
+  \\ match_mp_tac MULT_TWO_EXP_LESS_dimword
+  \\ asm_exists_tac \\ fs []
+QED
+
+Theorem word_or_eq_word_or_split:
+  w1 && w2 = 0w /\ v1 && v2 = 0w /\
+  w1 && v2 = 0w /\ v1 && w2 = 0w ==>
+  ((w1 ‖ w2 = v1 ‖ v2) ⇔  (w1 = v1 ∧ w2 = v2))
+Proof
+  fs [fcpTheory.CART_EQ,word_or_def,word_and_def,word_0,fcpTheory.FCP_BETA]
+  \\ metis_tac []
+QED
+
+Theorem ptr_bits_eq_ptr_bits:
+  tag < 2 ** c.tag_bits - 1 /\
+  len < 2 ** c.len_bits - 1 /\
+  c.len_bits + c.tag_bits < dimindex (:'a) ==>
+  ((ptr_bits c tag2 len2 ‖ 1w =
+    ptr_bits c tag len ‖ (1w:'a word)) <=>
+   (tag2 = tag /\ len2 = len))
+Proof
+  rewrite_tac [ptr_bits_or_1_add_1]
+  \\ simp [ptr_bits_def] \\ rw []
+  \\ qmatch_goalsub_abbrev_tac `w1 || w2 = v1 || v2`
+  \\ match_mp_tac EQ_TRANS
+  \\ qexists_tac `w1 = v1 /\ w2 = v2`
+  \\ conj_tac
+  THEN1
+   (match_mp_tac word_or_eq_word_or_split
+    \\ unabbrev_all_tac
+    \\ simp_tac std_ss [fcpTheory.CART_EQ,word_0,word_and_def,fcpTheory.FCP_BETA]
+    \\ rw [] \\ CCONTR_TAC \\ fs []
+    \\ imp_res_tac maxout_bits_bit \\ fs [])
+  \\ qsuff_tac `(w1 = v1 <=> len2 = len) /\ (w2 = v2 <=> tag2 = tag)`
+  THEN1 fs []
+  \\ unabbrev_all_tac
+  \\ fs [maxout_bits_eq]
+QED
+
+Theorem maxout_bits_0:
+  maxout_bits 0 b e = 0w
+Proof
+  fs [maxout_bits_def] \\ rw []
+  \\ Cases_on `b` \\ fs []
+  \\ fs [all_ones_def,EXP]
+  \\ Cases_on `2 ** n` \\ fs []
+QED
+
+Theorem ptr_bits_eq_ptr_bits_len_only:
+  len < 2 ** c.len_bits - 1 /\
+  c.len_bits < dimindex (:'a) ==>
+  ((ptr_bits c 0 len2 ‖ 1w =
+    ptr_bits c 0 len ‖ (1w:'a word)) <=>
+   (len2 = len))
+Proof
+  rewrite_tac [ptr_bits_or_1_add_1]
+  \\ simp [ptr_bits_def] \\ rw [maxout_bits_0]
+  \\ fs [maxout_bits_eq]
+QED
+
 Theorem assign_TagLenEq:
    (?tag len. op = TagLenEq tag len) ==> ^assign_thm_goal
 Proof
@@ -6535,7 +6658,7 @@ Proof
   \\ rpt_drule0 (memory_rel_get_vars_IMP |> GEN_ALL)
   \\ strip_tac \\ fs []
   \\ fs [assign_def] \\ IF_CASES_TAC \\ fs [] \\ clean_tac
-  THEN1
+  THEN1 (* len = 0 case *)
    (reverse IF_CASES_TAC
     \\ fs [LENGTH_NIL]
     \\ imp_res_tac get_vars_1_imp \\ eval_tac
@@ -6554,6 +6677,37 @@ Proof
     \\ match_mp_tac memory_rel_insert \\ fs []
     \\ TRY (match_mp_tac memory_rel_Boolv_F) \\ fs []
     \\ TRY (match_mp_tac memory_rel_Boolv_T) \\ fs [])
+  \\ IF_CASES_TAC
+  THEN1 (* tag < 2 ** tag_bits - 1 /\ len < 2 ** len_bits - 1 *)
+   (`c.len_bits + c.tag_bits < dimindex (:'a)` by
+         fs [memory_rel_def,heap_in_memory_store_def,shift_length_def]
+    \\ rpt_drule0 memory_rel_Block_IMP \\ strip_tac \\ fs []
+    \\ imp_res_tac get_vars_1_imp \\ eval_tac
+    \\ fs [wordSemTheory.get_var_def,wordSemTheory.get_var_imm_def,
+           asmTheory.word_cmp_def]
+    \\ rename [`Boolv (tag2 = tag ∧ LENGTH len2 = len)`]
+    \\ qmatch_goalsub_abbrev_tac `COND ggg`
+    \\ qsuff_tac `(tag2 = tag ∧ LENGTH len2 = len) = ggg` THEN1
+     (strip_tac \\ asm_rewrite_tac [] \\ ntac 2 (pop_assum kall_tac)
+      \\ Cases_on `ggg` \\ fs []
+      \\ fs [lookup_insert,adjust_var_11] \\ rw [] \\ fs [option_le_max_right]
+      \\ fs [inter_insert_ODD_adjust_set]
+      \\ full_simp_tac std_ss [GSYM APPEND_ASSOC]
+      \\ match_mp_tac memory_rel_insert \\ fs []
+      \\ TRY (match_mp_tac memory_rel_Boolv_F) \\ fs []
+      \\ TRY (match_mp_tac memory_rel_Boolv_T) \\ fs [])
+    \\ Cases_on `len2 = []` \\ fs [] THEN1
+     (fs [Abbr`ggg`] \\ fs [fcpTheory.CART_EQ,word_and_def,fcpTheory.FCP_BETA]
+      \\ qexists_tac `0` \\ fs [] \\ rveq \\ fs []
+      \\ first_x_assum (qspec_then `0` assume_tac) \\ fs [fcpTheory.FCP_BETA]
+      \\ fs [word_or_def,fcpTheory.FCP_BETA,n2w_def])
+    \\ fs [memory_rel_def,word_ml_inv_def,abs_ml_inv_def,bc_stack_ref_inv_def]
+    \\ rveq \\ fs [v_inv_def] \\ rveq \\ fs [word_addr_def]
+    \\ rveq \\ fs []
+    \\ `LENGTH xs' = LENGTH len2` by (imp_res_tac LIST_REL_LENGTH \\ fs []) \\ fs []
+    \\ simp [Abbr`ggg`]
+    \\ fs [all_ones_get_addr,ptr_bits_eq_ptr_bits])
+  \\ pop_assum kall_tac
   \\ CASE_TAC \\ fs [] THEN1
    (eval_tac \\ fs [lookup_insert,adjust_var_11] \\ rw [] \\ fs [option_le_max_right]
     \\ full_simp_tac std_ss [GSYM APPEND_ASSOC]
@@ -6591,6 +6745,143 @@ Proof
   \\ TRY (match_mp_tac memory_rel_Boolv_T) \\ fs []
 QED
 
+Theorem all_ones_and_1:
+  k <> 0 ==> all_ones k 0 && 1w = 1w
+Proof
+  fs [fcpTheory.CART_EQ,word_and_def,n2w_def,fcpTheory.FCP_BETA,all_ones_bit]
+QED
+
+Theorem all_ones_and_ptr_bits_tag_0:
+  all_ones (c.len_bits + 1) 0 && ptr_bits c tag len = ptr_bits c 0 len
+Proof
+  fs [ptr_bits_def,maxout_bits_0]
+  \\ fs [fcpTheory.CART_EQ,word_and_def,n2w_def,fcpTheory.FCP_BETA,all_ones_bit,
+         word_or_def] \\ rw [] \\ eq_tac \\ rw []
+  \\ imp_res_tac maxout_bits_bit \\ fs []
+QED
+
+Theorem assign_LenEq:
+   (?len. op = LenEq len) ==> ^assign_thm_goal
+Proof
+  rpt strip_tac \\ drule0 (evaluate_GiveUp |> GEN_ALL) \\ rw [] \\ fs []
+  \\ `t.termdep <> 0` by fs[]
+  \\ rpt_drule0 state_rel_cut_IMP
+  \\ qpat_x_assum `state_rel c l1 l2 s t [] locs` kall_tac \\ strip_tac
+  \\ imp_res_tac get_vars_IMP_LENGTH \\ fs [] \\ rw []
+  \\ fs [do_app,allowed_op_def] \\ rfs [] \\ every_case_tac \\ fs []
+  \\ clean_tac \\ fs []
+  \\ imp_res_tac state_rel_get_vars_IMP
+  \\ fs [Boolv_def] \\ rveq
+  \\ fs [GSYM Boolv_def] \\ rveq
+  \\ fs [LENGTH_EQ_1] \\ clean_tac
+  \\ fs [LENGTH_EQ_1] \\ clean_tac
+  \\ qpat_x_assum `state_rel c l1 l2 x t [] locs` (fn th => NTAC 2 (mp_tac th))
+  \\ strip_tac
+  \\ simp_tac std_ss [state_rel_thm] \\ strip_tac \\ fs [] \\ eval_tac
+  \\ full_simp_tac std_ss [GSYM APPEND_ASSOC]
+  \\ rpt_drule0 (memory_rel_get_vars_IMP |> GEN_ALL)
+  \\ strip_tac \\ fs []
+  \\ fs [assign_def] \\ IF_CASES_TAC \\ fs [] \\ clean_tac
+  THEN1 (* len = 0 case *)
+   (imp_res_tac get_vars_1_imp \\ eval_tac
+    \\ fs [wordSemTheory.get_var_imm_def,asmTheory.word_cmp_def]
+    \\ rpt_drule0 memory_rel_Block_IMP \\ strip_tac \\ fs []
+    \\ fs [word_index_0] \\ IF_CASES_TAC \\ fs []
+    \\ fs [lookup_insert,adjust_var_11] \\ rw [] \\ fs [option_le_max_right]
+    \\ full_simp_tac std_ss [GSYM APPEND_ASSOC]
+    \\ match_mp_tac memory_rel_insert \\ fs []
+    \\ TRY (match_mp_tac memory_rel_Boolv_F) \\ fs []
+    \\ TRY (match_mp_tac memory_rel_Boolv_T) \\ fs [])
+  \\ IF_CASES_TAC
+  THEN1 (* len < 2 ** len_bits - 1 *)
+   (`c.len_bits < dimindex (:'a)` by
+         fs [memory_rel_def,heap_in_memory_store_def,shift_length_def]
+    \\ rpt_drule0 memory_rel_Block_IMP \\ strip_tac \\ fs []
+    \\ imp_res_tac get_vars_1_imp \\ eval_tac
+    \\ fs [wordSemTheory.get_var_def,wordSemTheory.get_var_imm_def,
+           asmTheory.word_cmp_def]
+    \\ rename [`Boolv (LENGTH len2 = len)`]
+    \\ qmatch_goalsub_abbrev_tac `COND ggg`
+    \\ qsuff_tac `(LENGTH len2 = len) = ggg` THEN1
+     (strip_tac \\ asm_rewrite_tac [] \\ ntac 2 (pop_assum kall_tac)
+      \\ Cases_on `ggg` \\ fs []
+      \\ fs [lookup_insert,adjust_var_11] \\ rw [] \\ fs [option_le_max_right]
+      \\ fs [inter_insert_ODD_adjust_set]
+      \\ full_simp_tac std_ss [GSYM APPEND_ASSOC]
+      \\ match_mp_tac memory_rel_insert \\ fs []
+      \\ TRY (match_mp_tac memory_rel_Boolv_F) \\ fs []
+      \\ TRY (match_mp_tac memory_rel_Boolv_T) \\ fs [])
+    \\ Cases_on `len2 = []` \\ fs [] THEN1
+     (fs [Abbr`ggg`] \\ fs [fcpTheory.CART_EQ,word_and_def,fcpTheory.FCP_BETA]
+      \\ qexists_tac `0` \\ fs [] \\ rveq \\ fs []
+      \\ first_x_assum (qspec_then `0` assume_tac) \\ fs [fcpTheory.FCP_BETA]
+      \\ fs [word_or_def,fcpTheory.FCP_BETA,n2w_def])
+    \\ fs [memory_rel_def,word_ml_inv_def,abs_ml_inv_def,bc_stack_ref_inv_def]
+    \\ rveq \\ fs [v_inv_def] \\ rveq \\ fs [word_addr_def]
+    \\ rveq \\ fs []
+    \\ `LENGTH xs' = LENGTH len2` by (imp_res_tac LIST_REL_LENGTH \\ fs []) \\ fs []
+    \\ simp [Abbr`ggg`]
+    \\ qmatch_goalsub_abbrev_tac `_ && ww`
+    \\ `all_ones (c.len_bits + 1) 0 =
+        all_ones (c.len_bits + 1) 0 && all_ones (c.len_bits + (c.tag_bits + 1)) 0` by
+           fs [fcpTheory.CART_EQ,word_and_def,fcpTheory.FCP_BETA,all_ones_bit]
+    \\ pop_assum (fn th => once_rewrite_tac [th])
+    \\ rewrite_tac [WORD_AND_ASSOC]
+    \\ qunabbrev_tac `ww`
+    \\ rewrite_tac [all_ones_get_addr,WORD_LEFT_AND_OVER_OR]
+    \\ simp [all_ones_and_1,all_ones_and_ptr_bits_tag_0]
+    \\ fs [ptr_bits_eq_ptr_bits_len_only])
+  \\ pop_assum kall_tac
+  \\ imp_res_tac get_vars_1_imp \\ eval_tac
+  \\ rpt_drule0 memory_rel_Block_IMP \\ strip_tac \\ fs [word_index_0]
+  \\ rename [`COND (payload = [])`]
+  \\ reverse IF_CASES_TAC THEN1
+   (`LENGTH payload < dimword (:'a)` by
+      (FULL_CASE_TAC \\ fs []
+       \\ match_mp_tac LESS_LESS_EQ_TRANS
+       \\ asm_exists_tac \\ fs [] \\ fs [dimword_def])
+    \\ `LENGTH payload <> len` by (CCONTR_TAC \\ fs [])
+    \\ eval_tac \\ fs [wordSemTheory.get_var_imm_def]
+    \\ fs [inter_insert_ODD_adjust_set]
+    \\ fs [lookup_insert,adjust_var_11] \\ rw [] \\ fs [option_le_max_right]
+    \\ full_simp_tac std_ss [GSYM APPEND_ASSOC]
+    \\ match_mp_tac memory_rel_insert \\ fs []
+    \\ match_mp_tac memory_rel_Boolv_F \\ fs [])
+  \\ Cases_on `payload = []` \\ fs [] \\ rveq \\ fs []
+  THEN1
+   (fs [list_Seq_def] \\ eval_tac \\ fs [wordSemTheory.get_var_imm_def]
+    \\ fs [wordSemTheory.get_var_def,lookup_insert,asmTheory.word_cmp_def]
+    \\ fs [inter_insert_ODD_adjust_set]
+    \\ fs [lookup_insert,adjust_var_11] \\ rw [] \\ fs [option_le_max_right]
+    \\ full_simp_tac std_ss [GSYM APPEND_ASSOC]
+    \\ match_mp_tac memory_rel_insert \\ fs []
+    \\ match_mp_tac memory_rel_Boolv_F \\ fs [])
+  \\ ntac 2 (once_rewrite_tac [list_Seq_def]) \\ eval_tac
+  \\ fs [wordSemTheory.get_var_def,lookup_insert,wordSemTheory.get_var_imm_def,
+         asmTheory.word_cmp_def]
+  \\ drule word_exp_real_addr
+  \\ `shift_length c < dimindex (:α)` by (fs [memory_rel_def] \\ NO_TAC)
+  \\ fs [] \\ disch_then drule \\ fs [] \\ disch_then kall_tac
+  \\ fs [GSYM NOT_LESS,GREATER_EQ]
+  \\ `c.len_size <> 0` by
+      (fs [memory_rel_def,heap_in_memory_store_def] \\ NO_TAC)
+  \\ fs [NOT_LESS]
+  \\ fs [decode_length_def]
+  \\ fs [list_Seq_def] \\ eval_tac
+  \\ fs [wordSemTheory.get_var_def,lookup_insert,wordSemTheory.get_var_imm_def,
+         asmTheory.word_cmp_def]
+  \\ `LENGTH payload < dimword (:'a)` by
+   (match_mp_tac LESS_LESS_EQ_TRANS
+    \\ asm_exists_tac \\ fs [] \\ fs [dimword_def])
+  \\ fs [] \\ IF_CASES_TAC \\ fs []
+  \\ fs [inter_insert_ODD_adjust_set]
+  \\ fs [lookup_insert,adjust_var_11] \\ rw [] \\ fs [option_le_max_right]
+  \\ full_simp_tac std_ss [GSYM APPEND_ASSOC]
+  \\ match_mp_tac memory_rel_insert \\ fs []
+  \\ TRY (match_mp_tac memory_rel_Boolv_T) \\ fs []
+  \\ TRY (match_mp_tac memory_rel_Boolv_F) \\ fs []
+QED
+
 Theorem state_rel_upd_safe_pkheap:
   ! c l1 l2 s lcl hpk r locs. state_rel c l1 l2
                (s with <| locals := lcl; space := 0; stack_max := NONE|>)
@@ -11073,15 +11364,41 @@ Proof
   \\ rw [] \\ fs []
 QED
 
-Theorem assign_Deref:
-   op = Deref ==> ^assign_thm_goal
+Theorem assign_El:
+   op = El ==> ^assign_thm_goal
 Proof
   rpt strip_tac \\ drule0 (evaluate_GiveUp |> GEN_ALL) \\ rw [] \\ fs []
   \\ `t.termdep <> 0` by fs[]
   \\ rpt_drule0 state_rel_cut_IMP
   \\ qpat_x_assum `state_rel c l1 l2 s t [] locs` kall_tac \\ strip_tac
   \\ imp_res_tac get_vars_IMP_LENGTH \\ fs []
-  \\ fs [do_app,allowed_op_def] \\ every_case_tac \\ fs [] \\ clean_tac
+  \\ fs [do_app,CaseEq"list",CaseEq"dataSem$v",CaseEq"bool"]
+  \\ rveq \\ fs []
+  THEN1
+   (fs [INT_EQ_NUM_LEMMA] \\ clean_tac
+    \\ fs [integerTheory.NUM_OF_INT,LENGTH_EQ_2] \\ clean_tac
+    \\ imp_res_tac state_rel_get_vars_IMP
+    \\ fs [assign_def] \\ eval_tac \\ fs [state_rel_thm]
+    \\ full_simp_tac std_ss [GSYM APPEND_ASSOC]
+    \\ drule0 (memory_rel_get_vars_IMP |> GEN_ALL)
+    \\ disch_then drule0 \\ fs []
+    \\ imp_res_tac get_vars_2_IMP \\ fs []
+    \\ fs [integerTheory.NUM_OF_INT,LENGTH_EQ_2] \\ clean_tac
+    \\ imp_res_tac get_vars_2_IMP \\ fs [] \\ strip_tac
+    \\ drule0 (memory_rel_El |> GEN_ALL) \\ fs []
+    \\ strip_tac \\ clean_tac
+    \\ rename [`get_real_addr c t.store ptr_w = SOME x1`]
+    \\ `word_exp t (real_offset c (adjust_var a2)) = SOME (Word y) /\
+        word_exp t (real_addr c (adjust_var a1)) = SOME (Word x1)` by
+          metis_tac [get_real_offset_lemma,get_real_addr_lemma]
+    \\ fs [] \\ eval_tac
+    \\ fs [lookup_insert,adjust_var_11]
+    \\ rw [] \\ fs []
+    THEN1 metis_tac [option_le_trans,option_le_max_right]
+    \\ full_simp_tac std_ss [GSYM APPEND_ASSOC]
+    \\ match_mp_tac memory_rel_insert \\ fs []
+    \\ first_x_assum (fn th => mp_tac th THEN match_mp_tac memory_rel_rearrange)
+    \\ fs [] \\ rw [] \\ fs [])
   \\ fs [INT_EQ_NUM_LEMMA] \\ clean_tac
   \\ fs [integerTheory.NUM_OF_INT,LENGTH_EQ_2] \\ clean_tac
   \\ imp_res_tac state_rel_get_vars_IMP
@@ -11092,6 +11409,7 @@ Proof
   \\ imp_res_tac get_vars_2_IMP \\ fs []
   \\ fs [integerTheory.NUM_OF_INT,LENGTH_EQ_2] \\ clean_tac
   \\ imp_res_tac get_vars_2_IMP \\ fs [] \\ strip_tac
+  \\ fs [CaseEq"option",CaseEq"ref",CaseEq"bool"] \\ rveq \\ fs []
   \\ drule0 (memory_rel_Deref |> GEN_ALL) \\ fs []
   \\ strip_tac \\ clean_tac
   \\ `word_exp t (real_offset c (adjust_var a2)) = SOME (Word y) /\
@@ -11299,6 +11617,7 @@ Proof
   \\ fs[]
 QED
 
+(*
 Theorem assign_El:
    op = El ==> ^assign_thm_goal
 Proof
@@ -11331,6 +11650,7 @@ Proof
   \\ first_x_assum (fn th => mp_tac th THEN match_mp_tac memory_rel_rearrange)
   \\ fs [] \\ rw [] \\ fs []
 QED
+*)
 
 Theorem assign_Const:
    (?i. op = Const i) ==> ^assign_thm_goal
diff --git a/compiler/backend/proofs/data_to_word_memoryProofScript.sml b/compiler/backend/proofs/data_to_word_memoryProofScript.sml
index f174d03fef..09b12bb8c9 100644
--- a/compiler/backend/proofs/data_to_word_memoryProofScript.sml
+++ b/compiler/backend/proofs/data_to_word_memoryProofScript.sml
@@ -8048,20 +8048,36 @@ Proof
   rw[memory_rel_def] \\ asm_exists_tac \\ simp[]
 QED
 
+Theorem all_ones_bit:
+  i < dimindex (:'a) ==>
+  ((all_ones e b :'a word) ' i <=> b <= i /\ i < e)
+Proof
+  strip_tac
+  \\ imp_res_tac wordsTheory.word_0
+  \\ asm_simp_tac std_ss [all_ones_def]
+  \\ IF_CASES_TAC THEN1 fs []
+  \\ asm_simp_tac std_ss [word_slice_def,fcpTheory.FCP_BETA,word_1comp_def]
+  \\ fs []
+QED
+
+Theorem maxout_bits_bit:
+  (maxout_bits n l b:'a word) ' i /\ i < dimindex (:'a) ==>
+  b <= i /\ i < b + l
+Proof
+  rw [maxout_bits_def,word_lsl_def]
+  \\ fs [fcpTheory.FCP_BETA,n2w_def,all_ones_bit]
+  \\ fs [LESS_EQ_EXISTS] \\ rveq \\ fs []
+  \\ CCONTR_TAC \\ fs [NOT_LESS]
+  \\ `n < 2 ** l` by fs []
+  \\ qsuff_tac `n < 2 ** p`
+  THEN1 (strip_tac \\ drule bitTheory.NOT_BIT_GT_TWOEXP \\ simp [])
+  \\ match_mp_tac LESS_LESS_EQ_TRANS \\ asm_exists_tac \\ simp []
+QED
+
 Theorem maxout_bits_IMP:
    i < dimindex (:'a) /\ (maxout_bits tag k n:'a word) ' i ==> i < n + k
 Proof
-  rw [maxout_bits_def] \\ rfs [word_lsl_def,fcpTheory.FCP_BETA,n2w_def]
-  THEN1
-   (CCONTR_TAC \\ fs [GSYM NOT_LESS]
-    \\ fs [bitTheory.BIT_def,bitTheory.BITS_THM]
-    \\ sg `tag DIV 2 ** (i − n) = 0` \\ fs []
-    \\ match_mp_tac LESS_DIV_EQ_ZERO
-    \\ match_mp_tac LESS_LESS_EQ_TRANS
-    \\ asm_exists_tac \\ fs [])
-  \\ rfs [all_ones_def,word_slice_def,fcpTheory.FCP_BETA]
-  \\ Cases_on `k` \\ fs [] \\ rfs [word_0]
-  \\ rfs [ADD1,fcpTheory.FCP_BETA]
+  rw [] \\ imp_res_tac maxout_bits_bit \\ fs []
 QED
 
 Theorem make_cons_ptr_thm:
@@ -10853,26 +10869,33 @@ Proof
    Induct \\ rw [append_writes_def]
 QED
 
-val ptr_bits_1 = Q.prove (
-  `(ptr_bits c 0 2 || 1w) = ptr_bits c 0 2 + 1w`,
-  irule (SPEC_ALL WORD_ADD_OR |> PURE_ONCE_REWRITE_RULE [EQ_SYM_EQ])
-  \\ rw [word_0, fcpTheory.CART_EQ, ptr_bits_def]
-  \\ strip_tac
-  \\ rfs [fcpTheory.FCP_BETA, word_and_def, word_or_def]
-  \\ imp_res_tac maxout_bits_IMP \\ fs []
-  \\ imp_res_tac word_bit
-  \\ fsrw_tac [wordsLib.WORD_BIT_EQ_ss] [word_index, word_bit_test, shift_length_def]
-  \\ rveq \\ fs [maxout_bits_def, word_0]
-  \\ FULL_CASE_TAC \\ rfs [fcpTheory.FCP_BETA, word_lsl_def, all_ones_def]
-  \\ FULL_CASE_TAC \\ fs [word_0]
-  \\ fs [WORD_SLICE_THM, word_lsl_def, word_bits_def, fcpTheory.FCP_BETA]);
+Theorem ptr_bits_or_1_add_1:
+  ptr_bits c tag len ‖ 1w = ptr_bits c tag len + 1w
+Proof
+  match_mp_tac (GSYM WORD_ADD_OR)
+  \\ simp_tac std_ss [fcpTheory.CART_EQ,word_0,word_and_def,fcpTheory.FCP_BETA,
+       word_1comp_def,n2w_def] \\ fs []
+  \\ fs [ptr_bits_def,word_or_def,fcpTheory.FCP_BETA]
+  \\ rw [maxout_bits_def]
+  \\ fs [word_lsl_def,fcpTheory.FCP_BETA,all_ones_bit]
+QED
+
+Theorem all_ones_n2w:
+  all_ones (l + b) b = n2w (2 ** l - 1) << b
+Proof
+  simp_tac std_ss [all_ones_def]
+  \\ IF_CASES_TAC THEN1 (Cases_on `l` \\ fs [])
+  \\ simp_tac std_ss [fcpTheory.CART_EQ,word_slice_def,fcpTheory.FCP_BETA,word_lsl_def,
+        word_1comp_def,word_0]
+  \\ simp [n2w_def,bitTheory.BIT_EXP_SUB1,fcpTheory.FCP_BETA]
+QED
 
 Theorem ptr_bits_lemma:
    (w << shift_length conf || ptr_bits conf 0 2 || 1w) =
    w << shift_length conf + ptr_bits conf 0 2 + 1w
 Proof
   once_rewrite_tac [GSYM WORD_ADD_ASSOC]
-  \\ once_rewrite_tac [GSYM ptr_bits_1]
+  \\ once_rewrite_tac [GSYM ptr_bits_or_1_add_1]
   \\ irule (SPEC_ALL WORD_ADD_OR |> PURE_ONCE_REWRITE_RULE [EQ_SYM_EQ])
   \\ rw [word_0, fcpTheory.CART_EQ] \\ strip_tac
   \\ rfs [fcpTheory.FCP_BETA, word_lsl_def, word_or_def, word_and_def, ptr_bits_def]
diff --git a/compiler/backend/proofs/flat_elimProofScript.sml b/compiler/backend/proofs/flat_elimProofScript.sml
index 3d6bc4d0e2..3ec2c40392 100644
--- a/compiler/backend/proofs/flat_elimProofScript.sml
+++ b/compiler/backend/proofs/flat_elimProofScript.sml
@@ -444,7 +444,6 @@ val flat_state_rel_def = Define `
     flat_state_rel reachable s t ⇔
       s.clock = t.clock ∧ s.refs = t.refs ∧
       s.ffi = t.ffi ∧ globals_rel reachable s t ∧
-      s.exh_pat = t.exh_pat ∧
       s.check_ctor = t.check_ctor ∧
       s.c = t.c ∧
       domain (find_refs_globals s.refs) ⊆ domain reachable
@@ -480,8 +479,8 @@ Proof
     >- (Cases_on `store_lookup lnum s.refs` >> fs[] >> Cases_on `x` >> fs[] >>
         fs[semanticPrimitivesTheory.store_lookup_def] >>
         first_x_assum (qspec_then `reachable` match_mp_tac) >> rw[] >>
-        imp_res_tac find_refs_globals_EL >> metis_tac[SUBSET_TRANS])
-    >- (Cases_on `pmatch s p v l` >> fs[domain_union])
+        imp_res_tac find_refs_globals_EL >> metis_tac[SUBSET_TRANS]) >>
+    Cases_on `pmatch s p v l` >> fs[domain_union,CaseEq"match_result"]
 QED
 
 Theorem find_v_globals_list_to_v_APPEND:
@@ -518,6 +517,38 @@ Proof
     simp[Once flat_state_rel_def] >> strip_tac >>
     `∃ this_case . this_case op` by (qexists_tac `K T` >> simp[]) >>
     reverse (Cases_on `op`) >> fs[]
+    >- (rename [`El`]
+        \\ fs [do_app_def,CaseEq"list",CaseEq"lit",CaseEq"v"] \\ rveq \\ fs []
+        \\ fs [flat_state_rel_def,find_v_globals_def,find_sem_prim_res_globals_def]
+        THEN1
+         (rename [`domain (find_v_globalsL xs) ⊆ domain reachable`]
+          \\ qpat_x_assum `domain (find_v_globalsL xs) ⊆ domain reachable` mp_tac
+          \\ qpat_x_assum `n < LENGTH xs` mp_tac
+          \\ qid_spec_tac `n`
+          \\ Induct_on `xs` \\ fs [find_v_globals_def,domain_union]
+          \\ strip_tac \\ Cases \\ fs [])
+        \\ fs [CaseEq"option",CaseEq"store_v"] \\ rveq \\ fs []
+        \\ fs [find_sem_prim_res_globals_def,find_v_globals_def]
+        \\ match_mp_tac SUBSET_TRANS
+        \\ once_rewrite_tac [CONJ_COMM]
+        \\ asm_exists_tac \\ asm_rewrite_tac []
+        \\ fs[semanticPrimitivesTheory.store_alloc_def,
+              semanticPrimitivesTheory.store_lookup_def,
+              chr_exn_v_def, Boolv_def, div_exn_v_def]
+        \\ drule EL_MEM
+        \\ fs [MEM_SPLIT] \\ rveq \\ fs [] \\ strip_tac \\ rveq
+        \\ fs [find_refs_globals_APPEND,find_refs_globals_def,domain_union]
+        \\ fs [SUBSET_DEF])
+    >- (rename [`LenEq`]
+        \\ fs [do_app_def,CaseEq"list",CaseEq"lit",CaseEq"v",CaseEq"option",
+               pair_case_eq] \\ rveq \\ fs []
+        \\ fs [flat_state_rel_def,find_v_globals_def,find_sem_prim_res_globals_def]
+        \\ rw [Boolv_def]  \\ EVAL_TAC)
+    >- (rename [`TagLenEq`]
+        \\ fs [do_app_def,CaseEq"list",CaseEq"lit",CaseEq"v",CaseEq"option",
+               pair_case_eq] \\ rveq \\ fs []
+        \\ fs [flat_state_rel_def,find_v_globals_def,find_sem_prim_res_globals_def]
+        \\ rw [Boolv_def]  \\ EVAL_TAC)
     >- (fs[do_app_def] >> Cases_on `l` >> fs[find_v_globals_def] >>
         rveq >> fs[flat_state_rel_def] >>
         fs[find_lookups_def, dest_GlobalVarLookup_def] >>
@@ -541,7 +572,7 @@ Proof
        chr_exn_v_def, Boolv_def, div_exn_v_def] >>
     fs[flat_state_rel_def, find_v_globals_def,
        domain_union, find_refs_globals_def] >> rveq >> rfs[globals_rel_def]
-    (* 25 subgoals *)
+    (* 24 subgoals *)
     >- (rw[] >> Cases_on `n' < LENGTH removed_state.globals` >> rveq >> fs[]
         >- fs[EL_APPEND1] >- fs[EL_APPEND2] >- fs[EL_APPEND1] >- fs[EL_APPEND2]
         >- metis_tac[EL_APPEND1]
@@ -588,9 +619,15 @@ Proof
     >- (rw[] >- metis_tac[] >>
         fs[find_refs_globals_APPEND, domain_union, find_refs_globals_def] >>
         metis_tac[find_v_globalsL_REPLICATE, SUBSET_DEF])
+    >- (fs [integerTheory.INT_NOT_LT]
+        \\ imp_res_tac integerTheory.NUM_POSINT_EXISTS \\ rveq \\ fs []
+        \\ fs [GREATER_EQ,GSYM NOT_LESS]
+        \\ metis_tac[find_v_globalsL_EL, SUBSET_DEF])
+(*
     >- (rename [`ABS ii`] >>
         `Num (ABS ii) < LENGTH vs'` by fs[] >>
         metis_tac[find_v_globalsL_EL, SUBSET_DEF])
+*)
     >- (qexists_tac `removed_state` >> fs[] >> fs[])
     >- (metis_tac[find_v_globals_v_to_list, SUBSET_DEF])
     >- (qexists_tac `removed_state` >> fs[] >> fs[])
@@ -605,7 +642,6 @@ Proof
     >- (qexists_tac `removed_state` >> fs[] >> fs[])
     >- (fs[find_refs_globals_APPEND, domain_union, find_refs_globals_def] >>
         metis_tac[])
-    >- (metis_tac[find_refs_globals_EL, SUBSET_DEF])
     >- (rw[] >>
         fs[find_refs_globals_APPEND, find_refs_globals_def,
            find_v_globals_def, domain_union] >> res_tac)
@@ -630,14 +666,57 @@ Proof
     metis_tac[SUBSET_TRANS]
 QED
 
-(******** EVALUATE MUTUAL INDUCTION ********)
+Theorem flat_state_rel_pmatch:
+  (!(new_state:'a state) p a env.
+    flat_state_rel reachable new_state new_removed_state ==>
+    pmatch new_removed_state p a env =
+    pmatch new_state p a env) /\
+  (!(new_state:'a state) p a env.
+    flat_state_rel reachable new_state new_removed_state ==>
+    pmatch_list new_removed_state p a env =
+    pmatch_list new_state p a env)
+Proof
+  ho_match_mp_tac pmatch_ind \\ rw []
+  \\ fs [pmatch_def,flat_state_rel_def]
+  \\ rw [] \\ fs [] \\ rpt (CASE_TAC \\ fs [])
+QED
+
+Theorem flat_state_rel_pmatch_rows:
+  flat_state_rel reachable new_state new_removed_state ==>
+  pmatch_rows (pes: (pat # exp) list) new_removed_state a =
+  pmatch_rows pes new_state a
+Proof
+  Induct_on `pes` \\ fs [pmatch_rows_def,FORALL_PROD]
+  \\ rw [] \\ fs []
+  \\ drule (CONJUNCT1 flat_state_rel_pmatch) \\ fs []
+QED
+
+Theorem pmatch_rows_find_lookups:
+  pmatch_rows pes q a = Match (env',p',e') /\
+  domain (find_lookupsL (MAP SND pes)) ⊆ domain reachable ==>
+  domain (find_lookups e') ⊆ domain reachable
+Proof
+  Induct_on `pes` \\ fs [pmatch_rows_def,FORALL_PROD]
+  \\ fs [CaseEq"match_result"] \\ rw []
+  \\ fs [find_lookups_def,domain_union]
+QED
+
+Theorem pmatch_rows_IMP_pmatch:
+  pmatch_rows pes s v = Match (env',p',e') ==>
+  pmatch s p' v [] = Match env' /\ MEM (p',e') pes
+Proof
+  Induct_on `pes`
+  \\ fs [pmatch_rows_def,FORALL_PROD,CaseEq"match_result"]
+  \\ rw [] \\ fs []
+QED
+
+(******** EVALUATE INDUCTION ********)
 
 Theorem evaluate_sing_keep_flat_state_rel_eq_lemma:
      (∀ env (state:'a flatSem$state) exprL new_state
         result reachable:num_set removed_state .
         flatSem$evaluate env state exprL = (new_state, result) ∧
         domain (find_lookupsL exprL) ⊆ domain reachable ∧
-        state.exh_pat ∧
         flat_state_rel reachable state removed_state ∧
         domain (find_env_globals env) ⊆ domain reachable ∧
         result ≠ Rerr (Rabort Rtype_error)
@@ -645,21 +724,6 @@ Theorem evaluate_sing_keep_flat_state_rel_eq_lemma:
         evaluate env removed_state exprL = (new_removed_state, result) ∧
         flat_state_rel reachable new_state new_removed_state ∧
         domain (find_sem_prim_res_globals result) ⊆ domain reachable)
-   ∧
-    (∀ env (state:'a flatSem$state) v patExp_list err_v new_state result
-        reachable:num_set removed_state .
-        evaluate_match env state v patExp_list err_v = (new_state, result) ∧
-        domain (find_lookupsL (MAP SND patExp_list)) ⊆ domain reachable ∧
-        state.exh_pat ∧
-        domain (find_v_globals v) ⊆ domain reachable ∧
-        flat_state_rel reachable state removed_state ∧
-        domain (find_env_globals env) ⊆ domain reachable ∧
-        result ≠ Rerr (Rabort Rtype_error)
-    ⇒ ∃ new_removed_state .
-        evaluate_match env removed_state v patExp_list err_v =
-            (new_removed_state, result) ∧
-        flat_state_rel reachable new_state new_removed_state ∧
-        domain (find_sem_prim_res_globals result) ⊆ domain reachable)
 Proof
   ho_match_mp_tac evaluate_ind >> rpt CONJ_TAC >> rpt GEN_TAC >> strip_tac
   (* EVALUATE CASES *)
@@ -681,10 +745,8 @@ Proof
     fs[] >>
     reverse(Cases_on `r` >> fs[])
     >- (
-      rw[] >> fs[] >>
-      qsuff_tac `q.exh_pat` >- (strip_tac >> fs[]) >>
-      imp_res_tac evaluate_state_unchanged
-      )
+      rw[] >> fs[]
+    )
     >- (
       strip_tac >> rw[] >>
       imp_res_tac evaluate_state_unchanged >>
@@ -726,10 +788,18 @@ Proof
     strip_tac >>
     Cases_on `r` >> rw[] >> rfs[] >>
     Cases_on `e'` >> rw[] >> rfs[] >> rveq >> rfs[] >>
-    first_x_assum (
-        qspecl_then [`reachable`, `removed_state`] match_mp_tac) >>
-    fs[find_sem_prim_res_globals_def, find_result_globals_def] >>
-    imp_res_tac evaluate_state_unchanged
+    fs [CaseEq"match_result",pair_case_eq,CaseEq"bool"] >> rveq >> fs [] >>
+    drule flat_state_rel_pmatch_rows >> fs [] >>
+    rfs [] >> strip_tac >> first_x_assum match_mp_tac >> fs [] >>
+    conj_tac THEN1 metis_tac [pmatch_rows_find_lookups] >>
+    fs [find_env_globals_def] >>
+    fs[find_env_globals_def, find_v_globalsL_APPEND, domain_union] >>
+    imp_res_tac pmatch_rows_IMP_pmatch >>
+    drule (CONJUNCT1 pmatch_Match_reachable) >>
+    disch_then match_mp_tac >>
+    fs[find_v_globals_def] >>
+    fs [find_sem_prim_res_globals_def,find_result_globals_def] >>
+    fs [flat_state_rel_def]
     )
   >- ( (* Con NONE *)
     rpt gen_tac >> strip_tac >>
@@ -917,12 +987,19 @@ Proof
     `r ≠ Rerr(Rabort Rtype_error)` by
         (CCONTR_TAC >> Cases_on `r` >> fs[]) >> fs[] >>
     Cases_on `r` >> fs[] >>
-    first_x_assum (qspecl_then [`reachable`, `new_removed_state`]
-        match_mp_tac) >> fs[] >>
-    fs[find_sem_prim_res_globals_def] >>
-    imp_res_tac evaluate_sing >> rveq >> fs[] >> rveq >>
+    fs [CaseEq"match_result",pair_case_eq,CaseEq"bool"] >> rveq >> fs [] >>
+    drule flat_state_rel_pmatch_rows >> fs [] THEN1 EVAL_TAC >>
+    rfs [] >> strip_tac >> first_x_assum match_mp_tac >> fs [] >>
+    conj_tac THEN1 metis_tac [pmatch_rows_find_lookups] >>
+    fs [find_env_globals_def] >>
+    imp_res_tac evaluate_sing >> rveq >> fs [] >>
+    fs[find_env_globals_def, find_v_globalsL_APPEND, domain_union] >>
+    imp_res_tac pmatch_rows_IMP_pmatch >>
+    drule (CONJUNCT1 pmatch_Match_reachable) >>
+    disch_then match_mp_tac >>
     fs[find_v_globals_def] >>
-    imp_res_tac evaluate_state_unchanged
+    fs [find_sem_prim_res_globals_def,find_result_globals_def] >>
+    fs [flat_state_rel_def,find_v_globals_def]
     )
   >- ( (* Let *)
     rpt gen_tac >> strip_tac >>
@@ -965,28 +1042,6 @@ Proof
             metis_tac[find_v_globals_MAP_Recclosure] >>
     fs[SUBSET_DEF] >> metis_tac[]
     )
-  (* EVALUATE_MATCH CASES *)
-      (* EMPTY LIST CASE *)
-  >- (fs[evaluate_def])
-  >- ( (* NON-EMPTY LIST CASE *)
-    rpt gen_tac >> strip_tac >>
-    qpat_x_assum `evaluate_match _ _ _ _ _ =  _` mp_tac >>
-    simp[evaluate_def] >> fs[find_lookups_def, domain_union] >>
-    Cases_on `ALL_DISTINCT (pat_bindings p [])` >> fs[] >>
-    strip_tac >>
-    qpat_assum `flat_state_rel _ _ _`
-      (fn th => REWRITE_RULE[flat_state_rel_def] th |> assume_tac) >>
-    fs[] >>
-    imp_res_tac pmatch_state >>
-    fs[] >>
-    Cases_on `pmatch state' p v []` >> fs[] >>
-    first_x_assum (qspecl_then [`reachable`, `removed_state`] match_mp_tac) >>
-    fs[] >>
-    fs[find_env_globals_def, find_v_globalsL_APPEND, domain_union] >>
-    drule (CONJUNCT1 pmatch_Match_reachable) >> disch_then drule >>
-    disch_then match_mp_tac >>
-    strip_tac >> fs[find_v_globals_def] >> rw[]
-    )
 QED
 
 (******** EVALUATE SPECIALISATION ********)
@@ -996,7 +1051,7 @@ Theorem evaluate_sing_keep_flat_state_rel_eq:
       reachable removed_state .
       flatSem$evaluate (env with v := []) state exprL = (new_state, result) ∧
       exprL = [expr] ∧
-      keep reachable (Dlet expr) ∧ state.exh_pat ∧
+      keep reachable (Dlet expr) ∧
       domain(find_lookups expr) ⊆ domain reachable ∧
       flat_state_rel reachable state removed_state ∧
       result ≠ Rerr (Rabort Rtype_error)
@@ -1006,7 +1061,7 @@ Theorem evaluate_sing_keep_flat_state_rel_eq:
         flat_state_rel reachable new_state new_removed_state
 Proof
   rpt gen_tac >> strip_tac >> fs[keep_def] >> rveq >>
-  drule (CONJUNCT1 evaluate_sing_keep_flat_state_rel_eq_lemma) >> fs[] >>
+  drule evaluate_sing_keep_flat_state_rel_eq_lemma >> fs[] >>
   strip_tac >> pop_assum (qspecl_then [`reachable`, `removed_state`]
       mp_tac) >> fs[] >>
   impl_tac >> fs[] >>
@@ -1020,7 +1075,6 @@ Theorem evaluate_dec_flat_state_rel:
   ∀ (state:'a flatSem$state) dec new_state result
     reachable removed_state .
     evaluate_dec state dec = (new_state, result) ∧
-    state.exh_pat ∧
     decs_closed reachable [dec] ∧
     flat_state_rel reachable state removed_state ∧ keep reachable dec ∧
     result ≠ SOME (Rabort Rtype_error)
@@ -1086,7 +1140,35 @@ Proof
   rfs[]
 QED
 
+Theorem total_pat_IMP:
+  (!(s:'a state) p v env res.
+     pmatch s p v env = res /\ total_pat p ==> res <> No_match) /\
+  (!(s:'a state) ps vs env res.
+     LENGTH ps = LENGTH vs /\
+     pmatch_list s ps vs env = res /\ total_pat_list ps ==> res <> No_match)
+Proof
+  ho_match_mp_tac pmatch_ind \\ rw []
+  \\ fs [pmatch_def,CaseEq"bool",total_pat_def]
+  \\ CCONTR_TAC \\ fs []
+  \\ fs [pmatch_stamps_ok_OPTREL, OPTREL_def]
+  \\ rveq
+  \\ fs [total_pat_def]
+  \\ fs [CaseEq"match_result"] \\ fs []
+QED
 
+Theorem EXISTS_total_pat:
+  EXISTS total_pat (MAP FST pes) ==>
+  pmatch_rows pes new_state v <> No_match
+Proof
+  Induct_on `pes` \\ fs [pmatch_rows_def,FORALL_PROD]
+  \\ strip_tac
+  \\ reverse (Cases_on `EXISTS total_pat (MAP FST pes)`)
+  \\ full_simp_tac std_ss [] THEN1
+   (rw [] \\ Cases_on `pmatch new_state p_1 v []` \\ fs []
+    \\ drule (CONJUNCT1 total_pat_IMP) \\ fs [] \\ fs [CaseEq"match_result"])
+  \\ Cases_on `pmatch_rows pes new_state v` \\ fs []
+  \\ fs [CaseEq"match_result"]
+QED
 
 
 (********************** CASE: *NOT* keep reachable h ***********************)
@@ -1099,19 +1181,6 @@ Theorem evaluate_flat_state_rel_lemma:
       flatSem$evaluate env state exprL = (new_state, result) ∧
       EVERY is_pure exprL ∧
       EVERY (λ e. isEmpty (inter (find_loc e) reachable)) exprL ∧
-      state.exh_pat ∧
-      flat_state_rel reachable state removed_state ∧
-      result ≠ Rerr (Rabort Rtype_error)
-  ⇒ flat_state_rel reachable new_state removed_state ∧
-      ∃ (values : flatSem$v list) . result = Rval values)
- ∧
-  (∀ env (state:'a flatSem$state) v patExp_list err_v new_state result
-      reachable removed_state .
-      evaluate_match env state v patExp_list err_v = (new_state, result) ∧
-      EVERY is_pure (MAP SND patExp_list) ∧
-      EVERY (λ e. isEmpty (inter (find_loc e) reachable))
-          (MAP SND patExp_list) ∧
-      state.exh_pat ∧
       flat_state_rel reachable state removed_state ∧
       result ≠ Rerr (Rabort Rtype_error)
   ⇒ flat_state_rel reachable new_state removed_state ∧
@@ -1185,7 +1254,7 @@ Proof
     >- (fs[is_pure_def] >>
         qpat_x_assum `isEmpty _` mp_tac >> simp[Once find_loc_def] >>
         strip_tac >>
-        `isEmpty(inter (find_locL (MAP SND patExp_list)) reachable) ∧
+        `isEmpty(inter (find_locL (MAP SND pes)) reachable) ∧
         isEmpty (inter (find_loc e) reachable)` by
             metis_tac[inter_union_empty] >>
         first_x_assum (qspecl_then [`reachable`, `removed_state`] mp_tac) >>
@@ -1308,9 +1377,8 @@ Proof
       rveq >> first_x_assum (qspecl_then [`reachable`, `removed_state`]
           mp_tac) >> fs[] >>
       strip_tac >> rfs[] >>
-      first_x_assum match_mp_tac >>
-      fs[] >>
-      imp_res_tac evaluate_state_unchanged
+      first_x_assum (drule_then drule) >>
+      fs[]
       )
     >- (
       rveq >>
@@ -1325,18 +1393,19 @@ Proof
     Cases_on `evaluate env state' [e]` >> fs[] >> fs[is_pure_def] >>
     qpat_x_assum `isEmpty _` mp_tac >> simp[Once find_loc_def] >>
     strip_tac >>
-    `isEmpty (inter (find_locL (MAP SND patExp_list)) reachable) ∧
+    `isEmpty (inter (find_locL (MAP SND pes)) reachable) ∧
         isEmpty (inter (find_loc e) reachable)` by
             metis_tac[inter_union_empty] >>
-    first_x_assum (qspecl_then [`reachable`, `removed_state`] mp_tac) >>
-    fs[] >>
-    strip_tac >> Cases_on `r` >> fs[] >>
-    first_x_assum (qspecl_then [`reachable`, `removed_state`] mp_tac) >>
-    fs[] >>
-    strip_tac >> fs[is_pure_EVERY_aconv, find_loc_EVERY_isEmpty] >> rfs[] >>
-    imp_res_tac evaluate_sing >> rveq >> fs[find_v_globals_def] >>
-    imp_res_tac evaluate_state_unchanged >>
-    rfs[]
+    reverse (Cases_on `r`) >> fs[]
+    THEN1 (rveq \\ fs [] \\ metis_tac [])
+    \\ fs [CaseEq"match_result",pair_case_eq,CaseEq"bool"] \\ rveq \\ fs []
+    \\ imp_res_tac EXISTS_total_pat \\ fs []
+    \\ last_x_assum match_mp_tac \\ first_x_assum drule
+    \\ disch_then drule \\ fs [] \\ strip_tac
+    \\ drule pmatch_rows_IMP_pmatch \\ strip_tac
+    \\ fs [GSYM find_loc_EVERY_isEmpty]
+    \\ fs [EVERY_MEM,MEM_MAP,PULL_EXISTS] \\ res_tac \\ fs []
+    \\ fs [flat_state_rel_def]
     )
   >- ( (* Let *)
     rpt gen_tac >> strip_tac >> qpat_assum `flat_state_rel _ _ _` mp_tac >>
@@ -1385,25 +1454,6 @@ Proof
             (rw[MAP_EQ_f] >> PairCases_on `e'` >> fs[]) >>
     fs[]
     )
-  (* EVALUATE_MATCH CASES *)
-  >- ((* EMPTY LIST CASE *)
-    fs[evaluate_def]
-    )
-  >- ( (* NON-EMPTY LIST CASE *)
-    rpt gen_tac >> strip_tac >> qpat_assum `flat_state_rel _ _ _` mp_tac >>
-    SIMP_TAC std_ss [Once flat_state_rel_def] >> strip_tac >>
-    fs[evaluate_def] >>
-    Cases_on `ALL_DISTINCT (pat_bindings p [])` >> fs[] >>
-    imp_res_tac pmatch_state >>
-    Cases_on `pmatch state' p v []` >> fs[] >>
-    first_x_assum (qspecl_then [`reachable`, `removed_state`] mp_tac) >>
-    fs[] >>
-    impl_tac >> fs[] >>
-    fs[find_env_globals_def, find_v_globalsL_APPEND, domain_union] >>
-    drule (CONJUNCT1 pmatch_Match_reachable) >> disch_then drule >>
-    disch_then match_mp_tac >>
-    fs[find_v_globals_def] >> rw[] >> metis_tac[]
-    )
 QED
 
 (******** EVALUATE SPECIALISATION ********)
@@ -1413,14 +1463,14 @@ Theorem evaluate_sing_notKeep_flat_state_rel:
       reachable removed_state .
       flatSem$evaluate (env with v := []) state exprL = (new_state, result) ∧
       exprL = [expr] ∧
-      ¬keep reachable (Dlet expr) ∧ state.exh_pat ∧
+      ¬keep reachable (Dlet expr) ∧
       flat_state_rel reachable state removed_state ∧
       result ≠ Rerr (Rabort Rtype_error)
   ⇒ flat_state_rel reachable new_state removed_state ∧
       ∃ value : flatSem$v . result = Rval [value]
 Proof
   rpt gen_tac >> strip_tac >> fs[keep_def] >> rveq >>
-  drule (CONJUNCT1 evaluate_flat_state_rel_lemma) >> fs[] >>
+  drule evaluate_flat_state_rel_lemma >> fs[] >>
   disch_then drule >> disch_then drule >> fs[] >>
   rw[] >> imp_res_tac evaluate_sing >> fs[] >> fs[find_v_globals_def]
 QED
@@ -1433,7 +1483,7 @@ Theorem flat_decs_removal_lemma:
      ∀ (state:'a flatSem$state) decs new_state result
         reachable removed_decs removed_state .
         evaluate_decs state decs = (new_state, result) ∧
-        result ≠ SOME (Rabort Rtype_error) ∧ state.exh_pat ∧
+        result ≠ SOME (Rabort Rtype_error) ∧
         remove_unreachable reachable decs = removed_decs ∧
         flat_state_rel reachable state removed_state ∧
         decs_closed reachable decs
@@ -1485,24 +1535,22 @@ Proof
 QED
 
 Theorem flat_removal_thm:
-  ∀ exh_pat check_ctor ffi k decs new_state result roots tree
+  ∀ check_ctor ffi k decs new_state result roots tree
       reachable removed_decs .
-      evaluate_decs (initial_state ffi k exh_pat check_ctor) decs =
+      evaluate_decs (initial_state ffi k check_ctor) decs =
         (new_state, result) ∧
-      result ≠ SOME (Rabort Rtype_error) ∧ exh_pat ∧
+      result ≠ SOME (Rabort Rtype_error) ∧
       (roots, tree) = analyse_code decs ∧
       reachable = closure_spt roots (mk_wf_set_tree tree) ∧
       remove_unreachable reachable decs = removed_decs
   ⇒ ∃ s .
       s.ffi = new_state.ffi /\
-      evaluate_decs (initial_state ffi k exh_pat check_ctor)
+      evaluate_decs (initial_state ffi k check_ctor)
           removed_decs = (s, result)
 Proof
   rpt strip_tac >> drule flat_decs_removal_lemma >>
   rpt (disch_then drule) >> strip_tac >>
-  pop_assum (qspecl_then
-      [`reachable`, `removed_decs`, `initial_state ffi k exh_pat check_ctor`]
-        mp_tac) >> fs[] >>
+  pop_assum (qspec_then `initial_state ffi k check_ctor` mp_tac) >>
   reverse(impl_tac)
   >- (rw[] >> fs[]) >>
   qspecl_then [`decs`, `roots`, `mk_wf_set_tree tree`, `tree`]
@@ -1525,8 +1573,8 @@ Proof
 QED
 
 Theorem flat_remove_eval_sim:
-   eval_sim ffi T T ds1 T T (remove_flat_prog ds1)
-                            (\d1 d2. d2 = remove_flat_prog d1) F
+   eval_sim ffi T ds1 T (remove_flat_prog ds1)
+                        (\d1 d2. d2 = remove_flat_prog d1) F
 Proof
   rw [eval_sim_def] \\ qexists_tac `0` \\ fs [remove_flat_prog_def]
   \\ pairarg_tac \\ fs []
diff --git a/compiler/backend/proofs/flat_exh_matchProofScript.sml b/compiler/backend/proofs/flat_exh_matchProofScript.sml
deleted file mode 100644
index 364b830d13..0000000000
--- a/compiler/backend/proofs/flat_exh_matchProofScript.sml
+++ /dev/null
@@ -1,1470 +0,0 @@
-(*
-  Correctness proof for flat_exh_match
-*)
-
-open semanticPrimitivesTheory semanticPrimitivesPropsTheory;
-open preamble flatPropsTheory flatSemTheory flat_exh_matchTheory
-(* TODO: fix grammar ancestry problems when these opens are combined *)
-
-val _ = new_theory "flat_exh_matchProof"
-
-(* ------------------------------------------------------------------------- *)
-(* Compile lemmas                                                            *)
-(* ------------------------------------------------------------------------- *)
-
-val _ = set_grammar_ancestry["flat_exh_match","flatSem","flatProps","ffi","misc"];
-
-Theorem compile_exps_SING_HD[simp]:
-  LENGTH (compile_exps exh [x]) = 1 ∧
-  [HD (compile_exps exh [x])] = compile_exps exh [x]
-Proof
-  Cases_on `compile_exps exh [x]`
-  \\ pop_assum (mp_tac o Q.AP_TERM `LENGTH`) \\ fs [compile_exps_LENGTH]
-QED
-
-Theorem compile_exps_CONS:
-  compile_exps exh (x::xs) = compile_exps exh [x] ++ compile_exps exh xs
-Proof qid_spec_tac `x` \\ Induct_on `xs` \\ rw [compile_exps_def]
-QED
-
-Theorem compile_exps_APPEND:
-   compile_exps exh (xs ++ ys) = compile_exps exh xs ++ compile_exps exh ys
-Proof
-  map_every qid_spec_tac [`ys`,`xs`] \\ Induct \\ rw [compile_exps_def]
-  \\ rw [Once compile_exps_CONS]
-  \\ rw [Once (GSYM compile_exps_CONS)]
-QED
-
-Theorem compile_exps_REVERSE[simp]:
-  REVERSE (compile_exps exh xs) = compile_exps exh (REVERSE xs)
-Proof
-  Induct_on `xs` \\ rw [compile_exps_def]
-  \\ rw [Once compile_exps_CONS, Once compile_exps_APPEND]
-  \\ `LENGTH (compile_exps exh [h]) = 1`
-    by fs [compile_exps_LENGTH]
-  \\ fs [LENGTH_EQ_NUM_compute]
-QED
-
-Theorem compile_exps_MAP_FST:
-   MAP FST funs =
-   MAP FST (MAP (\(a,b,c). (a,b,HD (compile_exps ctors [c]))) funs)
-Proof
-  Induct_on `funs` \\ rw []
-  \\ PairCases_on `h` \\ fs []
-QED
-
-Theorem compile_exps_find_recfun:
-   !ls f exh.
-     find_recfun f (MAP (\(a,b,c). (a, b, HD (compile_exps exh [c]))) ls) =
-     OPTION_MAP (\(x,y). (x, HD (compile_exps exh [y]))) (find_recfun f ls)
-Proof
-  Induct \\ rw []
-  >- fs [semanticPrimitivesTheory.find_recfun_def]
-  \\ simp [Once semanticPrimitivesTheory.find_recfun_def]
-  \\ once_rewrite_tac [EQ_SYM_EQ]
-  \\ simp [Once semanticPrimitivesTheory.find_recfun_def]
-  \\ every_case_tac \\ fs []
-QED
-
-Theorem exhaustive_SUBMAP:
-   !ps ctors ctors_pre.
-     exhaustive_match ctors_pre ps /\
-     ctors_pre SUBMAP ctors
-     ==>
-     exhaustive_match ctors ps
-Proof
-  Induct \\ rw [exhaustive_match_def] \\ fs []
-  \\ every_case_tac \\ fs [is_unconditional_def]
-  \\ imp_res_tac FLOOKUP_SUBMAP \\ fs [] \\ rw []
-QED
-
-(* ------------------------------------------------------------------------- *)
-(* Value relations                                                           *)
-(* ------------------------------------------------------------------------- *)
-
-val ok_ctor_def = Define `
-  (ok_ctor ctors (Conv x ps) <=>
-    !id tid.
-      x = SOME (id, SOME tid) ==>
-      ?ars max.
-        FLOOKUP ctors tid = SOME ars /\
-        lookup (LENGTH ps) ars = SOME max /\
-        id < max) /\
-  (ok_ctor ctors v <=> T)`
-
-Inductive v_rel:
-  (!ctors v. v_rel ctors (Litv v) (Litv v)) /\
-  (!ctors n. v_rel ctors (Loc n) (Loc n)) /\
-  (!ctors vs1 vs2.
-     LIST_REL (v_rel ctors) vs1 vs2
-     ==>
-     v_rel ctors (Vectorv vs1) (Vectorv vs2)) /\
-  (!ctors t v1 v2 ctors_pre.
-     LIST_REL (v_rel ctors) v1 v2 /\
-     ctors_pre SUBMAP ctors /\
-     ok_ctor ctors_pre (Conv t v1)
-     ==>
-     v_rel ctors (Conv t v1) (Conv t v2)) /\
-  (!ctors vs1 n x vs2 ctors_pre.
-     nv_rel ctors vs1 vs2 /\
-     ctors_pre SUBMAP ctors
-     ==>
-     v_rel ctors (Closure vs1 n x)
-                 (Closure vs2 n (HD (compile_exps ctors_pre [x])))) /\
-  (!ctors vs1 fs x vs2 ctors_pre.
-     nv_rel ctors vs1 vs2 /\
-     ctors_pre SUBMAP ctors
-     ==>
-     v_rel ctors
-       (Recclosure vs1 fs x)
-       (Recclosure vs2
-         (MAP (\(n,m,e). (n,m,HD (compile_exps ctors_pre [e]))) fs) x)) /\
-  (!ctors. nv_rel ctors [] []) /\
-  (!ctors n v1 v2 vs1 vs2.
-     v_rel ctors v1 v2 /\
-     nv_rel ctors vs1 vs2
-     ==>
-     nv_rel ctors ((n,v1)::vs1) ((n,v2)::vs2))
-End
-
-Theorem v_rel_thms[simp]:
-   (v_rel ctors (Litv l) v <=> v = Litv l) /\
-   (v_rel ctors v (Litv l) <=> v = Litv l) /\
-   (v_rel ctors (Loc n) v  <=> v = Loc n) /\
-   (v_rel ctors v (Loc n)  <=> v = Loc n) /\
-   (v_rel ctors (Conv t x) v <=>
-     ?y. v = Conv t y /\ LIST_REL (v_rel ctors) x y /\
-     ok_ctor ctors v) /\
-   (v_rel ctors v (Conv t x) <=>
-     ?y. v = Conv t y /\ LIST_REL (v_rel ctors) y x /\
-     ok_ctor ctors v) /\
-   (v_rel ctors (Vectorv x) v <=>
-     ?y. v = Vectorv y /\ LIST_REL (v_rel ctors) x y) /\
-   (v_rel ctors v (Vectorv x) <=>
-     ?y. v = Vectorv y /\ LIST_REL (v_rel ctors) y x)
-Proof
-   rw [] \\ Cases_on `v` \\ rw [Once v_rel_cases, EQ_SYM_EQ, ok_ctor_def]
-   \\ Cases_on `t` \\ Cases_on `o'` \\ fs []
-   \\ every_case_tac \\ fs []
-   \\ metis_tac [SUBMAP_REFL, LIST_REL_EL_EQN, FLOOKUP_SUBMAP]
-QED
-
-Theorem v_rel_Boolv:
-  init_ctors SUBMAP ctors ==>
-  v_rel ctors (Boolv x) (Boolv x)
-Proof
-  Cases_on `x` \\ fs [Once v_rel_cases, Boolv_def] \\ rw []
-  \\ asm_exists_tac \\ fs [ok_ctor_def]
-  \\ EVAL_TAC \\ rw [lookup_def]
-QED
-
-Theorem nv_rel_LIST_REL:
-   !xs ys ctors.
-     nv_rel ctors xs ys <=>
-     LIST_REL (\(n1, v1) (n2, v2). n1 = n2 /\ v_rel ctors v1 v2) xs ys
-Proof
-  Induct \\ rw [Once (CONJUNCT2 v_rel_cases)]
-  \\ PairCases_on `h` \\ Cases_on `ys` \\ fs []
-  \\ PairCases_on `h` \\ fs [] \\ metis_tac []
-QED
-
-Theorem nv_rel_NIL[simp]:
-   nv_rel ctors [] []
-Proof
-rw [Once v_rel_cases]
-QED
-
-val ctor_rel_def = Define `
-  ctor_rel ctors (c : ((ctor_id # type_id) # num) set) <=>
-  !ty id arity.
-    ((id, SOME ty), arity) IN c <=>
-      ?ars max.
-        FLOOKUP ctors ty = SOME ars /\
-        lookup arity ars = SOME max /\
-        id < max`;
-
-val env_rel_def = Define `
-  env_rel ctors env1 env2 <=>
-   (* Value relation *)
-    nv_rel ctors env1.v env2.v`;
-
-val state_rel_def = Define `
-  state_rel check_ctor_rel ctors s1 s2 <=>
-    s1.clock = s2.clock /\
-    LIST_REL (sv_rel (v_rel ctors)) s1.refs s2.refs /\
-    s1.ffi = s2.ffi /\
-    LIST_REL (OPTREL (v_rel ctors)) s1.globals s2.globals ∧
-    (* Constructors *)
-    initial_ctors SUBSET s1.c /\
-    init_ctors SUBMAP ctors /\
-    (check_ctor_rel ⇒ ctor_rel ctors s1.c) /\
-    (* Flags *)
-    s1.check_ctor /\
-    s2.check_ctor /\
-    s1.c = s2.c /\
-    ~s1.exh_pat /\
-    s2.exh_pat`;
-
-val result_rel_def = Define `
-  (result_rel R ctors (Rval v1) (Rval v2) <=>
-    R ctors v1 v2) /\
-  (result_rel R ctors (Rerr (Rraise v1)) (Rerr (Rraise v2)) <=>
-    v_rel ctors v1 v2) /\
-  (result_rel R ctors (Rerr (Rabort e1)) (Rerr (Rabort e2)) <=>
-    e1 = e2) /\
-  (result_rel R ctors res1 res2 <=> F)`
-
-Theorem result_rel_thms[simp]:
-   (!ctors v1 r.
-     result_rel R ctors (Rval v1) r <=>
-     ?v2. r = Rval v2 /\ R ctors v1 v2) /\
-   (!ctors v2 r.
-     result_rel R ctors r (Rval v2) <=>
-     ?v1. r = Rval v1 /\ R ctors v1 v2) /\
-   (!ctors err r.
-     result_rel R ctors (Rerr err) r <=>
-       (?v1 v2.
-         err = Rraise v1 /\ r = Rerr (Rraise v2) /\
-         v_rel ctors v1 v2) \/
-       (?a.  err = Rabort a /\ r = Rerr (Rabort a))) /\
-   (!ctors err r.
-     result_rel R ctors r (Rerr err) <=>
-       (?v1 v2.
-         err = Rraise v2 /\ r = Rerr (Rraise v1) /\
-         v_rel ctors v1 v2) \/
-       (?a.  err = Rabort a /\ r = Rerr (Rabort a)))
-Proof
-  rpt conj_tac \\ ntac 2 gen_tac \\ Cases \\ rw [result_rel_def]
-  \\ Cases_on `e` \\ rw [result_rel_def]
-  \\ Cases_on `err` \\ fs [result_rel_def, EQ_SYM_EQ]
-QED
-
-val match_rel_def = Define `
-  (match_rel ctors (Match env1) (Match env2) <=> nv_rel ctors env1 env2) /\
-  (match_rel ctors No_match No_match <=> T) /\
-  (match_rel ctors Match_type_error Match_type_error <=> T) /\
-  (match_rel ctors _ _ <=> F)`
-
-Theorem match_rel_thms[simp]:
-   (match_rel ctors Match_type_error e <=> e = Match_type_error) /\
-   (match_rel ctors e Match_type_error <=> e = Match_type_error) /\
-   (match_rel ctors No_match e <=> e = No_match) /\
-   (match_rel ctors e No_match <=> e = No_match)
-Proof
-  Cases_on `e` \\ rw [match_rel_def]
-QED
-
-Theorem v_rel_v_to_char_list:
-   !v1 v2 xs ctors.
-     v_to_char_list v1 = SOME xs /\
-     v_rel ctors v1 v2
-     ==>
-     v_to_char_list v2 = SOME xs
-Proof
-  ho_match_mp_tac v_to_char_list_ind \\ rw []
-  \\ fs [v_to_char_list_def, case_eq_thms]
-  \\ rw [] \\ metis_tac []
-QED
-
-Theorem v_rel_v_to_list:
-   !v1 v2 xs ctors.
-     v_to_list v1 = SOME xs /\
-     v_rel ctors v1 v2
-     ==>
-     ?ys. v_to_list v2 = SOME ys /\
-          LIST_REL (v_rel ctors) xs ys
-Proof
-  ho_match_mp_tac v_to_list_ind \\ rw []
-  \\ fs [v_to_list_def, case_eq_thms] \\ rw []
-  \\ metis_tac []
-QED
-
-Theorem v_rel_vs_to_string:
-   !v1 v2 xs ctors.
-     vs_to_string v1 = SOME xs /\
-     LIST_REL (v_rel ctors) v1 v2
-     ==>
-     vs_to_string v2 = SOME xs
-Proof
-  ho_match_mp_tac vs_to_string_ind \\ rw []
-  \\ fs [vs_to_string_def, case_eq_thms] \\ rw []
-  \\ metis_tac []
-QED
-
-Theorem v_rel_list_to_v_APPEND:
-   !xs1 xs2 ctors ys1 ys2.
-     v_rel ctors (list_to_v xs1) (list_to_v xs2) /\
-     v_rel ctors (list_to_v ys1) (list_to_v ys2)
-     ==>
-     v_rel ctors (list_to_v (xs1 ++ ys1)) (list_to_v (xs2 ++ ys2))
-Proof
-  Induct \\ rw [] \\ fs [list_to_v_def]
-  \\ Cases_on `xs2` \\ fs [list_to_v_def, ok_ctor_def]
-QED
-
-Theorem v_rel_list_to_v:
-   !v1 v2 xs ys ctors.
-   v_to_list v1 = SOME xs /\
-   v_to_list v2 = SOME ys /\
-   v_rel ctors v1 v2
-   ==>
-   v_rel ctors (list_to_v xs) (list_to_v ys)
-Proof
-  ho_match_mp_tac v_to_list_ind \\ rw []
-  \\ fs [v_to_list_def, case_eq_thms] \\ rw []
-  \\ fs [list_to_v_def, ok_ctor_def]
-  \\ metis_tac []
-QED
-
-Theorem v_rel_Unitv[simp]:
-   v_rel ctors (Unitv cc) (Unitv cc)
-Proof
-  EVAL_TAC
-  \\ rw[v_rel_cases]
-  \\ EVAL_TAC
-  \\ rw[]
-QED
-
-Theorem nv_rel_ALOOKUP_v_rel:
-   !xs ys ctors n x.
-     nv_rel ctors xs ys /\
-     ALOOKUP xs n = SOME x
-     ==>
-     ?y.
-     ALOOKUP ys n = SOME y /\ v_rel ctors x y
-Proof
-  Induct \\ rw []
-  \\ qhdtm_x_assum `nv_rel` mp_tac
-  \\ rw [Once (CONJUNCT2 v_rel_cases)]
-  \\ fs [ALOOKUP_def, bool_case_eq]
-QED
-
-(* ------------------------------------------------------------------------- *)
-(* Various semantics preservation theorems                                   *)
-(* ------------------------------------------------------------------------- *)
-
-Theorem do_eq_thm:
-   (!v1 v2 r ctors v1' v2'.
-     do_eq v1 v2 = r /\
-     r <> Eq_type_error /\
-     v_rel ctors v1 v1' /\
-     v_rel ctors v2 v2'
-     ==>
-     do_eq v1' v2' = r) /\
-   (!vs1 vs2 r ctors vs1' vs2'.
-     do_eq_list vs1 vs2 = r /\
-     r <> Eq_type_error /\
-     LIST_REL (v_rel ctors) vs1 vs1' /\
-     LIST_REL (v_rel ctors) vs2 vs2'
-     ==>
-     do_eq_list vs1' vs2' = r)
-Proof
-  ho_match_mp_tac do_eq_ind \\ rw [do_eq_def] \\ fs [] \\ rw [do_eq_def]
-  \\ TRY (metis_tac [LIST_REL_LENGTH])
-  \\ TRY
-   (rpt (qhdtm_x_assum `v_rel` mp_tac \\ rw [Once v_rel_cases])
-    \\ rw [do_eq_def] \\ NO_TAC)
-  \\ every_case_tac \\ fs [] \\ res_tac \\ fs []
-QED
-
-Theorem pmatch_thm:
-  (!(s:'ffi state) p v vs r ctors s1 v1 vs1.
-     pmatch s p v vs = r /\
-     r <> Match_type_error /\
-     state_rel T ctors s s1 ∧
-     v_rel ctors v v1 /\
-     nv_rel ctors vs vs1
-     ==>
-     ?r1.
-       pmatch s1 p v1 vs1 = r1 /\
-       match_rel ctors r r1) /\
-  (!(s:'ffi state) ps v vs r ctors s1 v1 vs1.
-     pmatch_list s ps v vs = r /\
-     r <> Match_type_error /\
-     state_rel T ctors s s1 ∧
-     LIST_REL (v_rel ctors) v v1 /\
-     nv_rel ctors vs vs1
-     ==>
-     ?r1.
-       pmatch_list s1 ps v1 vs1 = r1 /\
-       match_rel ctors r r1)
-Proof
-  ho_match_mp_tac pmatch_ind \\ rw [pmatch_def]
-  \\ rw [match_rel_def, Once v_rel_cases]
-  \\ fsrw_tac [DNF_ss] [] \\ rfs [] \\ rw [pmatch_def]
-  \\ rfs [] \\ fs []
-  \\ TRY (metis_tac [state_rel_def, same_ctor_def, ctor_same_type_def])
-  \\ imp_res_tac LIST_REL_LENGTH \\ fs []
-  >-
-   (every_case_tac \\ fs [state_rel_def, store_lookup_def]
-    \\ fs [LIST_REL_EL_EQN]
-    \\ metis_tac [sv_rel_def])
-  \\ every_case_tac \\ fs [] \\ rfs []
-  \\ last_x_assum drule \\ rpt (disch_then drule) \\ rw [] \\ fs []
-  \\ metis_tac [match_rel_def]
-QED
-
-Theorem do_opapp_thm:
-   do_opapp vs1 = SOME (nvs1, e) /\
-   LIST_REL (v_rel ctors) vs1 vs2
-   ==>
-   ?ctors_pre nvs2.
-     nv_rel ctors nvs1 nvs2 /\
-     ctors_pre SUBMAP ctors /\
-     do_opapp vs2 = SOME (nvs2, HD (compile_exps ctors_pre [e]))
-Proof
-  simp [do_opapp_def, pair_case_eq, case_eq_thms, PULL_EXISTS]
-  \\ rw [] \\ fs [PULL_EXISTS] \\ rw [] \\ fs []
-  \\ fs [Once v_rel_cases] \\ rw [] \\ fs [PULL_EXISTS]
-  \\ TRY
-   (qpat_x_assum `ok_ctor _ (Conv t v1)` mp_tac
-    \\ Cases_on `t` \\ fs [ok_ctor_def]
-    >- metis_tac []
-    \\ PairCases_on `x` \\ fs []
-    \\ Cases_on `x1` \\ fs [] \\ rw []
-    \\ metis_tac [LIST_REL_LENGTH, flookup_thm, FLOOKUP_SUBMAP])
-  \\ TRY (simp [Once v_rel_cases] \\ metis_tac [])
-  \\ simp [compile_exps_find_recfun]
-  \\ simp [AC CONJ_ASSOC CONJ_COMM]
-  \\ fs [FST_triple, MAP_MAP_o, ETA_THM, o_DEF, LAMBDA_PROD, UNCURRY]
-  \\ fs [build_rec_env_merge, nv_rel_LIST_REL]
-  \\ qexists_tac `ctors_pre` \\ fs []
-  \\ TRY
-   (match_mp_tac EVERY2_APPEND_suff \\ fs [EVERY2_MAP]
-    \\ match_mp_tac EVERY2_refl \\ rw [UNCURRY]
-    \\ simp [Once v_rel_cases, nv_rel_LIST_REL]
-    \\ metis_tac [])
-  \\ fs [AC CONJ_ASSOC CONJ_COMM]
-  \\ TRY
-   (qpat_x_assum `ok_ctor _ (Conv t _)` mp_tac
-    \\ simp [ok_ctor_def]
-    \\ fs [ok_ctor_def] \\ rw []
-    >- metis_tac [FLOOKUP_SUBMAP, LIST_REL_LENGTH])
-  \\ TRY (conj_tac >- (simp [Once v_rel_cases, nv_rel_LIST_REL] \\ metis_tac []))
-  \\ match_mp_tac EVERY2_APPEND_suff \\ fs [EVERY2_MAP]
-  \\ match_mp_tac EVERY2_refl \\ rw [UNCURRY]
-  \\ simp [Once v_rel_cases, nv_rel_LIST_REL] \\ metis_tac []
-QED
-
-val store_v_same_type_cases = Q.prove (
-  `(!v r. store_v_same_type (Refv v) r <=> ?v1. r = Refv v1) /\
-   (!v r. store_v_same_type r (Refv v) <=> ?v1. r = Refv v1) /\
-   (!v r. store_v_same_type (Varray v) r <=> ?v1. r = Varray v1) /\
-   (!v r. store_v_same_type r (Varray v) <=> ?v1. r = Varray v1) /\
-   (!v r. store_v_same_type (W8array v) r <=> ?v1. r = W8array v1) /\
-   (!v r. store_v_same_type r (W8array v) <=> ?v1. r = W8array v1)`,
-  rpt conj_tac \\ gen_tac \\ Cases \\ rw [store_v_same_type_def]);
-
-Theorem do_app_thm:
-   do_app cc s1 op vs1 = SOME (t1, r1) /\
-   init_ctors SUBMAP ctors /\
-   state_rel T ctors s1 s2 /\
-   LIST_REL (v_rel ctors) vs1 vs2
-   ==>
-   ?t2 r2.
-     result_rel v_rel ctors r1 r2 /\
-     state_rel T ctors t1 t2 /\
-     do_app cc s2 op vs2 = SOME (t2, r2)
-Proof
-  rpt strip_tac \\ qhdtm_x_assum `do_app` mp_tac
-  \\ Cases_on `op = Opb Lt \/ op = Opb Gt \/ op = Opb Leq \/ op = Opb Geq \/
-               op = Opn Plus \/ op = Opn Minus \/ op = Opn Times \/
-               op = Opn Divide \/ op = Opn Modulo`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ fs [opb_lookup_def, v_rel_Boolv]
-    \\ rw [div_exn_v_def, Once v_rel_cases, ok_ctor_def] \\ metis_tac [])
-  \\ Cases_on `(?sz. op = Opw sz Andw \/ op = Opw sz Orw \/ op = Opw sz Xor \/
-                     op = Opw sz Add \/ op = Opw sz Sub) \/
-               (?sz s k. op = Shift sz s k)`
-  >-
-   (fs [] \\ fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS]
-    \\ rw [] \\ fs [])
-  \\ Cases_on `op = Equality`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ imp_res_tac do_eq_thm \\ fs [v_rel_Boolv])
-  \\ Cases_on `(?f. op = FP_cmp f) \/ (?f. op = FP_bop f) \/
-               (?f. op = FP_uop f)`
-  >-
-   (fs [] \\ fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS]
-    \\ rw [] \\ fs [v_rel_Boolv])
-  \\ Cases_on `op = Opapp`
-  >- (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS])
-  \\ Cases_on `op = Opassign \/ op = Opderef`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS]
-    \\ rw [] \\ fs [] \\ rw []
-    \\ rpt (pairarg_tac \\ fs []) \\ rveq \\ fs []
-    \\ fs [store_alloc_def, store_lookup_def, store_assign_def, state_rel_def,
-           LIST_REL_EL_EQN, store_v_same_type_cases] \\ rw []
-    \\ fs [EL_LUPDATE] \\ rw [] \\ fs []
-    \\ rename1 `nnn < LENGTH _.refs`
-    \\ last_x_assum (qspec_then `nnn` mp_tac) \\ fs []
-    \\ rw [Once sv_rel_cases] \\ fs [ok_ctor_def])
-  \\ Cases_on `op = Opref`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ rpt (pairarg_tac \\ fs [])
-    \\ fs [store_alloc_def, state_rel_def, LIST_REL_EL_EQN]
-    \\ rw [] \\ fs []
-    \\ rename1 `nnn < _`
-    \\ rw [EL_APPEND_EQN]
-    \\ qmatch_goalsub_abbrev_tac `EL x [_]`
-    \\ `x = 0` by fs [Abbr`x`] \\ fs [])
-  \\ Cases_on `op = Aw8alloc`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    >- (rw [Once v_rel_cases, subscript_exn_v_def, ok_ctor_def] \\ metis_tac [])
-    \\ rpt (pairarg_tac \\ fs []) \\ rveq
-    \\ fs [store_alloc_def, state_rel_def, LIST_REL_EL_EQN] \\ rveq \\ fs []
-    \\ rw [EL_APPEND_EQN]
-    \\ qmatch_goalsub_abbrev_tac `EL x _`
-    \\ `x = 0` by fs [Abbr`x`] \\ fs [])
-  \\ Cases_on `op = Aw8sub \/ op = Aw8length \/ op = Aw8update \/
-               op = Aw8sub_unsafe \/ op = Aw8update_unsafe`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ rw [Once v_rel_cases, subscript_exn_v_def]
-    \\ fs [store_lookup_def, state_rel_def, LIST_REL_EL_EQN] \\ rveq \\ fs []
-    \\ rename1 `EL n _ = _`
-    \\ last_assum (qspec_then `n` mp_tac)
-    \\ (impl_tac >- fs [])
-    \\ simp_tac std_ss [Once sv_rel_cases] \\ rw []
-    \\ fs [store_assign_def, store_v_same_type_cases]
-    \\ every_case_tac \\ fs [] \\ rveq \\ fs []
-    \\ rw [EL_LUPDATE, ok_ctor_def]
-    \\ metis_tac [])
-  \\ Cases_on `(?sz. op = WordFromInt sz) \/ (?sz. op = WordToInt sz)`
-  >- (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs [])
-  \\ Cases_on `op = CopyStrStr`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ rw [Once v_rel_cases, subscript_exn_v_def, ok_ctor_def]
-    \\ metis_tac [])
-  \\ Cases_on `op = CopyStrAw8`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ fs [store_lookup_def, store_assign_def, store_v_same_type_cases,
-           state_rel_def, LIST_REL_EL_EQN] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ rw [Once v_rel_cases, subscript_exn_v_def, ok_ctor_def]
-    \\ last_assum (qspec_then `dst` mp_tac)
-    \\ (impl_tac >- fs [])
-    \\ simp_tac std_ss [Once sv_rel_cases] \\ rw [EL_LUPDATE] \\ rw []
-    \\ metis_tac [])
-  \\ Cases_on `op = CopyAw8Str`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ fs [store_lookup_def, state_rel_def, LIST_REL_EL_EQN] \\ rw []
-    \\ fs [PULL_EXISTS] \\ rw [Once v_rel_cases, subscript_exn_v_def]
-    \\ last_assum (qspec_then `src` mp_tac)
-    \\ (impl_tac >- fs [])
-    \\ simp_tac std_ss [Once sv_rel_cases] \\ rw []
-    \\ rw [ok_ctor_def] \\ metis_tac [])
-  \\ Cases_on `op = CopyAw8Aw8`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ fs [store_lookup_def, state_rel_def, store_assign_def,
-           store_v_same_type_cases, LIST_REL_EL_EQN] \\ rw []
-    \\ fs [PULL_EXISTS] \\ rw [Once v_rel_cases, subscript_exn_v_def]
-    \\ rename1 `EL src _ = _ ws` \\ rename1 `EL dst _ = _ ds`
-    \\ last_assum (qspec_then `dst` mp_tac)
-    \\ (impl_tac >- fs [])
-    \\ simp_tac std_ss [Once sv_rel_cases] \\ rw []
-    \\ last_assum (qspec_then `src` mp_tac)
-    \\ (impl_tac >- fs [])
-    \\ simp_tac std_ss [Once sv_rel_cases] \\ rw []
-    \\ rw [EL_LUPDATE]
-    \\ rw [ok_ctor_def] \\ metis_tac [])
-  \\ Cases_on `op = Ord \/ op = Chr \/ op = Chopb Lt \/ op = Chopb Gt \/
-               op = Chopb Leq \/ op = Chopb Geq`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ fs [opb_lookup_def, v_rel_Boolv]
-    \\ rw [Once v_rel_cases, chr_exn_v_def, ok_ctor_def]
-    \\ metis_tac [])
-  \\ Cases_on `op = Implode \/ op = Strsub \/ op = Strlen \/ op = Strcat`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ rw [Once v_rel_cases, subscript_exn_v_def, ok_ctor_def]
-    \\ metis_tac [v_rel_v_to_char_list, v_rel_vs_to_string, v_rel_v_to_list])
-  \\ Cases_on `op = Explode`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ rename [`MAP (λc. Litv (Char c)) str`] \\ pop_assum kall_tac
-    \\ Induct_on `str`
-    \\ simp [Once v_rel_cases,list_to_v_def,ok_ctor_def]
-    \\ rw [] THEN1 (asm_exists_tac  \\ fs [] \\ EVAL_TAC \\ fs [lookup_def])
-    \\ goal_assum (first_assum o mp_then Any mp_tac)
-    \\ fs [EVAL ``FLOOKUP init_ctors list_id``,lookup_def] \\ EVAL_TAC)
-  \\ Cases_on `op = VfromList \/ op = Vsub \/ op = Vlength`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ rw [subscript_exn_v_def, ok_ctor_def] \\ fs [LIST_REL_EL_EQN]
-    \\ metis_tac [v_rel_v_to_list, LIST_REL_EL_EQN])
-  \\ Cases_on `op = Aalloc`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ rw [subscript_exn_v_def, ok_ctor_def]
-    \\ rpt (pairarg_tac \\ fs [])
-    \\ fs [store_alloc_def, store_v_same_type_cases, state_rel_def,
-           LIST_REL_EL_EQN] \\ rw [] \\ fs []
-    \\ rw [EL_APPEND_EQN]
-    \\ qmatch_goalsub_abbrev_tac `EL x _`
-    \\ `x = 0` by fs [Abbr`x`] \\ fs []
-    \\ rw [LIST_REL_REPLICATE_same])
-  \\ Cases_on `op = Asub \/ op = Alength \/ op = Asub_unsafe`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ rw [subscript_exn_v_def, ok_ctor_def]
-    \\ fs [store_lookup_def, state_rel_def, LIST_REL_EL_EQN] \\ rw [] \\ fs []
-    \\ fs [PULL_EXISTS]
-    \\ rename1 `EL nnn _ = _`
-    \\ last_assum (qspec_then `nnn` mp_tac)
-    \\ (impl_tac >- fs [])
-    \\ simp_tac std_ss [Once sv_rel_cases] \\ rw [] \\ fs []
-    \\ fs [LIST_REL_EL_EQN])
-  \\ Cases_on `op = Aupdate \/ op = Aupdate_unsafe`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ rw [subscript_exn_v_def, ok_ctor_def]
-    \\ fs [store_lookup_def, store_assign_def, store_v_same_type_cases,
-           state_rel_def, LIST_REL_EL_EQN] \\ rw [] \\ fs []
-    \\ fs [PULL_EXISTS]
-    \\ rename1 `EL nnn _ = _`
-    \\ last_assum (qspec_then `nnn` mp_tac)
-    \\ (impl_tac >- fs [])
-    \\ simp_tac std_ss [Once sv_rel_cases] \\ rw [] \\ fs []
-    \\ fs [LIST_REL_EL_EQN]
-    \\ rfs [] \\ rveq \\ fs []
-    \\ rw [EL_LUPDATE] \\ fs [LIST_REL_EL_EQN] \\ rw []
-    \\ rw [EL_LUPDATE] \\ rw [ok_ctor_def])
-  \\ Cases_on `op = ConfigGC`
-  >- (fs [do_app_def, case_eq_thms, pair_case_eq] \\ rw [] \\ fs [ok_ctor_def])
-  \\ Cases_on `?s. op = FFI s`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ fs [store_lookup_def, store_assign_def, store_v_same_type_cases,
-           state_rel_def, LIST_REL_EL_EQN] \\ rw [] \\ fs [] \\ rw [] \\ fs []
-    \\ rename1 `EL nnn _ = _`
-    \\ last_assum (qspec_then `nnn` mp_tac)
-    \\ impl_tac >- fs []
-    \\ simp_tac std_ss [Once sv_rel_cases] \\ rw []
-    \\ rfs [] \\ rw []
-    \\ rw [EL_LUPDATE] \\ rw [ok_ctor_def])
-  \\ Cases_on `op = ListAppend`
-  >-
-   (fs [do_app_def, case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ rw []
-    \\ imp_res_tac v_rel_v_to_list \\ fs []
-    \\ metis_tac [v_rel_list_to_v, v_rel_list_to_v_APPEND])
-  \\ Cases_on `?opn. op = Opn opn` >- (fs [] \\ Cases_on `opn` \\ fs [])
-  \\ Cases_on `?opb. op = Opb opb` >- (fs [] \\ Cases_on `opb` \\ fs [])
-  \\ Cases_on `?s opw. op = Opw s opw` >- (fs [] \\ Cases_on `opw` \\ fs [])
-  \\ Cases_on `?opb. op = Chopb opb` >- (fs [] \\ Cases_on `opb` \\ fs [])
-  \\ Cases_on `op` \\ fs [] \\ rw []
-  \\ fs [do_app_def, pair_case_eq, case_eq_thms] \\ rw [] \\ fs []
-  \\ fs [state_rel_def, LIST_REL_EL_EQN] \\ rw [] \\ fs []
-  \\ fs [OPTREL_def, EL_LUPDATE, EL_APPEND_EQN] \\ rw [] \\ fs [EL_REPLICATE]
-  \\ first_x_assum (qspec_then `n` mp_tac) \\ rw [] \\ fs []
-  \\ rw [ok_ctor_def]
-QED
-
-(* ------------------------------------------------------------------------- *)
-(* Compile expressions                                                       *)
-(* ------------------------------------------------------------------------- *)
-
-Theorem is_unconditional_thm:
-   !p env refs v vs.
-     is_unconditional p
-     ==>
-     pmatch s p v vs <> No_match
-Proof
-  ho_match_mp_tac is_unconditional_ind \\ rw []
-  \\ pop_assum mp_tac
-  \\ once_rewrite_tac [is_unconditional_def]
-  \\ CASE_TAC \\ fs [pmatch_def]
-  \\ TRY CASE_TAC \\ fs [] \\ rw []
-  \\ Cases_on `v` \\ fs [pmatch_def]
-  \\ rpt CASE_TAC \\ fs []
-  \\ rename1 `Conv t ls`
-  \\ Cases_on `t` \\ rw [pmatch_def]
-  \\ rpt (pop_assum mp_tac)
-  \\ map_every qid_spec_tac [`env`,`refs`,`ls`,`vs`,`l`]
-  \\ Induct \\ rw [pmatch_def]
-  \\ fsrw_tac [DNF_ss] []
-  \\ Cases_on `ls` \\ fs [pmatch_def]
-  \\ CASE_TAC \\ fs []
-  \\ res_tac \\ fs []
-QED
-
-Theorem is_unconditional_list_thm:
-  !vs1 vs2 a c.
-   EVERY is_unconditional vs1
-   ==>
-   pmatch_list a vs1 vs2 c <> No_match
-Proof
-  Induct >- (Cases \\ rw [pmatch_def])
-  \\ gen_tac \\ Cases \\ rw [pmatch_def]
-  \\ every_case_tac \\ fs []
-  \\ metis_tac [is_unconditional_thm]
-QED
-
-val exists_match_def = Define `
-  exists_match s ps v <=>
-    !vs. ?p. MEM p ps /\ pmatch s p v vs <> No_match`
-
-Theorem get_dty_tags_thm:
-   !pats tags res.
-     get_dty_tags pats tags = SOME res
-     ==>
-       (!pat.
-         MEM pat pats ==>
-           ?cid tyid ps left.
-             pat = Pcon (SOME (cid, SOME tyid)) ps /\
-             EVERY is_unconditional ps /\
-             lookup (LENGTH ps) res = SOME left /\
-             cid NOTIN domain left) /\
-       (!arity ts.
-         lookup arity tags = SOME ts ==>
-           ?left.
-             lookup arity res = SOME left /\
-             domain left SUBSET domain ts /\
-             (!tag.
-               tag IN domain ts /\
-               tag NOTIN domain left ==>
-                 ?ps' tyid'.
-                   MEM (Pcon (SOME (tag, SOME tyid')) ps') pats /\
-                   EVERY is_unconditional ps' /\
-                   LENGTH ps' = arity))
-Proof
-  Induct \\ simp [get_dty_tags_def]
-  \\ Cases \\ fs []
-  \\ ntac 3 (PURE_TOP_CASE_TAC \\ fs [])
-  \\ rpt gen_tac
-  \\ rw [] \\ fs [case_eq_thms] \\ first_x_assum drule \\ rw []
-  >-
-   (first_x_assum (qspec_then `LENGTH l` mp_tac)
-    \\ simp [lookup_insert]
-    \\ rw [SUBSET_DEF]
-    \\ metis_tac [])
-  \\ first_x_assum (qspec_then `arity` mp_tac)
-  \\ simp [lookup_insert]
-  \\ rw [] \\ fs [SUBSET_DEF] \\ rw []
-  \\ metis_tac []
-QED
-
-val pmatch_Pcon_No_match = Q.prove(
-  `s.check_ctor /\
-   EVERY is_unconditional ps
-   ==>
-   ((pmatch s (Pcon (SOME (c1,t)) ps) v bindings = No_match) <=>
-     ?c2 vs.
-       v = Conv (SOME (c2,t)) vs /\
-       ((c1,t), LENGTH ps) IN s.c /\
-       (LENGTH ps = LENGTH vs ==> c1 <> c2))`,
-  Cases_on `v` \\ fs [pmatch_def]
-  \\ Cases_on `o'` \\ fs [pmatch_def]
-  \\ PairCases_on `x` \\ fs [pmatch_def]
-  \\ rw [ctor_same_type_def, same_ctor_def] \\ fs []
-  \\ metis_tac [is_unconditional_list_thm]);
-
-Theorem exhaustive_exists_match:
-  !ctors ps s.
-     exhaustive_match ctors ps /\
-     s.check_ctor /\
-     ctor_rel ctors env.c
-     ==>
-     !refs v. ok_ctor ctors v ==> exists_match s ps v
-Proof
-  rw [exhaustive_match_def, exists_match_def]
-  >- (fs [EXISTS_MEM] \\ metis_tac [is_unconditional_thm])
-  \\ every_case_tac \\ fs [get_dty_tags_def, case_eq_thms]
-  \\ rfs [lookup_map] \\ rveq
-  \\ qpat_abbrev_tac `pp = Pcon X l`
-  \\ Cases_on `v`
-  \\ TRY (qexists_tac `pp` \\ fs [Abbr`pp`, pmatch_def] \\ NO_TAC)
-  \\ rename1 `Conv c1 l1`
-  \\ fsrw_tac [DNF_ss] []
-  \\ simp [METIS_PROVE [] ``a \/ b <=> ~a ==> b``]
-  \\ rw [Abbr`pp`, pmatch_Pcon_No_match]
-  \\ rename1 `FLOOKUP _ _ = SOME ars`
-  \\ rename1 `get_dty_tags _ _ = SOME res` \\ fs []
-  \\ imp_res_tac get_dty_tags_thm
-  \\ first_x_assum (qspec_then `LENGTH l1` mp_tac o CONV_RULE SWAP_FORALL_CONV)
-  \\ fs [ctor_rel_def]
-  \\ last_x_assum (qspec_then `x` assume_tac) \\ rfs []
-  \\ fs [ok_ctor_def] \\ rw [lookup_insert]
-  \\ fs [domain_fromList, lookup_map, SUBSET_DEF, PULL_EXISTS] \\ rfs []
-  \\ fs [EVERY_MEM, MEM_toList, PULL_EXISTS] \\ rveq
-  \\ first_x_assum (qspec_then `c2` mp_tac o PURE_ONCE_REWRITE_RULE [EQ_SYM_EQ])
-  \\ res_tac \\ fs [] \\ rw [] \\ res_tac
-  \\ asm_exists_tac
-  \\ rw [pmatch_def, same_ctor_def, ctor_same_type_def]
-  \\ metis_tac [EVERY_MEM, is_unconditional_list_thm]
-QED
-
-Theorem v_rel_ok_ctor:
-   v_rel ctors v1 v2
-   ==>
-   ok_ctor ctors v1 /\ ok_ctor ctors v2
-Proof
-  Cases_on `v1` \\ Cases_on `v2` \\ rw [ok_ctor_def]
-  \\ metis_tac [LIST_REL_LENGTH]
-QED
-
-val s1 = mk_var ("s1",
-  ``flatSem$evaluate`` |> type_of |> strip_fun |> snd
-  |> dest_prod |> fst);
-
-Theorem compile_exps_evaluate:
-  (!env1 ^s1 xs t1 r1.
-    evaluate env1 s1 xs = (t1, r1) /\
-    r1 <> Rerr (Rabort Rtype_error)
-    ==>
-    !ctors env2 s2 ctors_pre.
-      env_rel ctors env1 env2 /\
-      state_rel T ctors s1 s2 /\
-      ctors_pre SUBMAP ctors
-      ==>
-      ?t2 r2.
-        result_rel (LIST_REL o v_rel) ctors r1 r2 /\
-        state_rel T ctors t1 t2 /\
-        evaluate env2 s2 (compile_exps ctors_pre xs) = (t2, r2)) /\
-  (!env1 ^s1 v ps err_v t1 r1.
-    evaluate_match env1 s1 v ps err_v = (t1, r1) /\
-    r1 <> Rerr (Rabort Rtype_error)
-    ==>
-    !ps2 is_handle ctors env2 s2 v2 tr err_v2 ctors_pre.
-      env_rel ctors env1 env2 /\
-      state_rel T ctors s1 s2 /\
-      ctors_pre SUBMAP ctors /\
-      v_rel ctors v v2 /\
-      v_rel ctors err_v err_v2 /\
-      (is_handle  ==> err_v = v) /\
-      (~is_handle ==> err_v = bind_exn_v) /\
-      (ps2 = add_default tr is_handle F ps \/
-       exists_match s1 (MAP FST ps) v /\
-       ps2 = add_default tr is_handle T ps)
-      ==>
-      ?t2 r2.
-        result_rel (LIST_REL o v_rel) ctors r1 r2 /\
-        state_rel T ctors t1 t2 /\
-        evaluate_match env2 s2 v2
-          (MAP (\(p,e). (p, HD (compile_exps ctors_pre [e]))) ps2)
-          err_v2 = (t2, r2))
-Proof
-  ho_match_mp_tac evaluate_ind
-  \\ rw [compile_exps_def, evaluate_def] \\ fs [result_rel_def]
-  >-
-   (simp [Once evaluate_cons]
-    \\ fs [case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ rpt (first_x_assum drule \\ rpt (disch_then drule) \\ rw [])
-    \\ imp_res_tac evaluate_sing \\ fs [] \\ rw [])
-  >-
-   (fs [case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ rpt (first_x_assum drule \\ rpt (disch_then drule) \\ rw [])
-    \\ imp_res_tac evaluate_sing \\ fs [] \\ rw [])
-  >- (* Handle *)
-   (fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ first_x_assum drule \\ rpt (disch_then drule) \\ rw [] \\ fs []
-    \\ last_x_assum match_mp_tac \\ fs [add_default_def, state_rel_def]
-    \\ qexists_tac `T` \\ rw []
-    \\ metis_tac [exhaustive_exists_match, exhaustive_SUBMAP, v_rel_ok_ctor])
-  >-
-   (fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ fs [case_eq_thms, pair_case_eq, PULL_EXISTS]
-    \\ first_x_assum drule
-    \\ rpt (disch_then drule) \\ rw [] \\ fs []
-    \\ fsrw_tac [DNF_ss] [state_rel_def, ok_ctor_def])
-  >- fs [state_rel_def]
-  >- (* Con *)
-   (fs [case_eq_thms, pair_case_eq, bool_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ qpat_x_assum `_ ==> _` mp_tac
-    \\ (impl_keep_tac >- fs [state_rel_def])
-    \\ rpt (disch_then drule) \\ rfs [] \\ fs [compile_exps_LENGTH]
-    \\ fsrw_tac [DNF_ss] [state_rel_def] \\ rw []
-    \\ rw [ok_ctor_def]
-    \\ metis_tac [LIST_REL_LENGTH, evaluate_length, LENGTH_REVERSE, ctor_rel_def])
-  >-
-   (every_case_tac \\ fs [] \\ rw [] \\ fs [env_rel_def]
-    \\ map_every imp_res_tac [nv_rel_ALOOKUP_v_rel, LIST_REL_MEM_IMP] \\ rfs [])
-  >- (simp [Once v_rel_cases] \\ metis_tac [env_rel_def])
-  >- (* App *)
-   (fs [case_eq_thms, pair_case_eq, bool_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ last_x_assum drule
-    \\ rpt (disch_then drule) \\ rw [] \\ fs []
-    \\ rpt (qpat_x_assum `(_,_) = _` (assume_tac o GSYM)) \\ fs []
-    \\ imp_res_tac EVERY2_REVERSE
-    >- metis_tac [do_opapp_thm, state_rel_def]
-    >-
-     (drule (GEN_ALL do_opapp_thm) \\ disch_then drule \\ rw [] \\ fs []
-      \\ `env_rel ctors (env1 with v := env') (env2 with v := nvs2)`
-        by (fs [env_rel_def] \\ rfs [] \\ fs [])
-      \\ `state_rel T ctors (dec_clock s') (dec_clock t2)`
-        by (fs [state_rel_def, dec_clock_def] >> metis_tac [])
-      \\ first_x_assum drule \\ rpt (disch_then drule) \\ fs [] \\ rw []
-      \\ fs [state_rel_def] >> metis_tac [])
-    \\ drule (GEN_ALL do_app_thm)
-    \\ disch_then (qspecl_then [`REVERSE v2`,`t2`,`ctors`] mp_tac)
-    \\ fs [env_rel_def] \\ rw [] \\ fs [] >>
-    `init_ctors ⊑ ctors` by fs [state_rel_def] >>
-    fs [] >>
-    Cases_on `r` \\ Cases_on `r2` \\ fs [evaluateTheory.list_result_def] >>
-    fs [PULL_EXISTS, state_rel_def] >> rfs [])
-  >- (* If *)
-   (fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ first_x_assum drule \\ rpt (disch_then drule) \\ rw [] \\ fs []
-    \\ imp_res_tac evaluate_sing \\ fs [] \\ rveq \\ fs []
-    \\ rpt (disch_then drule) \\ rw [] \\ fs []
-    \\ fs [do_if_def, bool_case_eq, Boolv_def] \\ rw [] \\ fs [])
-  >- (* Mat *)
-   (fs [case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ first_x_assum drule \\ rpt (disch_then drule) \\ rw []
-    \\ imp_res_tac evaluate_sing \\ fs [] \\ rw []
-    \\ last_x_assum drule \\ rpt (disch_then drule)
-    \\ disch_then match_mp_tac
-    \\ qexists_tac `F` \\ rw [add_default_def] \\ fs [bind_exn_v_def]
-    \\ rw [ok_ctor_def]
-    \\ metis_tac [exhaustive_exists_match, state_rel_def, exhaustive_SUBMAP,
-                  v_rel_ok_ctor])
-  >- (* Let *)
-   (fs [case_eq_thms, pair_case_eq, PULL_EXISTS] \\ rw [] \\ fs []
-    \\ first_x_assum drule \\ rpt (disch_then drule) \\ rw [] \\ fs [PULL_EXISTS]
-    \\ last_x_assum match_mp_tac
-    \\ fs [env_rel_def]
-    \\ imp_res_tac evaluate_sing \\ fs [] \\ rw [] \\ fs []
-    \\ fs [libTheory.opt_bind_def] \\ PURE_CASE_TAC \\ fs []
-    \\ simp [Once v_rel_cases])
-  >- (* Letrec *)
-   (rw [] \\ TRY (metis_tac [compile_exps_MAP_FST])
-    \\ first_x_assum match_mp_tac \\ fs [env_rel_def]
-    \\ simp [nv_rel_LIST_REL, LIST_REL_EL_EQN]
-    \\ fs [build_rec_env_merge]
-    \\ conj_asm1_tac >- fs [env_rel_def, LIST_REL_EL_EQN, nv_rel_LIST_REL]
-    \\ fs [EL_APPEND_EQN] \\ rw [] \\ fs [EL_MAP] \\ fs [ELIM_UNCURRY]
-    >- (simp [Once v_rel_cases, MAP_EQ_f, ELIM_UNCURRY] \\ metis_tac [])
-    \\ fs [env_rel_def, nv_rel_LIST_REL, LIST_REL_EL_EQN, ELIM_UNCURRY])
-  >-
-   (fs [add_default_def] \\ fs [PULL_EXISTS]
-    \\ rw [evaluate_def, pat_bindings_def, pmatch_def, compile_exps_def,
-           exists_match_def] \\ fs [state_rel_def]
-    \\ rw [] \\ fs [] \\ EVAL_TAC
-    \\ fs [initial_ctors_def, SUBSET_DEF] \\ rfs [])
-  >- fs [exists_match_def]
-  >-
-   (`LIST_REL (sv_rel (v_rel ctors)) s1.refs s2.refs` by fs [state_rel_def]
-    \\ reverse every_case_tac \\ fs []
-    \\ drule (CONJUNCT1 pmatch_thm) \\ fs []
-    \\ rpt (disch_then drule)
-    \\ disch_then (qspecl_then [`[]`] mp_tac)
-    \\ (impl_tac >- simp [Once v_rel_cases])
-    \\ rw []
-    >-
-     (Cases_on `pmatch s2 p v2 []` \\ fs [match_rel_def]
-      \\ `env_rel ctors <|v := a ++ env1.v|> <|v := a' ++ env2.v|>` by
-       (fs [env_rel_def, nv_rel_LIST_REL]
-        \\ match_mp_tac EVERY2_APPEND_suff \\ fs [])
-      \\ first_x_assum drule
-      \\ rpt (disch_then drule)
-      \\ rw [] \\ fs []
-      \\ rw [add_default_def] \\ fs [compile_exps_def, evaluate_def])
-    \\ first_x_assum drule
-    \\ rpt (disch_then drule)
-    \\ disch_then (qspec_then `tr` mp_tac o CONV_RULE SWAP_FORALL_CONV) \\ fs []
-    \\ qpat_abbrev_tac `ps2 = add_default X Y F ps`
-    \\ qpat_abbrev_tac `ps3 = add_default X Y T ps`
-    \\ strip_tac
-    \\ first_assum (qspec_then `ps2` mp_tac)
-    \\ simp_tac std_ss []
-    \\ strip_tac \\ fs []
-    \\ first_x_assum (qspec_then `ps3` mp_tac)
-    \\ rw [] \\ fs [Abbr`ps2`, Abbr`ps3`]
-    \\ rfs [add_default_def] \\ rw [] \\ fs [evaluate_def])
-  \\ `LIST_REL (sv_rel (v_rel ctors)) s1.refs s2.refs` by fs [state_rel_def]
-  \\ reverse every_case_tac \\ fs []
-  \\ drule (CONJUNCT1 pmatch_thm) \\ fs []
-  \\ rpt (disch_then drule)
-  \\ disch_then (qspecl_then [`[]`] mp_tac)
-  \\ (impl_tac >- simp [Once v_rel_cases])
-  \\ rw []
-  >-
-   (Cases_on `pmatch s2 p v2 []` \\ fs [match_rel_def]
-    \\ `env_rel ctors <|v := a ++ env1.v|> <|v := a' ++ env2.v|>` by
-     (fs [env_rel_def, nv_rel_LIST_REL]
-      \\ match_mp_tac EVERY2_APPEND_suff \\ fs [])
-    \\ first_x_assum drule
-    \\ rpt (disch_then drule)
-    \\ rw [] \\ fs []
-    \\ rw [add_default_def] \\ fs [compile_exps_def, evaluate_def])
-  \\ first_x_assum drule
-  \\ rpt (disch_then drule)
-  \\ disch_then (qspec_then `tr` mp_tac o CONV_RULE SWAP_FORALL_CONV) \\ fs []
-  \\ qpat_abbrev_tac `ps2 = add_default X Y F ps`
-  \\ qpat_abbrev_tac `ps3 = add_default X Y T ps`
-  \\ strip_tac
-  \\ first_assum (qspec_then `ps2` mp_tac)
-  \\ simp_tac std_ss []
-  \\ strip_tac \\ fs []
-  \\ first_x_assum (qspec_then `ps3` mp_tac)
-  \\ fs [Abbr`ps2`,Abbr`ps3`, add_default_def] \\ rw [] \\ fs []
-  \\ fs [evaluate_def, compile_exps_def] \\ rw [] \\ fs []
-  \\ fs [exists_match_def, PULL_EXISTS]
-  \\ rw [] \\ fsrw_tac [DNF_ss] []
-  \\ metis_tac [pmatch_any_no_match]
-QED
-
-(* ------------------------------------------------------------------------- *)
-(* Compile declarations                                                      *)
-(* ------------------------------------------------------------------------- *)
-
-val v_rel_SUBMAP = Q.prove (
-  `(!pre v1 v2.
-    v_rel pre v1 v2 ==>
-    !post.
-    pre SUBMAP post ==>
-    v_rel post v1 v2) /\
-   (!pre vs1 vs2.
-    nv_rel pre vs1 vs2 ==>
-    !post.
-    pre SUBMAP post ==>
-    nv_rel post vs1 vs2)`,
-  ho_match_mp_tac v_rel_ind \\ rw [] \\ fs [LIST_REL_EL_EQN]
-  \\ fs [ok_ctor_def] \\ every_case_tac \\ fs []
-  \\ rw [Once v_rel_cases] \\ metis_tac [SUBMAP_TRANS, FLOOKUP_SUBMAP]);
-
-val sv_rel_lemma = Q.prove (
-  `!R x y. (!x y. R x y ==> Q ==> P x y) ==> sv_rel R x y ==> Q ==> sv_rel P x y`,
-  ho_match_mp_tac sv_rel_ind
-  \\ rw [] \\ fs [LIST_REL_EL_EQN]);
-
-val sv_rel_v_rel_SUBMAP = Q.prove (
-  `sv_rel (v_rel pre) v1 v2 /\
-   pre SUBMAP post
-   ==>
-   sv_rel (v_rel post) v1 v2`,
-  rw [] \\ ho_match_mp_tac (GEN_ALL (MP_CANON sv_rel_lemma))
-  \\ qexists_tac `pre SUBMAP post` \\ fs []
-  \\ qexists_tac `v_rel pre` \\ rw []
-  \\ imp_res_tac v_rel_SUBMAP);
-
-(* TODO, not true anymore
-val state_rel_SUBMAP = Q.prove (
-  `state_rel pre s1 s2 /\
-   pre SUBMAP post
-   ==>
-   state_rel post s1 s2`,
-  rw [state_rel_def, LIST_REL_EL_EQN]
-  >- metis_tac [sv_rel_v_rel_SUBMAP]
-  \\ first_x_assum (qspec_then `n` mp_tac)
-  \\ rw [OPTREL_def] \\ fs []
-  >- metis_tac [v_rel_SUBMAP]
-  >- metis_tac [SUBMAP_TRANS]
-  >- (
-    fs [ctor_rel_def, SUBMAP_DEF, FLOOKUP_DEF] >>
-    rw [] >> eq_tac >> rw [GSYM PULL_EXISTS]
-    metis_tac []
-    *)
-
-val dec_res_rel_def = Define `
-  (dec_res_rel ctors NONE NONE <=> T) /\
-  (dec_res_rel ctors (SOME r1) (SOME r2) <=>
-     result_rel (LIST_REL o v_rel) ctors (Rerr r1) (Rerr r2)) /\
-  (dec_res_rel _ _ _ <=> F)`;
-
-Theorem dec_res_rel_thms[simp]:
-   (!ctors r. dec_res_rel ctors NONE r <=> r = NONE) /\
-   (!ctors r. dec_res_rel ctors r NONE <=> r = NONE) /\
-   (!ctors e r. dec_res_rel ctors (SOME e) r <=>
-      ?e1. r = SOME e1 /\
-           result_rel (LIST_REL o v_rel) ctors (Rerr e) (Rerr e1)) /\
-   (!ctors e r. dec_res_rel ctors r (SOME e) <=>
-      ?e1. r = SOME e1 /\
-           result_rel (LIST_REL o v_rel) ctors (Rerr e1) (Rerr e))
-Proof
-  rw [] \\ Cases_on `r` \\ rw [dec_res_rel_def]
-QED
-
-val compile_exps_lemma =
-  CONJUNCT1 compile_exps_evaluate
-  |> SPEC_ALL |> UNDISCH |> SPEC_ALL
-  |> Q.GENL [`ctors_pre`,`ctors`]
-  |> Q.SPECL [`ctors`,`ctors`]
-  |> SIMP_RULE (srw_ss()) []
-  |> DISCH_ALL |> GEN_ALL;
-
-val get_tdecs_def = Define `
-  get_tdecs xs =
-    MAP (\d. case d of Dtype t s => t)
-      (FILTER (\d. ?t s. d = Dtype t s) xs)`;
-
-Theorem get_tdecs_APPEND:
-   get_tdecs (xs ++ ys) = get_tdecs xs ++ get_tdecs ys
-Proof
-  rw [get_tdecs_def, FILTER_APPEND]
-QED
-
-Theorem get_tdecs_MEM:
-   MEM t (get_tdecs xs) <=> ?s. MEM (Dtype t s) xs
-Proof
-  rw [get_tdecs_def, MEM_MAP, MEM_FILTER, PULL_EXISTS]
-QED
-
-val is_new_type_def = Define `
-  is_new_type ctors decl <=>
-    !tid s. decl = Dtype tid s ==> tid NOTIN FDOM ctors`;
-
-val compile_decs_SUBMAP = Q.prove (
-  `!decs ctors_pre ctors_post decs2.
-     EVERY (is_new_type ctors_pre) decs /\
-     ALL_DISTINCT (get_tdecs decs) /\
-     compile_decs ctors_pre decs = (ctors_post, decs2)
-     ==>
-     ctors_pre SUBMAP ctors_post`,
-  Induct \\ rw [compile_decs_def]
-  \\ rpt (pairarg_tac \\ fs []) \\ rveq
-  \\ `ALL_DISTINCT (get_tdecs decs) /\
-      ctors_pre SUBMAP ctor1 /\
-      EVERY (is_new_type ctor1) decs`
-    by (rename1 `compile_dec _ dec`
-        \\ Cases_on `dec` \\ fs [compile_dec_def] \\ rw []
-        \\ fs [is_new_type_def, EVERY_MEM] \\ rw []
-        \\ imp_res_tac get_tdecs_MEM
-        \\ fs [get_tdecs_def]
-        \\ every_case_tac \\ fs []
-        \\ strip_tac \\ fs []
-        \\ metis_tac [])
-  \\ metis_tac [SUBMAP_TRANS]);
-
-Theorem compile_dec_evaluate:
-  !d1 s1 t1 c1 r1.
-     evaluate_dec s1 d1 = (t1, r1) /\
-     r1 <> SOME (Rabort Rtype_error)
-     ==>
-     !ctors s2.
-       state_rel T ctors s1 s2 /\
-       is_new_type ctors d1
-       ==>
-       ?t2 r2 d2 ctors_post c2.
-         ctors SUBMAP ctors_post /\
-         compile_dec ctors d1 = (ctors_post, d2) /\
-         state_rel T ctors_post t1 t2 /\
-         dec_res_rel ctors_post r1 r2 /\
-         evaluate_dec s2 d2 = (t2, r2)
-Proof
-  Cases \\ rw []
-  >- (* Dlet *)
-   (
-    fs [compile_dec_def, evaluate_dec_def, pair_case_eq, case_eq_thms]
-    \\ rveq \\ fs [PULL_EXISTS]
-    \\ drule compile_exps_lemma \\ fs [] >>
-    disch_then (qspecl_then [`s2`, `<|v:=[]|>`] mp_tac) >>
-    simp [env_rel_def] >> disch_then drule >> rw [] >>
-    fs [compile_exp_def]
-    \\ every_case_tac \\ fs [] \\ rw [] >>
-    fs [Once v_rel_cases, Unitv_def, state_rel_def] >>
-    metis_tac [])
-  >- (* Dtype *)
-   (
-     fs [compile_dec_def, evaluate_dec_def] >>
-     Cases_on `is_fresh_type n s1.c` >> fs [] >>
-     `s1.check_ctor ∧ s1.c = s2.c` by fs [state_rel_def] >>
-     fs [] >> rw []
-     >- fs [is_new_type_def]
-     >- (
-       fs [state_rel_def, LIST_REL_EL_EQN] >> rw []
-       >- (
-         irule sv_rel_v_rel_SUBMAP >>
-         qexists_tac `ctors` >>
-         rw [] >> fs [is_new_type_def])
-       >- (
-         irule OPTREL_MONO >>
-         qexists_tac `v_rel ctors` >>
-         rw [] >>
-         irule (CONJUNCT1 v_rel_SUBMAP) >>
-         qexists_tac `ctors` >>
-         fs [is_new_type_def])
-       >- fs [SUBSET_DEF]
-       >- (fs [SUBMAP_DEF, FAPPLY_FUPDATE_THM, is_new_type_def] >> metis_tac [])
-       >- (
-         fs [ctor_rel_def, is_new_type_def, is_fresh_type_def] >> rw [] >>
-         Cases_on `ty = n` >> simp [FLOOKUP_UPDATE] >>
-         eq_tac >> rw [] >> metis_tac []))
-     >- fs [is_new_type_def]
-     >- fs [state_rel_def])
-  (* Dexn *)
-  \\ fs [evaluate_dec_def, env_rel_def, is_fresh_exn_def, compile_dec_def]
-  \\ every_case_tac \\ fs [] \\ rw [] \\ fs [ctor_rel_def, FORALL_PROD, state_rel_def]
-  \\ metis_tac [SUBSET_DEF, SUBSET_UNION]
-QED
-
-Theorem compile_decs_evaluate:
-  !ds1 s1 t1 c1 r1.
-     evaluate_decs s1 ds1 = (t1, r1) /\
-     r1 <> SOME (Rabort Rtype_error)
-     ==>
-     !ctors s2 ds2 ctors_post.
-       compile_decs ctors ds1 = (ctors_post, ds2) /\
-       state_rel T ctors s1 s2 /\
-       EVERY (is_new_type ctors) ds1 /\
-       ALL_DISTINCT (get_tdecs ds1)
-       ==>
-       ?t2 r2.
-         ctors SUBMAP ctors_post /\
-         state_rel (r1 = NONE) ctors_post t1 t2 /\
-         dec_res_rel ctors_post r1 r2 /\
-         evaluate_decs s2 ds2 = (t2, r2)
-Proof
-  Induct \\ rw []
-  >-
-   (fs [evaluate_decs_def, compile_decs_def, env_rel_def, get_tdecs_def,
-        environment_component_equality] \\ rw []
-    \\ fs [get_tdecs_def, evaluate_decs_def])
-  \\ fs [evaluate_decs_def, compile_decs_def, case_eq_thms, pair_case_eq]
-  \\ rpt (pairarg_tac \\ fs []) \\ rw []
-  \\ drule compile_dec_evaluate \\ fs []
-  \\ rpt (disch_then drule) \\ rw []
-  \\ `EVERY (is_new_type ctor1) ds1`
-    by (fs [EVERY_MEM] \\ rw []
-        \\ first_x_assum drule \\ fs [is_new_type_def] \\ rw []
-        \\ fs [get_tdecs_def]
-        \\ Cases_on `h` \\ fs [compile_dec_def] \\ rw [] \\ fs []
-        \\ metis_tac [get_tdecs_MEM, get_tdecs_def])
-  \\ `ALL_DISTINCT (get_tdecs ds1)` by (Cases_on `h` \\ fs [get_tdecs_def])
-  >-
-   (last_x_assum drule
-    \\ rpt (disch_then drule) \\ rw []
-    \\ simp [RIGHT_EXISTS_AND_THM]
-    \\ conj_tac >- metis_tac [SUBMAP_TRANS]
-    \\ fs [AC UNION_ASSOC UNION_COMM, evaluate_decs_def])
-  \\ fs [] \\ rw [] \\ fs [evaluate_decs_def] >>
-  rw []
-  >- metis_tac [SUBMAP_TRANS, compile_decs_SUBMAP]
-  >- (
-    `ctor1 SUBMAP ctor2` by metis_tac [compile_decs_SUBMAP] >>
-    fs [state_rel_def, LIST_REL_EL_EQN] >> rw [] >>
-    metis_tac [OPTREL_MONO,sv_rel_v_rel_SUBMAP,v_rel_SUBMAP, SUBMAP_TRANS])
-  >- metis_tac [v_rel_SUBMAP, compile_decs_SUBMAP]
-  >- metis_tac [SUBMAP_TRANS, compile_decs_SUBMAP]
-  >- (
-    `ctor1 SUBMAP ctor2` by metis_tac [compile_decs_SUBMAP] >>
-    fs [state_rel_def, LIST_REL_EL_EQN] >> rw [] >>
-    metis_tac [OPTREL_MONO,sv_rel_v_rel_SUBMAP,v_rel_SUBMAP, SUBMAP_TRANS])
-QED
-
-(* ------------------------------------------------------------------------- *)
-(* Top-level semantics theorem                                               *)
-(* ------------------------------------------------------------------------- *)
-
-val ctor_rel_initial_ctor = Q.prove (
-  `ctor_rel init_ctors (initial_state a b c d).c`,
-  rw [ctor_rel_def, init_ctors_def, initial_state_def, flookup_fupdate_list] \\ rw []
-  \\ fs [lookup_insert] \\ every_case_tac \\ fs [lookup_def] \\ EVAL_TAC \\ rw []);
-
-Theorem compile_decs_eval_sim:
-   EVERY (is_new_type init_ctors) ds1 /\
-   ALL_DISTINCT (get_tdecs ds1)
-   ==>
-   eval_sim
-     (ffi:'ffi ffi_state) F T ds1 T T
-     (SND (compile ds1))
-     (\p1 p2. p2 = SND (compile p1)) F
-Proof
-  rw [eval_sim_def] \\ qexists_tac `0` \\ fs []
-  \\ Cases_on `compile ds1` \\ fs [compile_def]
-  \\ `state_rel T init_ctors (initial_state ffi k F T) (initial_state ffi k T T)`
-    by (EVAL_TAC \\ fs [] >> rw [] >> eq_tac >> rw [] >> CCONTR_TAC >>
-        fs [lookup_def] >> fs [] >>
-        every_case_tac >> fs [lookup_def, EVEN_EXISTS] >>
-        intLib.COOPER_TAC)
-  \\ drule compile_decs_evaluate \\ fs []
-  \\ rpt (disch_then drule) \\ rw []
-  \\ fs [state_rel_def] \\ rw [dec_res_rel_def] \\ fs []
-QED
-
-val compile_decs_semantics = save_thm ("compile_decs_semantics",
-  MATCH_MP (REWRITE_RULE [GSYM AND_IMP_INTRO] IMP_semantics_eq)
-           (UNDISCH compile_decs_eval_sim)
-  |> DISCH_ALL
-  |> SIMP_RULE (srw_ss()) [AND_IMP_INTRO]);
-
-(* ------------------------------------------------------------------------- *)
-(* Syntactic results for expressions                                         *)
-(* ------------------------------------------------------------------------- *)
-
-val compile_exps_sing = Q.prove (
-  `!e. ?e2. compile_exps ctors [e] = [e2]`,
-  rw []
-  \\ qspecl_then [`ctors`,`[e]`] mp_tac compile_exps_LENGTH
-  \\ simp_tac(std_ss++listSimps.LIST_ss)[LENGTH_EQ_NUM_compute]);
-
-Theorem compile_exps_elist_globals_eq_empty:
-   !ctors es.
-     elist_globals es = {||}
-     ==>
-     elist_globals (compile_exps ctors es) = {||}
-Proof
-  ho_match_mp_tac compile_exps_ind
-  \\ rw [compile_exps_def]
-  \\ TRY
-    (rename1 `HD (compile_exps ctors [e])`
-     \\ qspec_then `e` assume_tac compile_exps_sing \\ fs [] \\ fs [])
-  \\ fs [MAP_MAP_o, o_DEF, UNCURRY]
-  \\ fs [add_default_def] \\ rw [] \\ fs []
-  \\ TRY
-   (pop_assum kall_tac
-    \\ pop_assum mp_tac
-    \\ ntac 2 (pop_assum kall_tac)
-    \\ pop_assum mp_tac
-    \\ rename1 `MAP _ ps`
-    \\ qid_spec_tac `ps`
-    \\ Induct \\ fs [FORALL_PROD] \\ rw []
-    \\ first_x_assum(fn th => mp_tac th \\ impl_tac >- METIS_TAC[])
-    \\ fsrw_tac [DNF_ss] [SUB_BAG_UNION] \\ rw []
-    \\ rename1 `compile_exps ctors [e]`
-    \\ Cases_on `compile_exps ctors [e]` \\ fs [])
-  \\ pop_assum mp_tac
-  \\ ntac 2 (pop_assum kall_tac)
-  \\ pop_assum mp_tac
-  \\ rename1 `MAP _ ps`
-  \\ qid_spec_tac `ps`
-  \\ Induct \\ fs [FORALL_PROD] \\ rw []
-  \\ first_x_assum(fn th => mp_tac th \\ impl_tac >- METIS_TAC[])
-  \\ fsrw_tac [DNF_ss] [SUB_BAG_UNION] \\ rw []
-  \\ rename1 `compile_exps ctors [e]`
-  \\ Cases_on `compile_exps ctors [e]` \\ fs []
-QED
-
-Theorem compile_exps_set_globals_eq_empty:
-   set_globals e = {||} ==> set_globals (HD (compile_exps ctors [e])) = {||}
-Proof
-  qspecl_then [`ctors`,`[e]`] mp_tac compile_exps_elist_globals_eq_empty
-  \\ rw[] \\ fs[] \\ Cases_on `compile_exps ctors [e]` \\ fs []
-QED
-
-Theorem compile_exps_esgc_free:
-   !ctors es.
-     EVERY esgc_free es
-     ==>
-     EVERY esgc_free (compile_exps ctors es)
-Proof
-  ho_match_mp_tac compile_exps_ind
-  \\ rw [compile_exps_def]
-  \\ fs [compile_exps_set_globals_eq_empty]
-  \\ TRY
-    (rename1 `HD (compile_exps ctors [e])`
-     \\ qspec_then `e` assume_tac compile_exps_sing \\ fs [] \\ fs []
-     \\ NO_TAC)
-  \\ fs [EVERY_MAP, EVERY_MEM, FORALL_PROD, elist_globals_eq_empty]
-  \\ fs [MEM_MAP, MAP_MAP_o, PULL_EXISTS, FORALL_PROD]
-  \\ fs [add_default_def] \\ rw [] \\ fs []
-  \\ TRY (
-    match_mp_tac compile_exps_set_globals_eq_empty
-    \\ res_tac)
-  \\ fs [compile_exps_def]
-  \\ rename1 `HD (compile_exps ctors [p])`
-  \\ qspec_then `p` assume_tac compile_exps_sing \\ fs []
-  \\ res_tac \\ fs []
-QED
-
-Theorem compile_exps_sub_bag:
-   !ctors es. elist_globals (compile_exps ctors es) ≤ elist_globals es
-Proof
-  ho_match_mp_tac compile_exps_ind
-  \\ rw [compile_exps_def]
-  \\ TRY
-   (rename1 `HD (compile_exps ctors [x])`
-    \\ qspec_then `x` assume_tac compile_exps_sing \\ fs [SUB_BAG_UNION]
-    \\ fs [elist_globals_append, SUB_BAG_UNION])
-  \\ fs [MAP_MAP_o, o_DEF, UNCURRY]
-  \\ fs [add_default_def] \\ rw [] \\ fs []
-  \\ simp [compile_exps_def, elist_globals_append]
-  \\ TRY
-   (rename1 `HD (compile_exps ctors [x1])`
-    \\ qspec_then `x1` assume_tac compile_exps_sing \\ fs [SUB_BAG_UNION]
-    \\ fs [elist_globals_append, SUB_BAG_UNION])
-  \\ TRY
-   (rename1 `HD (compile_exps ctors [x2])`
-    \\ qspec_then `x2` assume_tac compile_exps_sing \\ fs [SUB_BAG_UNION]
-    \\ fs [elist_globals_append, SUB_BAG_UNION])
-  \\ (FIRST
-    (map (fn th => match_mp_tac (MP_CANON th) \\ conj_tac >- simp[])
-         (CONJUNCTS SUB_BAG_UNION)))
-  \\ last_x_assum mp_tac
-  \\ rpt (pop_assum kall_tac)
-  \\ rename1 `MAP _ xs`
-  \\ Induct_on `xs` \\ fs [FORALL_PROD] \\ rw []
-  \\ last_x_assum mp_tac
-  \\ (impl_tac >- (rw [] \\ metis_tac [])) \\ rw []
-  \\ rename1 `HD (compile_exps ctors [p])`
-  \\ qspec_then `p` assume_tac compile_exps_sing \\ fs [SUB_BAG_UNION]
-  \\ fsrw_tac [DNF_ss] [SUB_BAG_UNION] \\ rw []
-QED
-
-Theorem compile_exps_distinct_globals:
-   BAG_ALL_DISTINCT (elist_globals es)
-   ==>
-   BAG_ALL_DISTINCT (elist_globals (compile_exps ctors es))
-Proof
-  metis_tac [compile_exps_sub_bag, BAG_ALL_DISTINCT_SUB_BAG]
-QED
-
-(* ------------------------------------------------------------------------- *)
-(* Syntactic results for declarations                                        *)
-(* ------------------------------------------------------------------------- *)
-
-Theorem compile_decs_elist_globals_eq_empty:
-   !ds ctors.
-     elist_globals
-       (MAP dest_Dlet (FILTER is_Dlet ds)) = {||}
-     ==>
-     elist_globals
-       (MAP dest_Dlet (FILTER is_Dlet (SND (compile_decs ctors ds)))) = {||}
-Proof
-  Induct \\ rw [compile_decs_def]
-  \\ fs [UNCURRY] \\ rw []
-  \\ Cases_on `h` \\ fs [compile_dec_def] \\ rw [compile_exp_def]
-  \\ metis_tac [compile_exps_set_globals_eq_empty]
-QED
-
-Theorem compile_decs_esgc_free:
-   !ds ctors.
-     EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet ds))
-     ==>
-     EVERY esgc_free (MAP dest_Dlet
-       (FILTER is_Dlet (SND (compile_decs ctors ds))))
-Proof
-  Induct \\ rw [compile_decs_def]
-  \\ fs [UNCURRY] \\ rw []
-  \\ Cases_on `h` \\ fs [compile_dec_def, compile_exp_def]
-  \\ qspec_then `e` assume_tac compile_exps_sing \\ fs []
-  \\ metis_tac [compile_exps_esgc_free, EVERY_DEF]
-QED
-
-Theorem compile_decs_sub_bag:
-   !ds ctors.
-    elist_globals (MAP dest_Dlet
-      (FILTER is_Dlet (SND (compile_decs ctors ds)))) ≤
-    elist_globals (MAP dest_Dlet (FILTER is_Dlet ds))
-Proof
-  Induct \\ rw [compile_decs_def]
-  \\ fs [UNCURRY] \\ rw []
-  \\ Cases_on `h` \\ fs [compile_dec_def, compile_exp_def]
-  \\ qspec_then `e` assume_tac compile_exps_sing \\ fs []
-  \\ last_x_assum (qspec_then `ctors` assume_tac)
-  \\ `elist_globals [e2] <= elist_globals [e]`
-    by metis_tac [compile_exps_sub_bag]
-  \\ fs [SUB_BAG_UNION]
-QED
-
-Theorem compile_exps_distinct_globals:
-   BAG_ALL_DISTINCT (elist_globals (MAP dest_Dlet (FILTER is_Dlet ds)))
-   ==>
-   BAG_ALL_DISTINCT
-     (elist_globals
-       (MAP dest_Dlet (FILTER is_Dlet (SND (compile_decs ctors ds)))))
-Proof
-  metis_tac [compile_decs_sub_bag, BAG_ALL_DISTINCT_SUB_BAG]
-QED
-
-val _ = export_theory();
diff --git a/compiler/backend/proofs/flat_patternProofScript.sml b/compiler/backend/proofs/flat_patternProofScript.sml
new file mode 100644
index 0000000000..4ff0cb707c
--- /dev/null
+++ b/compiler/backend/proofs/flat_patternProofScript.sml
@@ -0,0 +1,2564 @@
+(*
+  Correctness proof for flat_pattern
+*)
+
+open preamble flat_patternTheory
+     semanticPrimitivesTheory semanticPrimitivesPropsTheory
+     flatLangTheory flatSemTheory flatPropsTheory backendPropsTheory
+     pattern_semanticsTheory
+local open bagSimps in end
+
+val _ = new_theory "flat_patternProof"
+
+val _ = set_grammar_ancestry ["flat_pattern",
+                              "misc","ffi","bag","flatProps",
+                              "backendProps","backend_common",
+                              "pattern_semantics"];
+
+(* simple properties *)
+Theorem op_sets_globals_gbag:
+  op_sets_globals op = (op_gbag op <> {||})
+Proof
+  Cases_on `op` \\ simp [op_sets_globals_def, op_gbag_def]
+QED
+
+Theorem compile_exp_set_globals_FST_SND:
+  (!cfg x. FST (SND (compile_exp cfg x)) =
+    (set_globals x <> {||})) /\
+   (!cfg xs. FST (SND (compile_exps cfg xs)) =
+    (elist_globals xs <> {||})) /\
+  (!cfg ps. FST (SND (compile_match cfg ps)) =
+    (elist_globals (MAP SND ps) <> {||}))
+Proof
+  ho_match_mp_tac compile_exp_ind \\ rw [compile_exp_def] \\ fs []
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs []
+  \\ fs [flatPropsTheory.elist_globals_REVERSE, op_sets_globals_gbag]
+  \\ simp [DISJ_ASSOC]
+  \\ simp [EXISTS_MEM, elist_globals_eq_empty, PULL_EXISTS, MEM_MAP]
+  \\ simp [EXISTS_PROD, ELIM_UNCURRY]
+  \\ metis_tac []
+QED
+
+Theorem compile_exp_set_globals_tup:
+  (!cfg x i sg y. compile_exp cfg x = (i, sg, y) ==>
+    sg = (set_globals x <> {||})) /\
+   (!cfg xs i sg ys. compile_exps cfg xs = (i, sg, ys) ==>
+    sg = (elist_globals xs <> {||})) /\
+  (!cfg ps i sg ps2. compile_match cfg ps = (i, sg, ps2) ==>
+    sg = (elist_globals (MAP SND ps) <> {||}))
+Proof
+  metis_tac [compile_exp_set_globals_FST_SND, FST, SND]
+QED
+
+(* decoding the encoded names *)
+
+Theorem sum_string_ords_eq:
+  sum_string_ords i s = SUM (MAP (\c. ORD c - 35) (DROP i s))
+Proof
+  measureInduct_on `(\i. LENGTH s - i) i`
+  \\ simp [Once sum_string_ords_def]
+  \\ rw [rich_listTheory.DROP_EL_CONS, listTheory.DROP_LENGTH_TOO_LONG]
+QED
+
+Theorem dec_enc:
+  !xs. dec_name_to_num (enc_num_to_name i xs) =
+  i + SUM (MAP (\c. ORD c - 35) xs)
+Proof
+  measureInduct_on `I i`
+  \\ simp [Once enc_num_to_name_def]
+  \\ CASE_TAC \\ simp [dec_name_to_num_def, sum_string_ords_eq]
+QED
+
+Theorem enc_num_to_name_inj:
+  (enc_num_to_name i [] = enc_num_to_name j []) = (i = j)
+Proof
+  metis_tac [dec_enc |> Q.SPEC `[]` |> SIMP_RULE list_ss []]
+QED
+
+Theorem env_is_v_fold:
+  <| v := env.v |> = env
+Proof
+  simp [environment_component_equality]
+QED
+
+(* lists and lookups *)
+
+Theorem LIST_REL_ALOOKUP_OPTREL:
+  !xs ys. LIST_REL R xs ys /\
+  (!x y. R x y /\ MEM x xs /\ MEM y ys /\ (v = FST x \/ v = FST y) ==>
+    FST x = FST y /\ R2 (SND x) (SND y))
+  ==> OPTREL R2 (ALOOKUP xs v) (ALOOKUP ys v)
+Proof
+  Induct \\ rpt (Cases ORELSE gen_tac)
+  \\ simp [optionTheory.OPTREL_def]
+  \\ qmatch_goalsub_abbrev_tac `ALOOKUP (pair :: _)`
+  \\ Cases_on `pair`
+  \\ simp []
+  \\ rpt strip_tac
+  \\ last_x_assum drule
+  \\ impl_tac >- metis_tac []
+  \\ simp []
+  \\ strip_tac
+  \\ first_x_assum drule
+  \\ rw []
+  \\ fs [optionTheory.OPTREL_def]
+QED
+
+Theorem LIST_REL_ALOOKUP:
+  !xs ys. LIST_REL R xs ys /\
+  (!x y. R x y /\ MEM x xs /\ MEM y ys /\ (v = FST x \/ v = FST y) ==> x = y)
+  ==> ALOOKUP xs v = ALOOKUP ys v
+Proof
+  REWRITE_TAC [GSYM optionTheory.OPTREL_eq]
+  \\ rpt strip_tac
+  \\ drule_then irule LIST_REL_ALOOKUP_OPTREL
+  \\ metis_tac []
+QED
+
+Theorem LIST_REL_FILTER_MONO:
+  !xs ys. LIST_REL R (FILTER P1 xs) (FILTER P2 ys) /\
+  (!x. MEM x xs /\ P3 x ==> P1 x) /\
+  (!y. MEM y ys /\ P4 y ==> P2 y) /\
+  (!x y. MEM x xs /\ MEM y ys /\ R x y ==> P3 x = P4 y)
+  ==> LIST_REL R (FILTER P3 xs) (FILTER P4 ys)
+Proof
+  Induct
+  >- (
+    simp [FILTER_EQ_NIL, EVERY_MEM]
+    \\ metis_tac []
+  )
+  \\ gen_tac
+  \\ simp []
+  \\ reverse CASE_TAC
+  >- (
+    CASE_TAC
+    >- metis_tac []
+    \\ rw []
+  )
+  \\ rpt (gen_tac ORELSE disch_tac)
+  \\ fs [FILTER_EQ_CONS]
+  \\ rename [`_ = ys_pre ++ [y] ++ ys_post`]
+  \\ rveq \\ fs []
+  \\ fs [FILTER_APPEND]
+  \\ first_x_assum drule
+  \\ simp []
+  \\ disch_tac
+  \\ `FILTER P4 ys_pre = []` by (fs [FILTER_EQ_NIL, EVERY_MEM] \\ metis_tac [])
+  \\ rw []
+  \\ metis_tac []
+QED
+
+Theorem COND_false:
+  ~ P ==> ((if P then x else y) = y)
+Proof
+  simp []
+QED
+
+Theorem COND_true:
+  P ==> ((if P then x else y) = x)
+Proof
+  simp []
+QED
+
+Theorem FILTER_EQ_MONO = LIST_REL_FILTER_MONO
+  |> Q.GEN `R` |> Q.ISPEC `(=)` |> REWRITE_RULE [LIST_REL_eq]
+
+Theorem FILTER_EQ_MONO_TRANS = FILTER_EQ_MONO
+  |> Q.GEN `P2` |> Q.SPEC `\x. T`
+  |> Q.GEN `P4` |> Q.SPEC `P3`
+  |> REWRITE_RULE [FILTER_T]
+
+Theorem FILTER_EQ_ALOOKUP_EQ:
+  !xs ys. FILTER P xs = ys /\ (!z. P (x, z)) ==>
+  ALOOKUP xs x = ALOOKUP ys x
+Proof
+  Induct \\ simp []
+  \\ Cases
+  \\ rw []
+  \\ fs []
+QED
+
+Theorem ALOOKUP_FILTER_EQ = FILTER_EQ_ALOOKUP_EQ |> SIMP_RULE bool_ss []
+  |> GSYM;
+
+Theorem MEM_enumerate_EL:
+  !xs i x. MEM x (enumerate i xs) = (?j. j < LENGTH xs /\ x = (i + j, EL j xs))
+Proof
+  Induct \\ rw [miscTheory.enumerate_def]
+  \\ simp [indexedListsTheory.LT_SUC]
+  \\ EQ_TAC \\ rw []
+  \\ simp [EL_CONS, ADD1]
+  \\ simp [GSYM ADD1]
+  \\ qexists_tac `0` \\ simp []
+QED
+
+Theorem ALL_DISTINCT_enumerate:
+  !xs i. ALL_DISTINCT (enumerate i xs)
+Proof
+  Induct \\ rw [miscTheory.enumerate_def, MEM_enumerate_EL]
+QED
+
+Definition pure_eval_to_def:
+  pure_eval_to s env exp v = (evaluate env s [exp] = (s, Rval [v]))
+End
+
+Theorem pmatch_list_Match_IMP_LENGTH:
+  !xs ys env env' s. pmatch_list s xs ys env = Match env' ==>
+  LENGTH xs = LENGTH ys
+Proof
+  Induct
+  >- (
+    Cases \\ simp [flatSemTheory.pmatch_def]
+  )
+  >- (
+    gen_tac \\ Cases \\ simp [flatSemTheory.pmatch_def]
+    \\ simp [CaseEq "match_result"]
+    \\ metis_tac []
+  )
+QED
+
+Theorem pmatch_list_append_Match_exists:
+  (pmatch_list s (xs ++ ys) vs pre_bindings = Match bindings) =
+  (?vs1 vs2 bindings1. vs = vs1 ++ vs2 /\
+  pmatch_list s xs vs1 pre_bindings = Match bindings1 /\
+  pmatch_list s ys vs2 bindings1 = Match bindings)
+Proof
+  Cases_on `LENGTH vs <> LENGTH xs + LENGTH ys`
+  >- (
+    EQ_TAC \\ rw []
+    \\ imp_res_tac pmatch_list_Match_IMP_LENGTH
+    \\ fs []
+  )
+  \\ fs []
+  \\ qspecl_then [`xs`, `TAKE (LENGTH xs) vs`, `ys`, `DROP (LENGTH xs) vs`,
+        `s`, `pre_bindings`]
+    mp_tac flatPropsTheory.pmatch_list_append
+  \\ rw []
+  \\ simp [CaseEq "match_result"]
+  \\ EQ_TAC \\ rw []
+  \\ imp_res_tac pmatch_list_Match_IMP_LENGTH
+  \\ simp [TAKE_APPEND, DROP_APPEND, DROP_LENGTH_TOO_LONG]
+  \\ rpt (goal_assum (first_assum o mp_then Any mp_tac))
+  \\ simp []
+QED
+
+Definition ALOOKUP_rel_def:
+  ALOOKUP_rel P R env1 env2 =
+  (!x. P x ==> OPTREL R (ALOOKUP env1 x) (ALOOKUP env2 x))
+End
+
+Theorem ALOOKUP_rel_empty:
+  ALOOKUP_rel P R [] []
+Proof
+  simp [ALOOKUP_rel_def, OPTREL_def]
+QED
+
+Theorem ALOOKUP_rel_cons_false:
+  (~ P x ==> ALOOKUP_rel P R ((x, y) :: env1) env2 = ALOOKUP_rel P R env1 env2)
+  /\
+  (~ P x ==> ALOOKUP_rel P R env1 ((x, y) :: env2) = ALOOKUP_rel P R env1 env2)
+Proof
+  simp [ALOOKUP_rel_def]
+  \\ metis_tac [COND_CLAUSES]
+QED
+
+Theorem ALOOKUP_rel_APPEND_L_false:
+  EVERY ((~) o P o FST) xs ==>
+  ALOOKUP_rel P R (xs ++ ys) zs =
+  ALOOKUP_rel P R ys zs
+Proof
+  rw [ALOOKUP_rel_def, ALOOKUP_APPEND]
+  \\ EQ_TAC \\ rw []
+  \\ first_x_assum drule
+  \\ CASE_TAC \\ simp []
+  \\ drule ALOOKUP_MEM
+  \\ fs [EVERY_MEM, FORALL_PROD]
+  \\ metis_tac []
+QED
+
+Theorem ALOOKUP_rel_refl:
+  (!x y. P x /\ MEM (x, y) xs ==> R y y) ==> ALOOKUP_rel P R xs xs
+Proof
+  rw [ALOOKUP_rel_def]
+  \\ Cases_on `ALOOKUP xs x`
+  \\ simp [OPTREL_def]
+  \\ metis_tac [ALOOKUP_MEM]
+QED
+
+Theorem ALOOKUP_rel_cons:
+  (P x ==> R y z) /\ ALOOKUP_rel P R ys zs ==>
+  ALOOKUP_rel P R ((x, y) :: ys) ((x, z) :: zs)
+Proof
+  rw [ALOOKUP_rel_def] \\ rw [] \\ simp [OPTREL_def]
+QED
+
+Theorem ALOOKUP_rel_mono:
+  ALOOKUP_rel P R xs ys /\
+  (!x y z. P' x ==> P x) /\
+  (!x y z. P' x /\ R y z ==> R' y z) ==>
+  ALOOKUP_rel P' R' xs ys
+Proof
+  rw [ALOOKUP_rel_def]
+  \\ fs [OPTREL_def]
+  \\ metis_tac []
+QED
+
+Theorem ALOOKUP_rel_mono_rel:
+  (!y z. R y z ==> R' y z) ==>
+  ALOOKUP_rel P R xs ys ==>
+  ALOOKUP_rel P R' xs ys
+Proof
+  metis_tac [ALOOKUP_rel_mono]
+QED
+
+Theorem ALOOKUP_rel_append_suff:
+  ALOOKUP_rel P R xs1 xs3 /\ ALOOKUP_rel P R xs2 xs4 ==>
+  ALOOKUP_rel P R (xs1 ++ xs2) (xs3 ++ xs4)
+Proof
+  rw [ALOOKUP_rel_def, ALOOKUP_APPEND]
+  \\ res_tac
+  \\ EVERY_CASE_TAC
+  \\ fs [OPTREL_def]
+QED
+
+Theorem ALOOKUP_rel_EQ_ALOOKUP:
+  ALOOKUP_rel P (=) xs ys /\ P x ==>
+  ALOOKUP xs x = ALOOKUP ys x
+Proof
+  simp [ALOOKUP_rel_def]
+QED
+
+Theorem ALOOKUP_rel_eq_fst:
+  !xs ys.
+  LIST_REL (\x y. FST x = FST y /\ (P (FST x) ==> R (SND x) (SND y))) xs ys ==>
+  ALOOKUP_rel P R xs ys
+Proof
+  Induct \\ rpt Cases
+  \\ fs [ALOOKUP_rel_def, OPTREL_def]
+  \\ Cases_on `h`
+  \\ rw []
+  \\ rw []
+QED
+
+Theorem pat_bindings_evaluate_FOLDR_lemma1:
+  !xs.
+  (!x. MEM x xs ==> IS_SOME (f x)) /\
+  (!x. IMAGE (THE o f) (set xs) ⊆ new_names) /\
+  (!x. MEM x xs ==> (?rv. !env2.
+    ALOOKUP_rel (\x. x ∉ new_names) (=) env2.v env.v ==>
+    evaluate env2 s [g x] = (s, Rval [rv])))
+  ==>
+  !env2.
+  ALOOKUP_rel (\x. x ∉ new_names) (=) env2.v env.v ==>
+  evaluate env2 s
+    [FOLDR (λx exp. flatLang$Let t (f x) (g x) exp) exp xs] =
+  evaluate (env2 with v := MAP (λx. (THE (f x),
+        case evaluate env s [g x] of (_, Rval rv) => HD rv)) (REVERSE xs)
+             ++ env2.v) s [exp]
+Proof
+  Induct \\ simp [env_is_v_fold]
+  \\ rw []
+  \\ simp [evaluate_def]
+  \\ fs [DISJ_IMP_THM, FORALL_AND_THM, IMP_CONJ_THM, IS_SOME_EXISTS]
+  \\ rfs []
+  \\ simp [libTheory.opt_bind_def, ALOOKUP_rel_cons_false]
+  \\ simp_tac bool_ss [GSYM APPEND_ASSOC, APPEND]
+  \\ simp [ALOOKUP_rel_refl]
+QED
+
+Theorem pat_bindings_evaluate_FOLDR_lemma:
+  !new_names.
+  (!x. MEM x xs ==> IS_SOME (f x)) /\
+  (!x. IMAGE (THE o f) (set xs) ⊆ new_names) /\
+  (!x. MEM x xs ==> (?rv. !env2.
+    ALOOKUP_rel (\x. x ∉ new_names) (=) env2.v env.v ==>
+    evaluate env2 s [g x] = (s, Rval [rv])))
+  ==>
+  evaluate env s
+    [FOLDR (λx exp. flatLang$Let t (f x) (g x) exp) exp xs] =
+  evaluate (env with v := MAP (λx. (THE (f x),
+        case evaluate env s [g x] of (_, Rval rv) => HD rv)) (REVERSE xs)
+             ++ env.v) s [exp]
+Proof
+  rw []
+  \\ DEP_REWRITE_TAC [pat_bindings_evaluate_FOLDR_lemma1]
+  \\ simp [ALOOKUP_rel_refl]
+QED
+
+Definition v_cons_in_c_def1:
+  v_cons_in_c c (Conv stmp xs) = (
+    (case stmp of SOME con_stmp => (con_stmp, LENGTH xs) ∈ c
+        | NONE => T) /\
+    EVERY (v_cons_in_c c) xs) /\
+  v_cons_in_c c (Vectorv vs) = EVERY (v_cons_in_c c) vs /\
+  v_cons_in_c c (Closure env n exp) = EVERY (\x. v_cons_in_c c (SND x)) env /\
+  v_cons_in_c c (Recclosure env funs n) = EVERY (\x. v_cons_in_c c (SND x)) env /\
+  v_cons_in_c c other = T
+Termination
+  WF_REL_TAC `measure (v_size o SND)`
+  \\ rw []
+  \\ fs [MEM_SPLIT, SUM_APPEND, v3_size, v1_size, v_size_def]
+End
+
+Theorem v_cons_in_c_def[simp] = v_cons_in_c_def1
+    |> CONV_RULE (DEPTH_CONV ETA_CONV)
+    |> SIMP_RULE bool_ss [prove (``(λx. v_cons_in_c c (SND x))
+        = (v_cons_in_c c o SND)``, simp [o_DEF])]
+
+(* a note on 'naming' below. the existing (encoded) names in the program
+   (in the original x and exp)
+   are < j for starting val j. during the recursion, j increases to i, with
+   new names i < nm < j appearing in the new env, and in *expressions* in
+   n_bindings. note *names* in n_bindings/pre_bindings come from the original
+   program. also new/old names mix in env, thus the many filters. *)
+
+Theorem compile_pat_bindings_simulation:
+  ! t i n_bindings exp exp2 spt s vs pre_bindings bindings env s2 res vset.
+  compile_pat_bindings t i n_bindings exp = (spt, exp2) /\
+  pmatch_list s (MAP FST n_bindings) vs pre_bindings = Match bindings /\
+  evaluate env s [exp2] = (s2, res) /\
+  LIST_REL (\(_, k, v_exp) v. !env2. k ∈ domain spt /\
+        ALOOKUP_rel ((\k. k > j /\ k < i) o dec_name_to_num) (=) env2.v env.v
+        ==>
+        pure_eval_to s env2 v_exp v)
+    n_bindings vs /\
+  EVERY ((\k. k < j) o dec_name_to_num o FST) pre_bindings /\
+  j < i /\
+  ALOOKUP_rel ((\k. k < j) o dec_name_to_num) (=) env.v
+    (pre_bindings ++ base_vs) /\
+  EVERY (\(p, k, _). EVERY (\nm. dec_name_to_num nm < j) (pat_bindings p []) /\
+        j < k /\ k < i) n_bindings /\
+  EVERY (v_cons_in_c s.c ∘ SND) env.v /\
+  EVERY (EVERY (v_cons_in_c s.c) ∘ store_v_vs) s.refs /\
+  EVERY (v_cons_in_c s.c) vs
+  ==>
+  ?env2. evaluate env2 s [exp] = (s2, res) /\
+  EVERY (v_cons_in_c s.c ∘ SND) env2.v /\
+  ALOOKUP_rel ((\k. k < j) o dec_name_to_num) (=) env2.v (bindings ++ base_vs)
+Proof
+  ho_match_mp_tac compile_pat_bindings_ind
+  \\ rpt conj_tac
+  \\ simp_tac bool_ss [compile_pat_bindings_def, flatSemTheory.pmatch_def,
+        PULL_EXISTS, EVERY_DEF, PAIR_EQ, MAP, LIST_REL_NIL, LIST_REL_CONS1,
+        LIST_REL_CONS2, FORALL_PROD]
+  \\ rpt strip_tac
+  \\ fs [] \\ rveq \\ fs []
+  \\ fs [flatSemTheory.pmatch_def]
+  >- (
+    metis_tac []
+  )
+   >- (
+    metis_tac []
+  )
+  >- (
+    rpt (pairarg_tac \\ fs [])
+    \\ rveq \\ fs []
+    \\ fs [evaluate_def]
+    \\ qpat_x_assum `!env. _ ==> pure_eval_to _ _ x _` mp_tac
+    \\ disch_then (qspec_then `env` mp_tac)
+    \\ simp [pure_eval_to_def, ALOOKUP_rel_refl]
+    \\ rw []
+    \\ fs [pat_bindings_def]
+    \\ last_x_assum (drule_then (drule_then irule))
+    \\ simp [libTheory.opt_bind_def]
+    \\ simp [ALOOKUP_rel_cons]
+    \\ first_x_assum (fn t => mp_tac t \\ match_mp_tac LIST_REL_mono)
+    \\ simp [FORALL_PROD, ALOOKUP_rel_cons_false]
+  )
+  >- (
+    qmatch_asmsub_abbrev_tac `pmatch _ (Plit l) lv`
+    \\ Cases_on `lv` \\ fs [flatSemTheory.pmatch_def]
+    \\ qpat_x_assum `_ = Match _` mp_tac
+    \\ simp [CaseEq "match_result", bool_case_eq]
+    \\ rw []
+    \\ metis_tac []
+  )
+  >- (
+    (* Pcon *)
+    qmatch_asmsub_abbrev_tac `pmatch _ (Pcon stmp _) con_v`
+    \\ qpat_x_assum `_ = Match _` mp_tac
+    \\ simp [CaseEq "match_result"]
+    \\ rw []
+    \\ Cases_on `con_v` \\ fs [flatSemTheory.pmatch_def]
+    \\ fs [bool_case_eq]
+    \\ rpt (pairarg_tac \\ fs [])
+    \\ rveq \\ fs []
+    \\ fs [MAP_MAP_o |> REWRITE_RULE [o_DEF], UNCURRY, Q.ISPEC `SND` ETA_THM]
+    \\ fs [LENGTH_enumerate, MAP_enumerate_MAPi, MAPi_eq_MAP]
+    \\ qpat_x_assum `evaluate _ _ [FOLDR _ _ _] = _` mp_tac
+    \\ simp [ELIM_UNCURRY]
+    \\ DEP_REWRITE_TAC [pat_bindings_evaluate_FOLDR_lemma]
+    \\ simp []
+    \\ conj_tac >- (
+      qexists_tac `{x | ~ (dec_name_to_num x < i)}`
+      \\ simp [SUBSET_DEF, MEM_FILTER, MEM_MAPi, PULL_EXISTS]
+      \\ simp [dec_enc]
+      \\ simp [evaluate_def]
+      \\ rw [IS_SOME_EXISTS]
+      \\ rename [`pmatch_stamps_ok _ _ _ cstmp _ con_vs`]
+      \\ qexists_tac `EL n con_vs`
+      \\ rw []
+      \\ qpat_x_assum `!env. _ ==> pure_eval_to _ _ x _` mp_tac
+      \\ DEP_REWRITE_TAC [COND_false]
+      \\ simp [PULL_EXISTS, NULL_FILTER, MEM_MAPi]
+      \\ asm_exists_tac \\ simp []
+      \\ simp [pure_eval_to_def]
+      \\ disch_then (fn t => DEP_REWRITE_TAC [t])
+      \\ simp [do_app_def]
+      \\ drule_then irule ALOOKUP_rel_mono
+      \\ simp []
+    )
+    \\ rw []
+    \\ fs [Q.ISPEC `Match m` EQ_SYM_EQ]
+    \\ last_x_assum irule
+    \\ simp [PULL_EXISTS, pmatch_list_append_Match_exists]
+    \\ goal_assum (first_assum o mp_then (Pat `pmatch_list _ _ _ _ = _`) mp_tac)
+    \\ goal_assum (first_assum o mp_then (Pat `pmatch_list _ _ _ _ = _`) mp_tac)
+    \\ goal_assum (first_assum o mp_then (Pat `evaluate _ _ _ = _`) mp_tac)
+    \\ simp []
+    \\ rpt (conj_tac
+    >- (
+      fs [pat_bindings_def, pats_bindings_FLAT_MAP, EVERY_FLAT, EVERY_REVERSE]
+      \\ fs [EVERY_EL, FORALL_PROD, UNCURRY, EL_MAP]
+      \\ rw []
+      \\ res_tac
+      \\ simp []
+    ))
+    \\ DEP_REWRITE_TAC [ALOOKUP_rel_APPEND_L_false]
+    \\ simp [MAP_APPEND, REVERSE_APPEND, MEM_MAP, MEM_FILTER,
+      EVERY_MEM, MEM_MAPi, PULL_EXISTS, dec_enc]
+    \\ qpat_x_assum `!env. _ ==> pure_eval_to _ _ x _` (qspec_then `env` mp_tac)
+    \\ rpt strip_tac
+    >- (
+      rw []
+      \\ qpat_x_assum `_ ==> pure_eval_to _ _ x _` mp_tac
+      \\ DEP_REWRITE_TAC [COND_false]
+      \\ simp [ALOOKUP_rel_refl, pure_eval_to_def, NULL_FILTER]
+      \\ simp [MEM_MAPi, PULL_EXISTS]
+      \\ asm_exists_tac \\ simp []
+      \\ simp [evaluate_def, do_app_def]
+      \\ metis_tac [EVERY_EL]
+    )
+    \\ irule LIST_REL_APPEND_suff
+    \\ conj_tac
+    >- (
+      (* new elements *)
+      simp [LIST_REL_EL_EQN, LENGTH_enumerate, EL_enumerate, EL_MAP]
+      \\ simp [pure_eval_to_def, evaluate_def, option_case_eq]
+      \\ rw []
+      \\ drule_then (fn t => DEP_REWRITE_TAC [t]) ALOOKUP_rel_EQ_ALOOKUP
+      \\ simp [dec_enc]
+      \\ qpat_x_assum `_ ==> pure_eval_to _ _ x _` mp_tac
+      \\ DEP_REWRITE_TAC [COND_false]
+      \\ simp [NULL_FILTER, MEM_MAPi, PULL_EXISTS]
+      \\ fs [sptreeTheory.domain_lookup]
+      \\ asm_exists_tac \\ simp []
+      \\ rw [ALOOKUP_rel_refl, pure_eval_to_def]
+      \\ simp [do_app_def, option_case_eq]
+      \\ simp [ALOOKUP_APPEND, option_case_eq]
+      \\ DEP_REWRITE_TAC [GSYM MEM_ALOOKUP |> Q.SPEC `MAP f zs`]
+      \\ simp [MEM_MAP, EXISTS_PROD, MEM_FILTER, MEM_MAPi, enc_num_to_name_inj]
+      \\ simp [MAP_MAP_o, o_DEF, MAP_REVERSE]
+      \\ irule ALL_DISTINCT_MAP_INJ
+      \\ simp [MEM_FILTER, FORALL_PROD, MEM_MAPi, enc_num_to_name_inj]
+      \\ irule FILTER_ALL_DISTINCT
+      \\ simp [MAPi_enumerate_MAP]
+      \\ irule ALL_DISTINCT_MAP_INJ
+      \\ simp [FORALL_PROD, ALL_DISTINCT_enumerate]
+    )
+    (* prior env *)
+    \\ first_x_assum (fn t => mp_tac t \\ match_mp_tac LIST_REL_mono)
+    \\ simp [FORALL_PROD]
+    \\ rpt strip_tac
+    \\ first_x_assum irule
+    \\ simp []
+    \\ conj_tac \\ TRY (IF_CASES_TAC \\ simp [] \\ NO_TAC)
+    \\ rw [ALOOKUP_rel_def]
+    \\ drule_then (fn t => DEP_REWRITE_TAC [t]) ALOOKUP_rel_EQ_ALOOKUP
+    \\ simp [ALOOKUP_APPEND, option_case_eq, ALOOKUP_NONE, MEM_MAP, FORALL_PROD,
+        MEM_FILTER, MEM_MAPi]
+    \\ CCONTR_TAC \\ fs []
+    \\ fs [dec_enc]
+  )
+  >- (
+    (* Pref *)
+    qpat_x_assum `_ = Match _` mp_tac
+    \\ qmatch_goalsub_abbrev_tac `pmatch _ (Pref _) ref_v`
+    \\ Cases_on `ref_v` \\ simp [flatSemTheory.pmatch_def]
+    \\ rw [CaseEq "match_result", option_case_eq, CaseEq "store_v"]
+    \\ rpt (pairarg_tac \\ fs [])
+    \\ rveq \\ fs []
+    \\ qpat_x_assum `!env. _ ==> pure_eval_to _ _ x _` mp_tac
+    \\ disch_then (qspec_then `env` mp_tac)
+    \\ simp [evaluate_def, pure_eval_to_def, ALOOKUP_rel_refl]
+    \\ rw []
+    \\ fs [evaluate_def, do_app_def]
+    \\ last_x_assum match_mp_tac
+    \\ simp [CaseEq "match_result", PULL_EXISTS]
+    \\ rpt (CHANGED_TAC (asm_exists_tac \\ simp []))
+    \\ fs [libTheory.opt_bind_def, pat_bindings_def]
+    \\ simp [ALOOKUP_rel_cons_false, dec_enc]
+    \\ rpt conj_tac
+    >- (
+      rw [pure_eval_to_def, evaluate_def, option_case_eq]
+      \\ drule_then (fn t => DEP_REWRITE_TAC [t]) ALOOKUP_rel_EQ_ALOOKUP
+      \\ simp [dec_enc]
+    )
+    >- (
+      first_x_assum (fn t => mp_tac t \\ match_mp_tac LIST_REL_mono)
+      \\ simp [FORALL_PROD]
+      \\ rw []
+      \\ first_x_assum irule
+      \\ simp []
+      \\ rw [ALOOKUP_rel_def]
+      \\ drule_then (fn t => DEP_REWRITE_TAC [t]) ALOOKUP_rel_EQ_ALOOKUP
+      \\ simp [dec_enc, FILTER_FILTER]
+      \\ rw []
+      \\ fs [dec_enc]
+    )
+    >- (
+      fs [EVERY_MEM, FORALL_PROD]
+      \\ rw [] \\ res_tac \\ simp []
+    )
+    >- (
+      fs [store_lookup_def, Q.ISPEC `st.refs` EVERY_EL]
+      \\ first_x_assum drule
+      \\ simp []
+    )
+  )
+QED
+
+val s = ``s:'ffi flatSem$state``;
+val s1 = mk_var ("s1", type_of s);
+val s2 = mk_var ("s2", type_of s);
+
+Definition prev_cfg_rel_def:
+  prev_cfg_rel past_cfg cur_cfg =
+  (?tm. subspt tm cur_cfg.type_map /\ past_cfg = cur_cfg with <| type_map := tm |>)
+End
+
+Theorem prev_cfg_rel_refl:
+  prev_cfg_rel cfg cfg
+Proof
+  simp [prev_cfg_rel_def, config_component_equality]
+QED
+
+Theorem prev_cfg_rel_trans:
+  prev_cfg_rel cfg cfg' /\ prev_cfg_rel cfg' cfg'' ==> prev_cfg_rel cfg cfg''
+Proof
+  rw [prev_cfg_rel_def]
+  \\ fs [config_component_equality]
+  \\ metis_tac [subspt_trans]
+QED
+
+val _ = IndDefLib.add_mono_thm ALOOKUP_rel_mono_rel;
+
+Inductive v_rel:
+  (!v v'. simple_basic_val_rel v v' /\
+    LIST_REL (v_rel cfg) (v_container_xs v) (v_container_xs v') ==>
+    v_rel cfg v v') /\
+  (!N vs1 n x vs2 pcfg.
+     ALOOKUP_rel (\x. dec_name_to_num x < N) (v_rel cfg) vs1 vs2 /\
+     prev_cfg_rel pcfg cfg /\
+     FST (compile_exp pcfg x) < N ==>
+     v_rel cfg (Closure vs1 n x)
+       (Closure vs2 n (SND (SND (compile_exp pcfg x))))) /\
+  (!N vs1 fs x vs2.
+     ALOOKUP_rel (\x. dec_name_to_num x < N) (v_rel cfg) vs1 vs2 /\
+     prev_cfg_rel pcfg cfg /\
+     EVERY (\(n,m,e). FST (compile_exp pcfg e) < N) fs ==>
+     v_rel cfg (Recclosure vs1 fs x) (Recclosure vs2
+         (MAP (\(n,m,e). (n,m, SND (SND (compile_exp pcfg e)))) fs) x))
+End
+
+Theorem v_rel_l_cases = TypeBase.nchotomy_of ``: v``
+  |> concl |> dest_forall |> snd |> strip_disj
+  |> map (rhs o snd o strip_exists)
+  |> map (curry mk_comb ``v_rel cfg``)
+  |> map (fn t => mk_comb (t, ``v2 : v``))
+  |> map (SIMP_CONV (srw_ss ()) [Once v_rel_cases])
+  |> LIST_CONJ
+
+val add_q = augment_srw_ss [simpLib.named_rewrites "pair_rel_thm"
+  [quotient_pairTheory.PAIR_REL_THM]];
+
+Definition state_rel_def:
+  state_rel cfg (s:'ffi flatSem$state) (t:'ffi flatSem$state) <=>
+    t.clock = s.clock /\
+    LIST_REL (sv_rel (v_rel cfg)) s.refs t.refs /\
+    t.ffi = s.ffi /\
+    LIST_REL (OPTREL (v_rel cfg)) s.globals t.globals /\
+    t.c = s.c /\
+    s.check_ctor /\
+    t.check_ctor
+End
+
+Theorem state_rel_initial_state:
+  state_rel cfg (initial_state ffi k T) (initial_state ffi k T)
+Proof
+  fs [state_rel_def, initial_state_def]
+QED
+
+Triviality state_rel_IMP_check_ctor:
+  state_rel cfg s t ==> s.check_ctor /\ t.check_ctor
+Proof
+  fs [state_rel_def]
+QED
+
+Triviality state_rel_IMP_clock:
+  state_rel cfg s t ==> t.clock = s.clock
+Proof
+  fs [state_rel_def]
+QED
+
+Triviality state_rel_IMP_c:
+  state_rel cfg s t ==> t.c = s.c
+Proof
+  fs [state_rel_def]
+QED
+
+Overload nv_rel[local] =
+  ``\cfg N. ALOOKUP_rel (\x. dec_name_to_num x < N) (v_rel cfg)``
+
+Definition env_rel_def:
+  env_rel cfg N env1 env2 = nv_rel cfg N env1.v env2.v
+End
+
+val match_rel_def = Define `
+  (match_rel cfg N (Match env1) (Match env2) <=> nv_rel cfg N env1 env2) /\
+  (match_rel cfg N No_match No_match <=> T) /\
+  (match_rel cfg N Match_type_error Match_type_error <=> T) /\
+  (match_rel cfg N _ _ <=> F)`
+
+Theorem match_rel_thms[simp]:
+   (match_rel cfg N Match_type_error e <=> e = Match_type_error) /\
+   (match_rel cfg N e Match_type_error <=> e = Match_type_error) /\
+   (match_rel cfg N No_match e <=> e = No_match) /\
+   (match_rel cfg N e No_match <=> e = No_match)
+Proof
+  Cases_on `e` \\ rw [match_rel_def]
+QED
+
+Theorem MAX_ADD_LESS:
+  (MAX i j + k < l) = (i + k < l /\ j + k < l)
+Proof
+  rw [MAX_DEF]
+QED
+
+Theorem LESS_MAX_ADD:
+  (l < MAX i j + k) = (l < i + k \/ l < j + k)
+Proof
+  rw [MAX_DEF]
+QED
+
+Theorem MAX_ADD_LE:
+  (MAX i j + k <= l) = (i + k <= l /\ j + k <= l)
+Proof
+  rw [MAX_DEF]
+QED
+
+Theorem env_rel_mono:
+  env_rel cfg i env1 env2 /\ j <= i ==>
+  env_rel cfg j env1 env2
+Proof
+  rw [env_rel_def]
+  \\ drule_then irule ALOOKUP_rel_mono
+  \\ simp [FORALL_PROD]
+QED
+
+Theorem env_rel_ALOOKUP:
+  env_rel cfg N env1 env2 /\ dec_name_to_num n < N ==>
+  OPTREL (v_rel cfg) (ALOOKUP env1.v n) (ALOOKUP env2.v n)
+Proof
+  rw [env_rel_def, ALOOKUP_rel_def]
+QED
+
+Theorem ALOOKUP_MAP_3:
+  (!x. MEM x xs ==> FST (f x) = FST x) ==>
+  ALOOKUP (MAP f xs) x = OPTION_MAP (\y. SND (f (x, y))) (ALOOKUP xs x)
+Proof
+  Induct_on `xs` \\ rw []
+  \\ fs [DISJ_IMP_THM, FORALL_AND_THM]
+  \\ Cases_on `f h`
+  \\ Cases_on `h`
+  \\ rw []
+  \\ fs []
+QED
+
+Theorem ALOOKUP_rel_MAP_same:
+  (!x. MEM x xs ==> FST (f x) = FST (g x) /\
+    (P (FST (g x)) ==> R (SND (f x)) (SND (g x)))) ==>
+  ALOOKUP_rel P R (MAP f xs) (MAP g xs)
+Proof
+  Induct_on `xs` \\ rw [ALOOKUP_rel_empty]
+  \\ fs [DISJ_IMP_THM, FORALL_AND_THM]
+  \\ Cases_on `f h` \\ Cases_on `g h`
+  \\ fs [ALOOKUP_rel_cons]
+QED
+
+Theorem do_opapp_thm:
+  do_opapp vs1 = SOME (nvs1, exp) /\ LIST_REL (v_rel cfg) vs1 vs2
+  ==>
+  ?i sg exp' nvs2 prev_cfg. compile_exp prev_cfg exp = (i, sg, exp') /\
+  prev_cfg_rel prev_cfg cfg /\
+  nv_rel cfg (i + 1) nvs1 nvs2 /\ do_opapp vs2 = SOME (nvs2, exp')
+Proof
+  simp [do_opapp_def, pair_case_eq, case_eq_thms, PULL_EXISTS]
+  \\ rw []
+  \\ fs [v_rel_l_cases]
+  \\ rveq \\ fs []
+  \\ simp [PAIR_FST_SND_EQ]
+  \\ goal_assum (first_assum o mp_then (Pat `prev_cfg_reg _ _`) mp_tac)
+  >- (
+    simp [LENGTH_SND_compile_exps]
+    \\ irule ALOOKUP_rel_cons
+    \\ simp []
+    \\ drule_then irule ALOOKUP_rel_mono
+    \\ simp []
+  )
+  \\ fs [PULL_EXISTS, find_recfun_ALOOKUP, ALOOKUP_MAP]
+  \\ simp [ALOOKUP_MAP_3, FORALL_PROD, LENGTH_SND_compile_exps]
+  \\ simp [MAP_MAP_o, o_DEF, UNCURRY, Q.ISPEC `FST` ETA_THM]
+  \\ irule ALOOKUP_rel_cons
+  \\ simp [build_rec_env_eq_MAP]
+  \\ irule ALOOKUP_rel_append_suff
+  \\ simp [MAP_MAP_o, o_DEF, UNCURRY]
+  \\ conj_tac
+  >- (
+    irule ALOOKUP_rel_MAP_same
+    \\ rw [UNCURRY, v_rel_l_cases]
+    \\ metis_tac []
+  )
+  \\ drule_then irule ALOOKUP_rel_mono
+  \\ simp []
+  \\ imp_res_tac ALOOKUP_MEM
+  \\ fs [EVERY_MEM]
+  \\ res_tac
+  \\ fs []
+QED
+
+Theorem do_opapp_thm_REVERSE:
+  do_opapp (REVERSE vs1) = SOME (nvs1, exp) /\ LIST_REL (v_rel cfg) vs1 vs2
+  ==>
+  ?i sg exp' nvs2 prev_cfg.
+  compile_exp prev_cfg exp = (i, sg, exp') /\
+  prev_cfg_rel prev_cfg cfg /\
+  nv_rel cfg (i + 1) nvs1 nvs2 /\
+  do_opapp (REVERSE vs2) = SOME (nvs2, exp')
+Proof
+  rw []
+  \\ drule_then irule do_opapp_thm
+  \\ simp []
+QED
+
+Theorem pmatch_thm:
+  (!(s:'ffi state) p v vs r s1 v1 vs1.
+    pmatch s p v vs = r /\
+    r <> Match_type_error /\
+    state_rel cfg s s1 /\
+    v_rel cfg v v1 /\
+    nv_rel cfg N vs vs1
+    ==> ?r1. pmatch s1 p v1 vs1 = r1 /\ match_rel cfg N r r1) /\
+  (!(s:'ffi state) ps v vs r s1 v1 vs1.
+    pmatch_list s ps v vs = r /\
+    r <> Match_type_error /\
+    state_rel cfg s s1 ∧
+    LIST_REL (v_rel cfg) v v1 /\
+    nv_rel cfg N vs vs1
+    ==> ?r1. pmatch_list s1 ps v1 vs1 = r1 /\ match_rel cfg N r r1)
+Proof
+  ho_match_mp_tac flatSemTheory.pmatch_ind
+  \\ simp [flatSemTheory.pmatch_def, match_rel_def, v_rel_l_cases]
+  \\ rw [match_rel_def]
+  \\ imp_res_tac state_rel_IMP_check_ctor
+  \\ imp_res_tac state_rel_IMP_c
+  \\ fs [flatSemTheory.pmatch_def, pmatch_stamps_ok_OPTREL]
+  \\ rfs []
+  \\ imp_res_tac LIST_REL_LENGTH \\ fs []
+  >- ( irule ALOOKUP_rel_cons \\ simp [] )
+  >- (
+    fs [store_lookup_def, bool_case_eq, option_case_eq]
+    \\ every_case_tac \\ rfs []
+    \\ rpt (first_x_assum drule)
+    \\ fs [state_rel_def, LIST_REL_EL_EQN]
+    \\ rfs []
+    \\ rpt (first_x_assum drule)
+    \\ simp []
+  )
+  >- (
+    every_case_tac \\ fs []
+    \\ rpt (first_x_assum drule \\ rw [])
+    \\ TRY (rpt (asm_exists_tac \\ simp []) \\ NO_TAC)
+    \\ fs [match_rel_def]
+  )
+QED
+
+Theorem simple_val_rel_step_isClosure:
+  simple_basic_val_rel x y ==> ~ isClosure x /\ ~ isClosure y
+Proof
+  Cases_on `x` \\ simp [simple_basic_val_rel_def]
+  \\ rw [] \\ simp []
+QED
+
+Theorem simple_val_rel:
+  simple_val_rel (v_rel cfg)
+Proof
+  simp [simple_val_rel_def, v_rel_cases]
+  \\ rw [] \\ simp []
+  \\ EQ_TAC \\ rw [] \\ fs []
+  \\ metis_tac [simple_val_rel_step_isClosure]
+QED
+
+Theorem simple_state_rel:
+  simple_state_rel (v_rel cfg) (state_rel cfg)
+Proof
+  simp [simple_state_rel_def, state_rel_def]
+QED
+
+Theorem do_app_thm = MATCH_MP simple_do_app_thm
+    (CONJ simple_val_rel simple_state_rel)
+
+Theorem do_app_thm_REVERSE:
+  do_app cc s1 op (REVERSE vs1) = SOME (t1, r1) /\
+  state_rel cfg s1 s2 /\ LIST_REL (v_rel cfg) vs1 vs2
+  ==>
+  ?t2 r2. result_rel (v_rel cfg) (v_rel cfg) r1 r2 /\
+  state_rel cfg t1 t2 /\ do_app cc s2 op (REVERSE vs2) = SOME (t2, r2)
+Proof
+  rw []
+  \\ drule_then irule do_app_thm
+  \\ simp []
+QED
+
+Theorem do_if_helper:
+  do_if b x y = SOME e /\ v_rel cfg b b' ==>
+  ((b' = Boolv T) = (b = Boolv T)) /\ ((b' = Boolv F) = (b = Boolv F))
+Proof
+  simp [Once v_rel_cases]
+  \\ Cases_on `b`
+  \\ rw [Boolv_def]
+  \\ EQ_TAC \\ rw [] \\ fs []
+QED
+
+Theorem list_max_LESS_EVERY:
+  (list_max xs < N) = (0 < N /\ EVERY (\x. x < N) xs)
+Proof
+  Induct_on `xs`
+  \\ simp [list_max_def |> REWRITE_RULE [GSYM MAX_DEF]]
+  \\ metis_tac []
+QED
+
+Theorem max_dec_name_LESS_EVERY:
+  (max_dec_name ns < N) = (0 < N /\ EVERY (\n. dec_name_to_num n < N) ns)
+Proof
+  Induct_on `ns` \\ simp [max_dec_name_def]
+  \\ metis_tac []
+QED
+
+Definition encode_val_def:
+  encode_val (Litv l) = Litv l /\
+  encode_val (Conv stmp xs) = Term
+    (case stmp of NONE => NONE | SOME (i, _) => SOME i)
+    (MAP encode_val xs) /\
+  encode_val (Loc n) = RefPtr n /\
+  encode_val others = Other
+Termination
+  WF_REL_TAC `measure v_size`
+  \\ rw []
+  \\ fs [MEM_SPLIT, SUM_APPEND, v3_size]
+End
+
+Theorem decode_test_simulation:
+  dt_test test enc_v = SOME b /\
+  pure_eval_to s env x v /\
+  enc_v = encode_val v
+  ==>
+  pure_eval_to s env (decode_test tr test x) (Boolv b)
+Proof
+  Cases_on `test` \\ Cases_on `v`
+  \\ simp [encode_val_def]
+  \\ EVERY_CASE_TAC
+  \\ rw []
+  \\ fs [dt_test_def]
+  \\ fs [decode_test_def, pure_eval_to_def, evaluate_def]
+  \\ simp [do_app_def, do_eq_def, lit_same_type_sym]
+  \\ rw [Boolv_def]
+QED
+
+Theorem app_pos_Term_IMP:
+  !xs n. app_pos refs (Pos n pos) (Term c xs) = SOME y ==>
+  n < LENGTH xs /\ app_pos refs pos (EL n xs) = SOME y
+Proof
+  Induct_on `xs`
+  \\ simp [app_pos_def]
+  \\ rw []
+  \\ Cases_on `n`
+  \\ fs [app_pos_def]
+QED
+
+Definition encode_refs_def:
+  encode_refs s = FUN_FMAP (\i. encode_val (case EL i s.refs of Refv v => v))
+    (count (LENGTH s.refs) ∩ {i | ?v. EL i s.refs = Refv v})
+End
+
+Theorem FLOOKUP_encode_refs:
+  FLOOKUP (encode_refs s) n = if n < LENGTH s.refs
+  then (case EL n s.refs of Refv v => SOME (encode_val v) | _ => NONE)
+  else NONE
+Proof
+  simp [encode_refs_def, FLOOKUP_FUN_FMAP]
+  \\ EVERY_CASE_TAC \\ simp []
+QED
+
+Theorem decode_pos_simulation:
+  !pos exp x. app_pos (encode_refs s) pos (encode_val x) = SOME enc_y /\
+  pure_eval_to s env exp x
+  ==>
+  ?y. enc_y = encode_val y /\
+  pure_eval_to s env (decode_pos tr exp pos) y
+Proof
+  Induct
+  \\ simp [app_pos_def, decode_pos_def]
+  \\ rw []
+  \\ fs [pure_eval_to_def]
+  \\ first_x_assum irule
+  \\ Cases_on `n` \\ Cases_on `x` \\ fs [app_pos_def, encode_val_def]
+  >- (
+    Cases_on `l` \\ fs [app_pos_def]
+    \\ simp [evaluate_def, do_app_def]
+  )
+  >- (
+    fs [option_case_eq]
+    \\ simp [evaluate_def, do_app_def]
+    \\ fs [store_lookup_def, FLOOKUP_encode_refs, case_eq_thms]
+  )
+  >- (
+    simp [evaluate_def, do_app_def]
+    \\ Cases_on `l` \\ fs [app_pos_def]
+    \\ drule app_pos_Term_IMP
+    \\ csimp [EL_MAP]
+  )
+QED
+
+Theorem fold_Boolv = GSYM (LIST_CONJ [
+  Boolv_def |> REWRITE_RULE [GSYM backend_commonTheory.bool_to_tag_def],
+  backend_commonTheory.bool_to_tag_def])
+
+Theorem do_eq_Boolv:
+  do_eq (Boolv x) (Boolv y) = Eq_val (x = y)
+Proof
+  EVAL_TAC \\ EVERY_CASE_TAC \\ fs []
+QED
+
+Theorem do_if_Boolv:
+  do_if (Boolv x) y z = SOME (if x then y else z)
+Proof
+  EVAL_TAC \\ EVERY_CASE_TAC \\ fs []
+QED
+
+Theorem decode_guard_simulation:
+  !b. dt_eval_guard (encode_refs s) (encode_val y) gd = SOME b /\
+  pure_eval_to s env x y /\
+  (!bv. ((bool_to_tag bv,SOME bool_id),0) ∈ s.c)
+  ==>
+  pure_eval_to s env (decode_guard tr x gd) (Boolv b)
+Proof
+  Induct_on `gd`
+  \\ simp [decode_guard_def, FORALL_PROD, dt_eval_guard_def]
+  \\ fs [pure_eval_to_def, evaluate_def, option_case_eq]
+  \\ rw []
+  \\ fs [Bool_def, evaluate_def, fold_Boolv, do_app_def, do_eq_Boolv,
+        do_if_Boolv, bool_case_eq]
+  \\ drule decode_test_simulation
+  \\ fs [pure_eval_to_def]
+  \\ disch_then irule
+  \\ drule decode_pos_simulation
+  \\ simp [pure_eval_to_def]
+  \\ disch_then drule
+  \\ metis_tac []
+QED
+
+val init_in_c_imps1 = ASSUME ``initial_ctors ⊆ c``
+  |> SIMP_RULE (srw_ss()) [initial_ctors_def]
+  |> CONJUNCTS |> map DISCH_ALL
+
+Theorem init_in_c_bool_tag:
+  initial_ctors ⊆ c ==>
+  ((bool_to_tag bv,SOME bool_id),0) ∈ c
+Proof
+  rw [initial_ctors_def, backend_commonTheory.bool_to_tag_def]
+QED
+
+val v_cons_in_c_exn_simps = map (QCONV (SIMP_CONV (srw_ss())
+    [subscript_exn_v_def, bind_exn_v_def, chr_exn_v_def, div_exn_v_def]))
+  [``v_cons_in_c c subscript_exn_v``,
+    ``v_cons_in_c c bind_exn_v``,
+    ``v_cons_in_c c chr_exn_v``,
+    ``v_cons_in_c c div_exn_v``];
+
+Theorem init_in_c_imps2:
+  (initial_ctors ⊆ c ==> v_cons_in_c c (Unitv T)) /\
+  (initial_ctors ⊆ c ==> v_cons_in_c c (Boolv b))
+Proof
+  rw [Unitv_def, Boolv_def] \\ fs [initial_ctors_def]
+QED
+
+Theorem init_in_c_list_to_v:
+  initial_ctors ⊆ c ==>
+  v_cons_in_c c (list_to_v xs) = EVERY (v_cons_in_c c) xs
+Proof
+  Induct_on `xs` \\ simp [list_to_v_def, list_ctors_def, initial_ctors_def]
+QED
+
+val init_in_c_simps = init_in_c_imps1 @ v_cons_in_c_exn_simps
+    @ CONJUNCTS init_in_c_imps2 @ [init_in_c_list_to_v]
+
+Theorem v_to_list_in_c:
+  !v vs. v_to_list v = SOME vs /\ v_cons_in_c c v ==>
+  EVERY (v_cons_in_c c) vs
+Proof
+  ho_match_mp_tac v_to_list_ind
+  \\ simp [v_to_list_def, case_eq_thms]
+  \\ rw [] \\ simp []
+QED
+
+Theorem simp_guard_thm:
+  !gd x. dt_eval_guard r v gd = SOME x ==>
+  dt_eval_guard r v (simp_guard gd) = SOME x
+Proof
+  ho_match_mp_tac simp_guard_ind
+  \\ rw [simp_guard_def]
+  \\ fs [dt_eval_guard_def]
+  \\ EVERY_CASE_TAC
+  \\ fs []
+  \\ rfs []
+  \\ metis_tac []
+QED
+
+Theorem decode_dtree_simulation:
+  pattern_semantics$dt_eval (encode_refs s) (encode_val y) dtree = SOME v /\
+  pure_eval_to s env x y /\
+  initial_ctors ⊆ s.c
+  ==>
+  evaluate env s [decode_dtree tr exps x default_x dtree] =
+  evaluate env s [case v of MatchSuccess i => (case lookup i exps of
+    SOME exp => exp | NONE => default_x) | _ => default_x]
+Proof
+  Induct_on `dtree`
+  \\ simp [dt_eval_def, decode_dtree_def]
+  \\ rw [evaluate_def]
+  \\ fs [option_case_eq]
+  \\ imp_res_tac simp_guard_thm
+  \\ drule_then drule decode_guard_simulation
+  \\ rfs [dt_eval_guard_def, init_in_c_bool_tag]
+  \\ rw [pure_eval_to_def]
+  \\ fs []
+  \\ simp [do_if_Boolv]
+  \\ CASE_TAC \\ fs []
+QED
+
+Definition c_type_map_rel_def:
+  c_type_map_rel c type_map = (!stmp ty_id len.
+    (((stmp, SOME ty_id), len) ∈ c) <=>
+        ?tys. lookup ty_id type_map = SOME tys /\ MEM (stmp, len) tys)
+End
+
+Theorem ctor_same_type_v_cons_is_sibling_subspt:
+  ctor_same_type (SOME stmp) (SOME stmp') /\
+  c_type_map_rel c tm' /\
+  subspt tm tm' /\
+  (stmp, len) ∈ c /\
+  (stmp', len') ∈ c /\
+  stmp' = (x, SOME y) ==>
+  pattern_semantics$is_sibling (x, len') (lookup y tm)
+Proof
+  simp [c_type_map_rel_def]
+  \\ Cases_on `stmp` \\ Cases_on `stmp'` \\ rw []
+  \\ rfs [ctor_same_type_def]
+  \\ rveq \\ fs []
+  \\ rveq \\ fs []
+  \\ simp [pattern_semanticsTheory.is_sibling_def]
+  \\ fs [subspt_lookup]
+  \\ Cases_on `lookup y tm` \\ simp [pattern_semanticsTheory.is_sibling_def]
+  \\ first_x_assum drule
+  \\ rw []
+  \\ simp []
+QED
+
+Theorem encode_pat_match_simulation:
+  (! ^s pat v pre_bindings res.
+  flatSem$pmatch s pat v pre_bindings = res /\
+  res <> Match_type_error /\
+  s.check_ctor /\
+  v_cons_in_c s.c v /\
+  EVERY (EVERY (v_cons_in_c s.c) ∘ store_v_vs) s.refs /\
+  subspt tm tm' /\
+  c_type_map_rel s.c tm'
+  ==>
+  pattern_semantics$pmatch (encode_refs s) (encode_pat tm pat) (encode_val v) =
+  (if res = No_match then PMatchFailure else PMatchSuccess)
+  ) /\
+  (! ^s ps vs pre_bindings res.
+  flatSem$pmatch_list s ps vs pre_bindings = res /\
+  res <> Match_type_error /\
+  s.check_ctor /\
+  EVERY (v_cons_in_c s.c) vs /\
+  EVERY (EVERY (v_cons_in_c s.c) ∘ store_v_vs) s.refs /\
+  subspt tm tm' /\
+  c_type_map_rel s.c tm'
+  ==>
+  pattern_semantics$pmatch_list (encode_refs s) (MAP (encode_pat tm) ps)
+    (MAP encode_val vs) =
+  (if res = No_match then PMatchFailure else PMatchSuccess))
+Proof
+  ho_match_mp_tac flatSemTheory.pmatch_ind
+  \\ rpt strip_tac
+  \\ fs [encode_pat_def, encode_val_def,
+    Q.ISPEC `encode_val` ETA_THM, Q.ISPEC `encode_pat m` ETA_THM]
+  \\ fs [flatSemTheory.pmatch_def, pmatch_def]
+  \\ TRY (fs [pmatch_stamps_ok_def, bool_case_eq] \\ rveq \\ fs [] \\ NO_TAC)
+  >- (
+    (* conses *)
+    fs [Q.GEN `t` bool_case_eq |> Q.ISPEC `Match_type_error`] \\ fs []
+    \\ fs [pmatch_stamps_ok_OPTREL, v_cons_in_c_def, OPTREL_def]
+    \\ rfs [] \\ fs []
+    \\ simp [pmatch_def]
+    \\ drule_then drule ctor_same_type_v_cons_is_sibling_subspt
+    \\ rpt (disch_then drule)
+    \\ rpt (CASE_TAC \\ fs [ctor_same_type_def, same_ctor_def, pmatch_def,
+            pattern_semanticsTheory.is_sibling_def])
+  )
+  >- (
+    (* refs *)
+    fs [case_eq_thms]
+    \\ rveq \\ fs []
+    \\ fs [FLOOKUP_encode_refs, store_lookup_def, EVERY_EL]
+    \\ first_x_assum drule
+    \\ simp []
+  )
+  >- (
+    fs [CaseEq "match_result"]
+    \\ rveq \\ fs []
+  )
+QED
+
+Theorem pmatch_rows_encode:
+  !pats j_offs.
+  pmatch_rows pats s v <> Match_type_error /\
+  v_cons_in_c s.c v /\
+  EVERY (EVERY (v_cons_in_c s.c) ∘ store_v_vs) s.refs /\
+  subspt tm cfg.type_map /\
+  c_type_map_rel s.c cfg.type_map /\ s.check_ctor
+  ==>
+  case (pattern_semantics$match (encode_refs s)
+    (MAPi (λj (p,_). (encode_pat tm p, j + j_offs)) pats) (encode_val v))
+    of NONE => F
+    | SOME (MatchSuccess n) => ?i env. n = i + j_offs /\ i < LENGTH pats /\
+        pmatch s (FST (EL i pats)) v [] = Match env /\
+        pmatch_rows pats s v = Match (env, EL i pats)
+    | _ => pmatch_rows pats s v = No_match
+Proof
+  Induct_on `pats`
+  \\ simp [FORALL_PROD, pmatch_rows_def, match_def]
+  \\ rw []
+  \\ qmatch_asmsub_abbrev_tac `pmatch _ hd_pat _ []`
+  \\ Cases_on `pmatch s hd_pat v [] = Match_type_error`
+  \\ fs []
+  \\ drule_then drule
+    (SIMP_RULE bool_ss [] (CONJUNCT1 encode_pat_match_simulation))
+  \\ simp [combinTheory.o_ABS_L]
+  \\ disch_then drule
+  \\ first_x_assum (qspec_then `SUC j_offs` mp_tac)
+  \\ simp_tac (bool_ss ++ numSimps.ARITH_AC_ss) [ADD1]
+  (* make this variable sort left by hand. ugh *)
+  \\ qabbrev_tac `aj_offs = j_offs`
+  \\ rw []
+  >- (
+    (* match failed *)
+    rpt (CASE_TAC \\ fs [])
+    \\ rfs []
+    \\ simp [GSYM ADD1]
+  )
+  \\ Cases_on `pmatch s hd_pat v []` \\ fs []
+  \\ EVERY_CASE_TAC \\ fs []
+  \\ qexists_tac `0` \\ simp []
+QED
+
+Theorem naive_pattern_match_correct:
+  !t mats vs exp res bindings.
+  naive_pattern_match t mats = exp /\
+  pmatch_list s (MAP FST mats) vs bindings = res /\
+  res <> Match_type_error /\
+  LIST_REL (pure_eval_to s env) (MAP SND mats) vs /\
+  s.check_ctor /\
+  initial_ctors ⊆ s.c ==>
+  pure_eval_to s env exp (Boolv (res <> No_match))
+Proof
+  ho_match_mp_tac naive_pattern_match_ind
+  \\ simp [naive_pattern_match_def]
+  \\ rw []
+  \\ fs [pure_eval_to_def, evaluate_def, Bool_def, init_in_c_bool_tag,
+        fold_Boolv, flatSemTheory.pmatch_def]
+  \\ Cases_on `y` \\ fs [flatSemTheory.pmatch_def]
+  >- (
+    (* lit eq *)
+    fs [do_app_def, do_eq_def]
+    \\ rw []
+    \\ fs [lit_same_type_sym, do_if_Boolv]
+    \\ EVERY_CASE_TAC \\ fs []
+    \\ simp [evaluate_def, Bool_def, fold_Boolv, init_in_c_bool_tag]
+  )
+  >- (
+    (* cons no tag *)
+    rw [] \\ fs [pmatch_stamps_ok_OPTREL, OPTREL_def]
+    \\ first_x_assum (qspecl_then [`l ++ ys`, `bindings`] mp_tac)
+    \\ simp [flatPropsTheory.pmatch_list_append, o_DEF]
+    \\ simp [listTheory.LIST_REL_APPEND_EQ]
+    \\ simp [LIST_REL_EL_EQN, pure_eval_to_def, evaluate_def, do_app_def]
+  )
+  >- (
+    (* cons with tag *)
+    qmatch_goalsub_abbrev_tac `if ~ ok then Match_type_error else _`
+    \\ Cases_on `ok` \\ fs []
+    \\ fs [markerTheory.Abbrev_def, pmatch_stamps_ok_OPTREL, OPTREL_SOME]
+    \\ rveq \\ fs []
+    \\ rename [`ctor_same_type (SOME stmp) (SOME stmp')`]
+    \\ Cases_on `stmp` \\ Cases_on `stmp'`
+    \\ fs [ctor_same_type_def]
+    \\ rveq \\ fs []
+    \\ simp [do_app_def]
+    \\ simp [do_if_Boolv]
+    \\ rw [] \\ fs [] \\ simp [evaluate_def, fold_Boolv, init_in_c_bool_tag]
+    \\ TRY (EVERY_CASE_TAC \\ fs [] \\ NO_TAC)
+    \\ first_x_assum (qspecl_then [`l ++ ys`, `bindings`] mp_tac)
+    \\ simp [flatPropsTheory.pmatch_list_append, o_DEF]
+    \\ simp [listTheory.LIST_REL_APPEND_EQ]
+    \\ simp [LIST_REL_EL_EQN, pure_eval_to_def, evaluate_def, do_app_def]
+  )
+  >- (
+    (* ref *)
+    CASE_TAC \\ fs []
+    \\ CASE_TAC \\ fs []
+    \\ fs [PULL_EXISTS, flatSemTheory.pmatch_def]
+    \\ fs [do_app_def]
+  )
+QED
+
+Theorem naive_pattern_matches_correct:
+  !t x mats dflt exp v res.
+  naive_pattern_matches t x mats dflt = exp /\
+  pure_eval_to s env x v /\
+  pmatch_rows mats s v = res /\
+  res <> Match_type_error /\
+  s.check_ctor /\
+  initial_ctors ⊆ s.c ==>
+  evaluate env s [exp] = (case res of Match (_, _, exp) =>
+      evaluate env s [exp]
+    | _ => evaluate env s [dflt])
+Proof
+  ho_match_mp_tac naive_pattern_matches_ind
+  \\ simp [naive_pattern_matches_def, pmatch_rows_def]
+  \\ rw []
+  \\ simp [evaluate_def]
+  \\ `?pm_exp. naive_pattern_match t [(p,x)] = pm_exp` by simp []
+  \\ drule naive_pattern_match_correct
+  \\ simp [PULL_EXISTS, flatSemTheory.pmatch_def]
+  \\ disch_then (qspecl_then [`s`, `env`, `[]`, `v`] mp_tac)
+  \\ fs [pure_eval_to_def]
+  \\ impl_tac
+  >- rpt (CASE_TAC \\ fs [])
+  \\ simp [do_if_Boolv]
+  \\ rpt (CASE_TAC \\ fs [])
+QED
+
+Theorem pmatch_rows_same_FST:
+  !pats pats2. MAP FST pats = MAP FST pats2 ==>
+  case pmatch_rows pats s v of
+    | Match_type_error => pmatch_rows pats2 s v = Match_type_error
+    | No_match => pmatch_rows pats2 s v = No_match
+    | Match (env,p,e) => ?i. i < LENGTH pats2 /\ EL i pats = (p, e) /\
+        pmatch_rows pats2 s v = Match (env, EL i pats2)
+Proof
+  Induct \\ simp [pmatch_rows_def]
+  \\ gen_tac \\ Cases \\ simp []
+  \\ Cases_on `h` \\ Cases_on `h'`
+  \\ simp [pmatch_rows_def]
+  \\ rw []
+  \\ first_x_assum drule
+  \\ rpt (CASE_TAC \\ fs [])
+  \\ rw []
+  \\ TRY (qexists_tac `0` \\ simp [] \\ NO_TAC)
+  \\ TRY (qexists_tac `SUC i` \\ simp [] \\ NO_TAC)
+QED
+
+Triviality comp_thm = pattern_compTheory.comp_thm
+  |> REWRITE_RULE [GSYM quantHeuristicsTheory.IS_SOME_EQ_NOT_NONE]
+  |> SIMP_RULE bool_ss [IS_SOME_EXISTS, PULL_EXISTS]
+
+Theorem evaluate_compile_pats:
+  pmatch_rows pats s v <> Match_type_error /\
+  pure_eval_to s env exp v /\
+  prev_cfg_rel prev_cfg cfg /\
+  v_cons_in_c s.c v /\
+  initial_ctors ⊆ s.c /\
+  s.check_ctor /\
+  EVERY (EVERY (v_cons_in_c s.c) ∘ store_v_vs) s.refs /\
+  c_type_map_rel s.c cfg.type_map ==>
+  evaluate env s [compile_pats prev_cfg naive t N exp default_x pats] =
+  evaluate env s [case pmatch_rows pats s v of
+    | Match (env', p', e') => compile_pat_rhs t N exp (p', e')
+    | _ => default_x]
+Proof
+  rw [compile_pats_def]
+  \\ fs [prev_cfg_rel_def]
+  >- (
+    (* naive case *)
+    drule (SIMP_RULE bool_ss [] naive_pattern_matches_correct)
+    \\ disch_then (fn t => DEP_REWRITE_TAC [t])
+    \\ simp []
+    \\ qmatch_goalsub_abbrev_tac `ZIP map_pats`
+    \\ Q.ISPECL_THEN [`s`, `v`, `ZIP map_pats`, `pats`] mp_tac
+        (Q.GENL [`s`, `v`] pmatch_rows_same_FST)
+    \\ fs [markerTheory.Abbrev_def, MAP_ZIP]
+    \\ rpt (CASE_TAC \\ fs [])
+    \\ rw []
+    \\ rfs [EL_ZIP, EL_MAP]
+  )
+  \\ drule (Q.SPECL [`pats`, `0`] pmatch_rows_encode)
+  \\ rpt (disch_then drule)
+  \\ TOP_CASE_TAC
+  \\ imp_res_tac comp_thm
+  \\ drule_then drule decode_dtree_simulation
+  \\ simp [lookup_fromList]
+  \\ EVERY_CASE_TAC \\ fs []
+  \\ simp [EL_MAP]
+QED
+
+Theorem pmatch_rows_IMP_pmatch:
+  pmatch_rows pats s v = Match (env, p, exp) ==>
+  pmatch s p v [] = Match env
+Proof
+  Induct_on `pats` \\ simp [FORALL_PROD, pmatch_rows_def]
+  \\ rw []
+  \\ fs [CaseEq "match_result"] \\ rveq \\ fs []
+QED
+
+Theorem compile_match_pmatch_rows:
+  !pats k sg pats2 res.
+  compile_match prev_cfg pats = (k, sg, pats2) /\
+  v_rel cfg v v' /\
+  state_rel cfg s t /\
+  k <= N /\
+  pmatch_rows pats s v = res /\
+  prev_cfg_rel prev_cfg cfg ==>
+  case res of
+    | Match_type_error => T
+    | No_match => pmatch_rows pats2 t v' = No_match
+    | Match (env, p, e) => ?i env'. i < LENGTH pats /\ i < LENGTH pats2 /\
+        (p, e) = EL i pats /\ nv_rel cfg N env env' /\
+        pmatch_rows pats2 t v' = Match (env', EL i pats2)
+Proof
+  Induct
+  \\ simp [FORALL_PROD, compile_exp_def, pmatch_rows_def]
+  \\ rw []
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ Cases_on `pmatch s p_1 v []` \\ fs []
+  \\ drule (CONJUNCT1 pmatch_thm)
+  \\ simp []
+  \\ disch_then (drule_then drule)
+  \\ simp []
+  \\ disch_then (qspecl_then [`N`, `[]`] mp_tac)
+  \\ simp [ALOOKUP_rel_empty]
+  \\ rw []
+  \\ fs [pmatch_rows_def]
+  \\ EVERY_CASE_TAC \\ fs [match_rel_def]
+  \\ TRY (qexists_tac `0` \\ simp [] \\ NO_TAC)
+  \\ TRY (qexists_tac `SUC i'` \\ simp [] \\ NO_TAC)
+QED
+
+Theorem compile_match_EL:
+  !pats pats2 k sg i.
+  compile_match cfg pats = (k, sg, pats2) /\
+  i < LENGTH pats /\
+  EL i pats = (pat, exp) ==>
+  ?exp_i sg exp'.
+  compile_exp cfg exp = (exp_i, sg, exp') /\
+  EL i pats2 = (pat, exp') /\
+  exp_i <= k /\ max_dec_name (pat_bindings pat []) <= k
+Proof
+  Induct
+  \\ simp [FORALL_PROD, compile_exp_def]
+  \\ rw []
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ Cases_on `i`
+  \\ fs [] \\ rveq \\ fs []
+  \\ first_x_assum drule
+  \\ rw []
+  \\ simp []
+QED
+
+Theorem evaluate_compile_pat_rhs:
+  evaluate uenv s [compile_pat_rhs tr N (Var_local tr (enc_num_to_name N ""))
+    (p, exp)] = (t, res) /\
+  pmatch s p v [] = Match bindings /\
+  env_rel cfg M env1 env2 /\
+  nv_rel cfg M l_bindings bindings /\
+  uenv.v = (enc_num_to_name N "", v) :: env2.v /\
+  N <= M /\
+  max_dec_name (pat_bindings p []) < N - 1 /\
+  v_cons_in_c s.c v /\
+  EVERY (EVERY (v_cons_in_c s.c) ∘ store_v_vs) s.refs /\
+  EVERY (v_cons_in_c s.c ∘ SND) env2.v
+  ==>
+  ?ext_env.
+  evaluate ext_env s [exp] = (t, res) /\
+  env_rel cfg (N - 1) <| v := l_bindings ++ env1.v |> ext_env /\
+  EVERY (v_cons_in_c s.c ∘ SND) ext_env.v
+Proof
+  simp [compile_pat_rhs_def, max_dec_name_LESS_EVERY]
+  \\ qmatch_goalsub_abbrev_tac `evaluate _ _ [SND comp]`
+  \\ PairCases_on `comp`
+  \\ fs [markerTheory.Abbrev_def, Q.ISPEC `(a, b)` EQ_SYM_EQ]
+  \\ rw []
+  \\ drule (compile_pat_bindings_simulation |> SPEC_ALL |> Q.GEN `vs`
+        |> Q.SPEC `[v]`)
+  \\ simp [flatSemTheory.pmatch_def, CaseEq "match_result"]
+  \\ rpt (disch_then drule)
+  \\ disch_then (qspecl_then [`N - 1`, `env2.v`] mp_tac)
+  \\ simp []
+  \\ impl_tac
+  >- (
+    simp [ALOOKUP_rel_def, pure_eval_to_def, evaluate_def, dec_enc]
+    \\ rw [] \\ fs [dec_enc]
+  )
+  \\ rw []
+  \\ asm_exists_tac
+  \\ fs [env_rel_def]
+  \\ fs [ALOOKUP_rel_def, ALOOKUP_APPEND]
+  \\ rw []
+  \\ rpt (first_x_assum (qspec_then `x` mp_tac))
+  \\ simp [OPTREL_def, case_eq_thms]
+  \\ rw [] \\ fs []
+QED
+
+val EVERY_EL_IMP = ASSUME ``EVERY P xs`` |> REWRITE_RULE [EVERY_EL]
+  |> DISCH_ALL
+
+Theorem do_app_v_inv:
+  do_app cc s op vs = SOME (t, r) /\
+  EVERY (EVERY (v_cons_in_c s.c) ∘ store_v_vs) s.refs /\
+  EVERY (OPTION_ALL (v_cons_in_c s.c)) s.globals /\
+  initial_ctors ⊆ s.c /\
+  cc /\
+  EVERY (v_cons_in_c s.c) vs
+  ==>
+  t.c = s.c /\
+  EVERY (EVERY (v_cons_in_c s.c) ∘ store_v_vs) t.refs /\
+  EVERY (OPTION_ALL (v_cons_in_c s.c)) t.globals /\
+  EVERY (v_cons_in_c s.c) (result_vs (list_result r))
+Proof
+  simp [do_app_def, case_eq_thms, pair_case_eq, bool_case_eq, store_alloc_def,
+    store_assign_def]
+  \\ rpt disch_tac \\ fs []
+  \\ rveq \\ simp init_in_c_simps
+  \\ TRY (pairarg_tac \\ rpt (pairarg_tac \\ fs []) \\ rveq \\ fs [])
+  \\ fs [IMP_EVERY_LUPDATE, EVERY_MAP, IS_SOME_EXISTS, GREATER_EQ,
+    NOT_LESS_EQUAL, EVERY_REPLICATE]
+  \\ TRY (drule_then drule EVERY_EL_IMP \\ simp [])
+  \\ TRY (
+    drule_then drule v_to_list_in_c
+    \\ imp_res_tac v_to_list_in_c
+    \\ simp []
+  )
+  \\ fs [store_lookup_def]
+  \\ rw [IMP_EVERY_LUPDATE]
+  \\ drule_then drule EVERY_EL_IMP \\ rw []
+  \\ drule_then drule EVERY_EL_IMP \\ rw []
+QED
+
+Theorem do_opapp_v_inv:
+  do_opapp vs = SOME (nvs, exp) /\
+  EVERY (v_cons_in_c c) vs
+  ==>
+  EVERY (v_cons_in_c c ∘ SND) nvs
+Proof
+  simp [do_opapp_def, case_eq_thms]
+  \\ rw [] \\ fs []
+  \\ fs [find_recfun_ALOOKUP, pair_case_eq]
+  \\ rveq \\ fs [build_rec_env_eq_MAP, EVERY_MAP]
+  \\ simp [UNCURRY]
+QED
+
+Theorem state_rel_dec_clock:
+  state_rel cfg s1 s2 ==> state_rel cfg (dec_clock s1) (dec_clock s2)
+Proof
+  simp [state_rel_def, dec_clock_def]
+QED
+
+Theorem compile_exps_evaluate:
+  !env1 ^s1 xs t1 r1 i sg ys N env2 ^s2 prev_cfg.
+    evaluate env1 s1 xs = (t1, r1) /\
+    compile_exps prev_cfg xs = (i, sg, ys) /\
+    r1 <> Rerr (Rabort Rtype_error) /\
+    env_rel cfg N env1 env2 /\ state_rel cfg s1 s2 /\ i < N /\
+    prev_cfg_rel prev_cfg cfg /\
+    EVERY (EVERY (v_cons_in_c s2.c) ∘ store_v_vs) s2.refs /\
+    EVERY (OPTION_ALL (v_cons_in_c s2.c)) s2.globals /\
+    initial_ctors ⊆ s2.c /\
+    EVERY (v_cons_in_c s2.c ∘ SND) env2.v /\
+    c_type_map_rel s2.c cfg.type_map
+    ==>
+    ?t2 r2.
+      result_rel (LIST_REL (v_rel cfg)) (v_rel cfg) r1 r2 /\
+      state_rel cfg t1 t2 /\
+      evaluate env2 s2 ys = (t2, r2) /\
+      EVERY (EVERY (v_cons_in_c s2.c) ∘ store_v_vs) t2.refs /\
+      EVERY (OPTION_ALL (v_cons_in_c s2.c)) t2.globals /\
+      EVERY (v_cons_in_c s2.c) (result_vs r2) /\
+      t2.c = s2.c
+Proof
+  ho_match_mp_tac evaluate_ind
+  \\ simp [evaluate_def, compile_exp_def, result_vs_def]
+  \\ rpt (gen_tac ORELSE disch_tac ORELSE conj_tac)
+  \\ simp [v_rel_rules]
+  \\ fs [pair_case_eq, Q.GEN `t` bool_case_eq
+    |> Q.ISPEC `(x, Rerr (Rabort Rtype_error))`, Q.GEN `f` bool_case_eq
+    |> Q.ISPEC `(x, Rerr (Rabort Rtype_error))`] \\ fs []
+  \\ fs [miscTheory.UNCURRY_eq_pair, PULL_EXISTS]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2, listTheory.LENGTH_CONS]
+  \\ rveq \\ fs [evaluate_def, v_rel_rules, GSYM PULL_FORALL]
+  \\ TRY (rename [`rv_1 ≠ Rerr (Rabort Rtype_error) ==> _`]
+    \\ (Cases_on `rv_1 = Rerr (Rabort Rtype_error)` >- fs [])
+    \\ fs [])
+  \\ TRY (rename [`rv_1 ≠ Rerr (Rabort Rtype_error) /\ _`]
+    \\ (Cases_on `rv_1 = Rerr (Rabort Rtype_error)` >- fs [])
+    \\ fs [])
+  \\ TRY (rename [`~ st.check_ctor`]
+    \\ imp_res_tac state_rel_IMP_check_ctor \\ fs [])
+  >- (
+    rpt (first_x_assum drule \\ rw [])
+    \\ rveq \\ fs []
+    \\ fs [case_eq_thms, pair_case_eq] \\ rveq \\ fs [] \\ rveq \\ fs []
+    \\ imp_res_tac evaluate_length
+    \\ rpt (first_x_assum drule \\ rw [])
+    \\ fs [quantHeuristicsTheory.LIST_LENGTH_2, listTheory.LENGTH_CONS]
+    \\ rveq \\ fs []
+    \\ rveq \\ fs []
+  )
+  >- (
+    rpt (first_x_assum drule \\ rw [])
+    \\ rveq \\ fs []
+    \\ simp [evaluate_def, v_cons_in_c_def]
+    \\ fs [case_eq_thms, pair_case_eq] \\ rveq \\ fs [] \\ rveq \\ fs []
+    \\ imp_res_tac evaluate_length
+    \\ rpt (first_x_assum drule \\ rw [])
+    \\ fs [quantHeuristicsTheory.LIST_LENGTH_2, listTheory.LENGTH_CONS]
+    \\ rveq \\ fs []
+    \\ rveq \\ fs []
+  )
+  >- (
+    (* Handle *)
+    simp [evaluate_def, pat_bindings_def, pmatch_rows_def,
+        flatSemTheory.pmatch_def]
+    \\ fs [case_eq_thms] \\ rveq \\ fs [] \\ rveq \\ fs []
+    \\ rw []
+    \\ first_x_assum (drule_then (drule_then drule))
+    \\ TRY (fs [MAX_ADD_LESS, PULL_EXISTS] \\ NO_TAC)
+    (* down to raise+pmatch case *)
+    \\ impl_tac >- fs [MAX_ADD_LESS]
+    \\ rw []
+    \\ fs [result_vs_def]
+    \\ rename [`compile_match _ _ = (k, _)`]
+    \\ `k <= N` by fs [MAX_ADD_LESS]
+    \\ drule_then (drule_then drule) compile_match_pmatch_rows
+    \\ disch_then drule
+    \\ rw []
+    \\ DEP_REWRITE_TAC [Q.GEN `v` evaluate_compile_pats |> Q.SPEC `v'`]
+    \\ imp_res_tac state_rel_IMP_check_ctor
+    \\ simp [pure_eval_to_def, evaluate_def]
+    \\ fs [CaseEq "match_result", pair_case_eq, bool_case_eq] \\ rveq
+    \\ fs [] \\ rfs [] \\ simp [evaluate_def, result_vs_def]
+    \\ fs [Q.ISPEC `(a, b)` EQ_SYM_EQ]
+    \\ drule_then (drule_then drule) compile_match_EL
+    \\ rw [] \\ fs []
+    \\ imp_res_tac pmatch_rows_IMP_pmatch
+    \\ qmatch_goalsub_abbrev_tac `x = (_, _)`
+    \\ PairCases_on `x`
+    \\ fs [markerTheory.Abbrev_def, Q.ISPEC `(a, b)` EQ_SYM_EQ]
+    \\ drule_then drule evaluate_compile_pat_rhs
+    \\ simp [LESS_MAX_ADD]
+    \\ rpt (disch_then drule)
+    \\ simp []
+    \\ disch_tac
+    \\ fs []
+    \\ last_x_assum (drule_then (drule_then drule))
+    \\ simp [LESS_MAX_ADD]
+  )
+  >- (
+    (* Conv, no tag *)
+    imp_res_tac state_rel_IMP_check_ctor
+    \\ last_x_assum (drule_then (drule_then drule))
+    \\ rw [] \\ simp []
+    \\ fs [case_eq_thms] \\ rveq \\ fs []
+    \\ rveq \\ fs []
+    \\ simp [v_rel_rules, EVERY_REVERSE]
+  )
+  >- (
+    (* Conv with tag *)
+    imp_res_tac state_rel_IMP_check_ctor
+    \\ last_x_assum (drule_then (drule_then drule))
+    \\ rw [] \\ simp []
+    \\ fs [case_eq_thms] \\ rveq \\ fs []
+    \\ rveq \\ fs []
+    \\ simp [PULL_EXISTS, v_rel_rules, EVERY_REVERSE]
+    \\ imp_res_tac evaluate_length
+    \\ fs [state_rel_def]
+    \\ rfs []
+  )
+  >- (
+    drule_then drule env_rel_ALOOKUP
+    \\ strip_tac \\ fs [optionTheory.OPTREL_def]
+  )
+  >- (
+    (* invs of looked up var *)
+    fs [case_eq_thms]
+    \\ drule_then drule env_rel_ALOOKUP
+    \\ simp [optionTheory.OPTREL_def]
+    \\ rw []
+    \\ simp []
+    \\ imp_res_tac ALOOKUP_MEM
+    \\ fs [EVERY_MEM]
+    \\ res_tac \\ fs []
+  )
+  >- (
+    simp [Once v_rel_cases]
+    \\ fs [env_rel_def]
+    \\ metis_tac [FST, SND, HD, prev_cfg_rel_refl]
+  )
+  >- (
+    (* App *)
+    last_x_assum (drule_then (drule_then drule))
+    \\ rw []
+    \\ fs [case_eq_thms] \\ rveq \\ fs [] \\ rveq \\ fs []
+    \\ Cases_on `op = Opapp`
+    >- (
+      fs [option_case_eq, pair_case_eq]
+      \\ rveq \\ fs []
+      \\ drule_then drule do_opapp_thm_REVERSE
+      \\ rw []
+      \\ imp_res_tac state_rel_IMP_clock
+      \\ imp_res_tac LENGTH_compile_exps_IMP
+      \\ fs [bool_case_eq, quantHeuristicsTheory.LIST_LENGTH_2]
+      \\ fs [Q.ISPEC `(a, b)` EQ_SYM_EQ]
+      \\ imp_res_tac state_rel_dec_clock
+      \\ last_x_assum (first_assum o mp_then (Pat `state_rel _ _ _`) mp_tac)
+      \\ simp [dec_clock_def]
+      \\ disch_then irule
+      \\ drule do_opapp_v_inv
+      \\ rw [EVERY_REVERSE]
+      \\ simp [env_rel_def]
+      \\ metis_tac [LE_LT1, LESS_EQ_REFL]
+    )
+    \\ fs [option_case_eq, pair_case_eq]
+    \\ rveq \\ fs []
+    \\ drule_then (drule_then drule) do_app_thm_REVERSE
+    \\ imp_res_tac state_rel_IMP_check_ctor
+    \\ rw []
+    \\ fs []
+    \\ drule do_app_v_inv
+    \\ simp [EVERY_REVERSE]
+  )
+  >- (
+    (* If *)
+    last_x_assum (drule_then (drule_then drule))
+    \\ rw []
+    \\ fs [case_eq_thms] \\ rveq \\ fs []
+    \\ rveq \\ fs []
+    \\ imp_res_tac flatPropsTheory.evaluate_sing
+    \\ rveq \\ fs []
+    \\ drule_then drule do_if_helper
+    \\ rw []
+    \\ fs [do_if_def, bool_case_eq]
+    \\ rveq \\ fs []
+    \\ last_x_assum (drule_then (drule_then drule))
+    \\ simp []
+  )
+  >- (
+    (* Mat *)
+    simp [evaluate_def, pat_bindings_def, flatSemTheory.pmatch_def]
+    \\ last_x_assum (drule_then (drule_then drule))
+    \\ impl_tac >- (fs [MAX_ADD_LESS])
+    \\ rw []
+    \\ fs [case_eq_thms] \\ rveq \\ fs [] \\ rveq \\ fs []
+    \\ DEP_REWRITE_TAC [Q.GEN `v` evaluate_compile_pats |> Q.SPEC `HD v'`]
+    \\ simp [pure_eval_to_def, evaluate_def, libTheory.opt_bind_def]
+    \\ imp_res_tac flatPropsTheory.evaluate_sing
+    \\ rveq \\ fs []
+    \\ rename [`compile_match _ _ = (k, _)`]
+    \\ drule_then (drule_then drule) compile_match_pmatch_rows
+    \\ `k <= N` by fs [MAX_ADD_LESS]
+    \\ disch_then drule
+    \\ fs [CaseEq "match_result", pair_case_eq, bool_case_eq] \\ rveq \\ fs []
+    >- (
+      (* no match *)
+      simp [PULL_EXISTS, evaluate_def]
+      \\ fs [initial_ctors_def]
+      \\ imp_res_tac state_rel_IMP_check_ctor
+      \\ simp [bind_exn_v_def, v_rel_l_cases]
+    )
+    \\ imp_res_tac state_rel_IMP_check_ctor
+    \\ rw [] \\ simp []
+    \\ fs [Q.ISPEC `(a, b)` EQ_SYM_EQ]
+    \\ drule_then (drule_then drule) compile_match_EL
+    \\ rw []
+    \\ fs []
+    \\ imp_res_tac pmatch_rows_IMP_pmatch
+    (* pull out evaluate *)
+    \\ qmatch_goalsub_abbrev_tac `x = (_, _)`
+    \\ PairCases_on `x`
+    \\ fs [markerTheory.Abbrev_def, Q.ISPEC `(a, b)` EQ_SYM_EQ]
+    \\ drule_then drule evaluate_compile_pat_rhs
+    \\ simp [LESS_MAX_ADD]
+    \\ rpt (disch_then drule)
+    \\ simp [libTheory.opt_bind_def]
+    \\ disch_tac \\ fs []
+    \\ last_x_assum (drule_then (drule_then drule))
+    \\ simp [LESS_MAX_ADD]
+  )
+  >- (
+    (* Let *)
+    last_x_assum (drule_then (drule_then drule))
+    \\ rw []
+    \\ fs [case_eq_thms] \\ rveq \\ fs [] \\ rveq \\ fs []
+    \\ last_x_assum (first_assum o mp_then (Pat `state_rel _ _ _`) mp_tac)
+    \\ simp []
+    \\ disch_then irule
+    \\ simp []
+    \\ imp_res_tac evaluate_sing
+    \\ rveq \\ fs []
+    \\ conj_tac
+    >- (
+      simp [libTheory.opt_bind_def]
+      \\ CASE_TAC \\ simp []
+    )
+    \\ goal_assum (first_assum o mp_then (Pat `compile_exp _ _ = _`) mp_tac)
+    \\ asm_exists_tac
+    \\ simp []
+    \\ fs [env_rel_def, libTheory.opt_bind_def]
+    \\ CASE_TAC \\ simp []
+    \\ simp [ALOOKUP_rel_cons]
+  )
+  >- (
+    fs [bool_case_eq]
+    \\ fs [Q.ISPEC `(a, b)` EQ_SYM_EQ]
+    \\ fs [MAP_MAP_o, o_DEF, UNCURRY, ETA_THM]
+    \\ first_x_assum irule
+    \\ simp [build_rec_env_eq_MAP, EVERY_MAP, o_DEF]
+    \\ goal_assum (first_assum o mp_then (Pat `compile_exp _ _ = _`) mp_tac)
+    \\ asm_exists_tac
+    \\ fs [env_rel_def, FILTER_APPEND]
+    \\ irule ALOOKUP_rel_append_suff
+    \\ simp [UNCURRY, MAP_MAP_o, o_DEF]
+    \\ irule ALOOKUP_rel_eq_fst
+    \\ rw [LIST_REL_EL_EQN, EL_MAP, UNCURRY]
+    \\ simp [Once v_rel_cases]
+    \\ fs [ELIM_UNCURRY, list_max_LESS_EVERY, EVERY_MAP]
+    \\ metis_tac []
+  )
+QED
+
+Theorem OPTION_ALL_FORALL:
+  OPTION_ALL P x = (!y. x = SOME y ==> P y)
+Proof
+  Cases_on `x` \\ simp []
+QED
+
+Theorem v_cons_in_c_SUBSET:
+  !c v. v_cons_in_c c v ==> c ⊆ c' ==> v_cons_in_c c' v
+Proof
+  ho_match_mp_tac v_cons_in_c_def1_ind
+  \\ rw []
+  \\ EVERY_CASE_TAC \\ rw [] \\ fs [EVERY_MEM, FORALL_PROD]
+  \\ metis_tac [SUBSET_DEF]
+QED
+
+Theorem compile_dec_evaluate:
+  evaluate_dec s1 dec = (t1, res) /\
+  compile_dec cfg dec = (cfg', dec') /\
+  state_rel cfg s1 s2 /\
+  res ≠ SOME (Rabort Rtype_error) /\
+  EVERY (EVERY (v_cons_in_c s2.c) ∘ store_v_vs) s2.refs /\
+  EVERY (OPTION_ALL (v_cons_in_c s2.c)) s2.globals /\
+  initial_ctors ⊆ s2.c /\
+  c_type_map_rel s2.c cfg.type_map /\
+  ~ MEM [] (toList cfg.type_map)
+  ==>
+  ?t2 res'.
+  evaluate_dec s2 dec' = (t2, res') /\
+  state_rel cfg t1 t2 /\
+  OPTREL (exc_rel (v_rel cfg')) res res' /\
+  EVERY (EVERY (v_cons_in_c t2.c) ∘ store_v_vs) t2.refs /\
+  EVERY (OPTION_ALL (v_cons_in_c t2.c)) t2.globals /\
+  prev_cfg_rel cfg cfg' /\
+  c_type_map_rel t2.c cfg'.type_map /\
+  ~ MEM [] (toList cfg'.type_map) /\
+  s2.c ⊆ t2.c
+Proof
+  Cases_on `dec` \\ simp [evaluate_dec_def, compile_dec_def]
+  \\ rw [] \\ fs [pair_case_eq, bool_case_eq]
+  \\ imp_res_tac state_rel_IMP_check_ctor
+  \\ rveq \\ fs [OPTREL_def]
+  >- (
+    (* Dlet *)
+    `?N sg exps. compile_exps cfg [e] = (N, sg, exps)` by metis_tac [pair_CASES]
+    \\ drule_then drule compile_exps_evaluate
+    \\ disch_then (qspecl_then [`cfg`, `N + 1`, `<| v := [] |>`, `s2`] mp_tac)
+    \\ simp [env_rel_def, ALOOKUP_rel_empty, prev_cfg_rel_refl]
+    \\ impl_tac >- (CCONTR_TAC \\ fs [])
+    \\ fs [compile_exp_def]
+    \\ rpt (pairarg_tac \\ fs [])
+    \\ rveq \\ fs []
+    \\ rw [prev_cfg_rel_refl]
+    \\ simp [evaluate_dec_def]
+    \\ imp_res_tac evaluate_state_unchanged
+    \\ fs [Unitv_def, case_eq_thms, bool_case_eq]
+    \\ rveq \\ fs [v_rel_l_cases]
+    \\ rveq \\ fs []
+  )
+  >- (
+    (* Dtype with no constructors *)
+    fs [evaluate_dec_def, state_rel_def]
+    \\ rename [`NULL (FLAT (MAP _ (toAList sptree)))`]
+    \\ Cases_on `!x y z. ~ (lookup x sptree = SOME y /\ z < y)`
+    \\ simp []
+    \\ rfs [prev_cfg_rel_refl]
+    \\ fs [NULL_EQ, FLAT_EQ_NIL, EVERY_MAP, EVERY_MEM,
+        FORALL_PROD, MEM_toAList]
+    \\ Cases_on `y` \\ fs []
+    \\ res_tac
+    \\ fs [COUNT_LIST_def]
+  )
+  >- (
+    (* Dtype *)
+    fs [evaluate_dec_def, state_rel_def, OPTREL_def]
+    \\ rw []
+    >- (
+      fs [EVERY_MEM]
+      \\ metis_tac [v_cons_in_c_SUBSET, SUBSET_UNION]
+    )
+    >- (
+      fs [EVERY_MEM, OPTION_ALL_FORALL]
+      \\ metis_tac [v_cons_in_c_SUBSET, SUBSET_UNION]
+    )
+    >- (
+      (* config monotonic (is_fresh_type implies no overwrites) *)
+      simp [prev_cfg_rel_def, config_component_equality, subspt_lookup,
+        lookup_insert, bool_case_eq]
+      \\ rfs []
+      \\ fs [c_type_map_rel_def, is_fresh_type_def, FORALL_PROD, MEM_toList]
+      \\ first_x_assum (qspec_then `n` mp_tac)
+      \\ rw []
+      \\ fs [GSYM NULL_EQ, NOT_NULL_MEM, EXISTS_PROD]
+      \\ rfs []
+    )
+    >- (
+      (* updating the type map *)
+      fs [c_type_map_rel_def, is_fresh_type_def, FORALL_PROD]
+      \\ rfs [] \\ fs []
+      \\ rw [lookup_insert, MEM_FLAT, MEM_MAP, PULL_EXISTS, EXISTS_PROD]
+      \\ simp [MEM_COUNT_LIST, MEM_toAList]
+      \\ metis_tac []
+    )
+    >- (
+      (* silly invariant about empty types in map *)
+      fs [MEM_toList, lookup_insert, bool_case_eq, NULL_EQ]
+    )
+  )
+  >- (
+    fs [evaluate_dec_def, state_rel_def, prev_cfg_rel_refl]
+    \\ rw []
+    >- (
+      fs [EVERY_MEM]
+      \\ metis_tac [v_cons_in_c_SUBSET, SUBSET_UNION]
+    )
+    >- (
+      fs [EVERY_MEM, OPTION_ALL_FORALL]
+      \\ metis_tac [v_cons_in_c_SUBSET, SUBSET_UNION]
+    )
+    >- rfs [c_type_map_rel_def]
+  )
+QED
+
+Theorem v_rel_next_cfg:
+  prev_cfg_rel cfg cfg' ==> !x y. v_rel cfg x y ==> v_rel cfg' x y
+Proof
+  disch_tac \\ ho_match_mp_tac v_rel_ind
+  \\ CONV_TAC (DEPTH_CONV ETA_CONV)
+  \\ simp [v_rel_rules]
+  \\ simp [v_rel_l_cases]
+  \\ metis_tac [prev_cfg_rel_trans]
+QED
+
+Theorem state_rel_next_cfg:
+  state_rel cfg s t /\ prev_cfg_rel cfg cfg' ==>
+  state_rel cfg' s t
+Proof
+  rw [state_rel_def]
+  \\ first_x_assum (fn t => mp_tac t \\ match_mp_tac LIST_REL_mono)
+  \\ metis_tac [v_rel_next_cfg, sv_rel_mono, OPTREL_MONO]
+QED
+
+Definition cfg_inv_def:
+  cfg_inv cfg s <=>
+  EVERY (EVERY (v_cons_in_c s.c) ∘ store_v_vs) s.refs /\
+  EVERY (OPTION_ALL (v_cons_in_c s.c)) s.globals /\
+  initial_ctors ⊆ s.c /\
+  ~ MEM [] (toList cfg.type_map) /\
+  c_type_map_rel s.c cfg.type_map
+End
+
+Theorem compile_decs_evaluate:
+  !decs s1 s2 t1 cfg cfg' decs'.
+  evaluate_decs s1 decs = (t1, res) /\
+  compile_decs cfg decs = (cfg', decs') /\
+  res <> SOME (Rabort Rtype_error) /\
+  state_rel cfg s1 s2 /\ cfg_inv cfg s2
+  ==>
+  ?t2 res'.
+  evaluate_decs s2 decs' = (t2, res') /\
+  OPTREL (exc_rel (K (K T))) res res' /\
+  t1.ffi = t2.ffi /\
+  (res = NONE ==>
+    state_rel cfg' t1 t2 /\ cfg_inv cfg' t2 /\
+    prev_cfg_rel cfg cfg')
+Proof
+  Induct
+  \\ simp [evaluate_decs_def, compile_decs_def, prev_cfg_rel_refl]
+  \\ simp [pair_case_eq, PULL_EXISTS]
+  \\ fs [cfg_inv_def]
+  \\ TRY (fs [state_rel_def] \\ NO_TAC)
+  \\ rpt strip_tac
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs [OPTREL_def]
+  \\ drule_then (drule_then drule) compile_dec_evaluate
+  \\ simp []
+  \\ impl_tac >- (CCONTR_TAC \\ fs [])
+  \\ rw []
+  \\ drule_then drule state_rel_next_cfg
+  \\ rw []
+  \\ reverse (fs [option_case_eq])
+  >- (
+    (* exception raised *)
+    rveq \\ fs [OPTREL_SOME, evaluate_decs_def]
+    \\ fs [state_rel_def]
+    \\ rename [`exc_rel _ exc exc'`]
+    \\ Cases_on `exc` \\ fs []
+  )
+  \\ last_x_assum (drule_then (drule_then drule))
+  \\ simp [evaluate_decs_def]
+  \\ impl_tac >- metis_tac [SUBSET_TRANS]
+  \\ rw [] \\ fs [OPTREL_def]
+  \\ metis_tac [prev_cfg_rel_trans]
+QED
+
+Definition cfg_precondition_def:
+  cfg_precondition cfg <=> cfg.type_map = init_type_map
+End
+
+Theorem cfg_precondition_inv:
+  cfg_precondition cfg ==>
+  cfg_inv cfg (initial_state ffi k T)
+Proof
+  simp [init_type_map_def, initial_state_def, cfg_inv_def, MEM_toList,
+    lookup_fromAList, bool_case_eq, cfg_precondition_def]
+  \\ rw [c_type_map_rel_def, lookup_fromAList, bool_case_eq,
+    initial_ctors_def]
+  \\ simp_tac bool_ss [RIGHT_AND_OVER_OR, EXISTS_OR_THM, MEM]
+  \\ EVAL_TAC
+  \\ EQ_TAC \\ rw [list_id_def, bool_id_def]
+QED
+
+Theorem cfg_precondition_init:
+  cfg_precondition (init_config ph)
+Proof
+  simp [init_config_def, cfg_precondition_def]
+QED
+
+Theorem compile_decs_eval_sim:
+  cfg_precondition cfg ==>
+  eval_sim ffi T prog T prog'
+    (\decs decs'. compile_decs cfg decs = (cfg', decs')) F
+Proof
+  simp [eval_sim_def]
+  \\ rpt strip_tac
+  \\ qexists_tac `0`
+  \\ simp [PAIR_FST_SND_EQ]
+  \\ assume_tac state_rel_initial_state
+  \\ drule_then drule compile_decs_evaluate
+  \\ simp []
+  \\ disch_then drule
+  \\ simp [cfg_precondition_inv]
+  \\ strip_tac
+  \\ simp []
+  \\ rw [] \\ fs [OPTREL_def]
+QED
+
+Theorem compile_decs_semantics:
+  cfg_precondition cfg /\
+  compile_decs cfg prog = (cfg', prog') /\
+  semantics T ffi prog <> Fail
+  ==>
+  semantics T ffi prog = semantics T ffi prog'
+Proof
+  rw []
+  \\ irule (DISCH_ALL (MATCH_MP (hd (RES_CANON IMP_semantics_eq))
+        (UNDISCH_ALL compile_decs_eval_sim)))
+  \\ simp []
+  \\ asm_exists_tac
+  \\ simp []
+QED
+
+(* set_globals and esgc properties *)
+
+Theorem set_globals_decode_pos:
+  !p exp. set_globals exp = {||} ==>
+  set_globals (decode_pos t exp p) = {||}
+Proof
+  Induct \\ simp [decode_pos_def, op_gbag_def]
+QED
+
+Theorem set_globals_decode_test:
+  set_globals exp = {||} ==>
+  set_globals (decode_test t d exp) = {||}
+Proof
+  Cases_on `d`
+  \\ simp [decode_test_def, op_gbag_def]
+QED
+
+Theorem set_globals_decode_guard:
+  set_globals exp = {||} ==>
+  set_globals (decode_guard t exp gd) = {||}
+Proof
+  Induct_on `gd` \\ simp [decode_guard_def, Bool_def, op_gbag_def]
+  \\ simp [set_globals_decode_test, set_globals_decode_pos]
+QED
+
+Theorem set_globals_decode_dtree_empty:
+  set_globals x = {||} /\ set_globals dflt = {||} /\
+  EVERY (\y. set_globals y = {||}) (toList br_spt) ==>
+  set_globals (decode_dtree t br_spt x dflt dtree) = {||}
+Proof
+  Induct_on `dtree`
+  \\ simp [decode_dtree_def]
+  \\ rw []
+  \\ simp [set_globals_decode_guard]
+  \\ CASE_TAC
+  \\ fs [EVERY_MEM, FORALL_PROD, MEM_toList]
+  \\ metis_tac []
+QED
+
+Theorem inv_on_FOLDR:
+  !f. (!x v. MEM x xs ==> f (g x v) = f v) ==>
+  f (FOLDR g v xs) = f v
+Proof
+  gen_tac \\ Induct_on `xs` \\ simp []
+QED
+
+Theorem set_globals_compile_pat_bindings:
+  !t i n_bindings exp.
+  EVERY (\(_, _, v_exp). set_globals v_exp = {||}) n_bindings ==>
+  set_globals (SND (compile_pat_bindings t i n_bindings exp)) =
+  set_globals exp
+Proof
+  ho_match_mp_tac compile_pat_bindings_ind
+  \\ rw [compile_pat_bindings_def]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ simp [op_gbag_def]
+  \\ DEP_REWRITE_TAC [Q.ISPEC `set_globals` inv_on_FOLDR]
+  \\ simp [FORALL_PROD, op_gbag_def]
+  \\ fs [EVERY_MAP, ELIM_UNCURRY]
+QED
+
+Theorem set_globals_naive_pattern_match:
+  !t xs. EVERY (\v. set_globals (SND v) = {||}) xs ==>
+  set_globals (naive_pattern_match t xs) = {||}
+Proof
+  ho_match_mp_tac naive_pattern_match_ind
+  \\ simp [naive_pattern_match_def, op_gbag_def, Bool_def]
+  \\ rw []
+  \\ fs []
+  \\ fs [EVERY_EL, op_gbag_def]
+QED
+
+Theorem set_globals_naive_pattern_matches:
+  set_globals x = {||} ==>
+  set_globals (naive_pattern_matches t x ps dflt) =
+  elist_globals (dflt :: MAP SND ps)
+Proof
+  Induct_on `ps`
+  \\ simp [FORALL_PROD, naive_pattern_matches_def,
+        set_globals_naive_pattern_match]
+  \\ simp_tac (bool_ss ++ bagSimps.BAG_ss) []
+QED
+
+Theorem set_toList_fromList:
+  set (toList (fromList xs)) = set xs
+Proof
+  simp [EXTENSION, MEM_toList, lookup_fromList, MEM_EL]
+  \\ metis_tac []
+QED
+
+Theorem set_globals_compile_pats:
+  (~ naive ==> elist_globals (dflt :: MAP SND ps) = {||}) /\
+  set_globals x = {||} ==>
+  set_globals (compile_pats cfg naive t N x dflt ps) =
+  elist_globals (dflt :: MAP SND ps)
+Proof
+  simp [compile_pats_def]
+  \\ rw []
+  >- (
+    simp [set_globals_naive_pattern_matches, MAP_ZIP]
+    \\ simp [elist_globals_FOLDR]
+    \\ irule FOLDR_CONG
+    \\ simp [MAP_MAP_o]
+    \\ irule MAP_CONG
+    \\ simp [FORALL_PROD, compile_pat_rhs_def, set_globals_compile_pat_bindings]
+  )
+  \\ DEP_REWRITE_TAC [set_globals_decode_dtree_empty]
+  \\ simp [EVERY_MEM, set_toList_fromList]
+  \\ fs [elist_globals_eq_empty, MEM_MAP, PULL_EXISTS]
+  \\ fs [FORALL_PROD, compile_pat_rhs_def, set_globals_compile_pat_bindings]
+  \\ metis_tac []
+QED
+
+Theorem compile_exp_set_globals:
+  (!cfg exp N sg exp'. compile_exp cfg exp = (N, sg, exp')
+  ==>
+  set_globals exp' = set_globals exp)
+  /\
+  (!cfg exps N sg exps'. compile_exps cfg exps = (N, sg, exps')
+  ==>
+  elist_globals exps' = elist_globals exps)
+  /\
+  (!cfg m N sg m'. compile_match cfg m = (N, sg, m')
+  ==>
+  elist_globals (MAP SND m') = elist_globals (MAP SND m))
+Proof
+  ho_match_mp_tac compile_exp_ind
+  \\ fs [compile_exp_def]
+  \\ fs [miscTheory.UNCURRY_eq_pair, PULL_EXISTS]
+  \\ rw []
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs []
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2, elist_globals_REVERSE]
+  \\ rveq \\ fs []
+  \\ TRY (DEP_REWRITE_TAC [set_globals_compile_pats]
+    \\ imp_res_tac compile_exp_set_globals_tup
+    \\ simp [])
+  \\ simp [elist_globals_FOLDR] \\ irule FOLDR_CONG
+  \\ simp [MAP_MAP_o] \\ irule MAP_CONG
+  \\ simp [FORALL_PROD] \\ rw []
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ first_x_assum drule
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2, elist_globals_REVERSE]
+QED
+
+Theorem compile_decs_elist_globals:
+  !decs cfg decs' cfg'. compile_decs cfg decs = (cfg', decs')
+  ==>
+  elist_globals (MAP dest_Dlet (FILTER is_Dlet decs')) =
+  elist_globals (MAP dest_Dlet (FILTER is_Dlet decs))
+Proof
+  Induct
+  \\ rw [compile_decs_def]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs []
+  \\ Cases_on `h` \\ fs [compile_dec_def]
+  \\ last_x_assum drule \\ rw []
+  \\ rveq \\ fs []
+  \\ qmatch_goalsub_abbrev_tac `compile_exp cfg exp`
+  \\ `?N sg e'. compile_exp cfg exp = (N, sg, e')` by metis_tac [pair_CASES]
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ imp_res_tac compile_exp_set_globals
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2]
+QED
+
+Theorem esgc_free_decode_pos:
+  !p exp. esgc_free exp ==>
+  esgc_free (decode_pos t exp p)
+Proof
+  Induct \\ simp [decode_pos_def]
+QED
+
+Theorem esgc_free_decode_test:
+  esgc_free exp ==> esgc_free (decode_test t d exp)
+Proof
+  Cases_on `d`
+  \\ simp [decode_test_def]
+QED
+
+Theorem esgc_free_decode_guard:
+  esgc_free exp ==> esgc_free (decode_guard t exp gd)
+Proof
+  Induct_on `gd` \\ simp [decode_guard_def, Bool_def]
+  \\ simp [esgc_free_decode_test, esgc_free_decode_pos]
+QED
+
+Theorem esgc_free_decode_dtree:
+  esgc_free v_exp /\ esgc_free dflt /\
+  EVERY (\y. esgc_free y) (toList br_spt) ==>
+  esgc_free (decode_dtree t br_spt v_exp dflt dtree)
+Proof
+  Induct_on `dtree`
+  \\ simp [decode_dtree_def]
+  \\ rw []
+  \\ simp [esgc_free_decode_guard]
+  \\ CASE_TAC
+  \\ fs [MEM_toList, EVERY_MEM, FORALL_PROD]
+  \\ metis_tac []
+QED
+
+Theorem esgc_free_compile_pat_bindings:
+  !t i n_bindings exp.
+  esgc_free exp /\
+  EVERY (\(_, _, v_exp). esgc_free v_exp) n_bindings ==>
+  esgc_free (SND (compile_pat_bindings t i n_bindings exp))
+Proof
+  ho_match_mp_tac compile_pat_bindings_ind
+  \\ rw [compile_pat_bindings_def]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ simp [op_gbag_def]
+  \\ DEP_REWRITE_TAC [Q.ISPEC `esgc_free` inv_on_FOLDR]
+  \\ simp [FORALL_PROD, op_gbag_def]
+  \\ fs [EVERY_MAP, ELIM_UNCURRY]
+QED
+
+Theorem esgc_free_naive_pattern_match:
+  !t xs. EVERY esgc_free (MAP SND xs) ==>
+  esgc_free (naive_pattern_match t xs)
+Proof
+  ho_match_mp_tac naive_pattern_match_ind
+  \\ simp [naive_pattern_match_def, Bool_def]
+  \\ rw []
+  \\ fs [EVERY_EL]
+QED
+
+Theorem esgc_free_naive_pattern_matches:
+  !t x xs dflt. EVERY esgc_free (x :: dflt :: MAP SND xs) ==>
+  esgc_free (naive_pattern_matches t x xs dflt)
+Proof
+  ho_match_mp_tac naive_pattern_matches_ind
+  \\ simp [naive_pattern_matches_def, esgc_free_naive_pattern_match]
+QED
+
+Theorem esgc_free_compile_pats:
+  esgc_free dflt /\ EVERY esgc_free (MAP SND ps) ==>
+  esgc_free (compile_pats cfg naive t N (Var_local t' nm) dflt ps)
+Proof
+  rw [compile_pats_def]
+  \\ DEP_REWRITE_TAC [esgc_free_decode_dtree, esgc_free_naive_pattern_matches]
+  \\ simp [MAP_ZIP]
+  \\ fs [EVERY_MEM, set_toList_fromList, MEM_MAP, PULL_EXISTS, FORALL_PROD]
+  \\ rw [compile_pat_rhs_def]
+  \\ irule esgc_free_compile_pat_bindings
+  \\ simp []
+  \\ metis_tac []
+QED
+
+Theorem compile_exp_esgc_free:
+  (!cfg exp N sg exp'. compile_exp cfg exp = (N, sg, exp') /\
+  esgc_free exp
+  ==>
+  esgc_free exp')
+  /\
+  (!cfg exps N sg exps'. compile_exps cfg exps = (N, sg, exps') /\
+  EVERY esgc_free exps
+  ==>
+  EVERY esgc_free exps')
+  /\
+  (!cfg m N sg m'. compile_match cfg m = (N, sg, m') /\
+  EVERY (esgc_free o SND) m
+  ==>
+  EVERY (esgc_free o SND) m')
+Proof
+  ho_match_mp_tac compile_exp_ind
+  \\ fs [compile_exp_def]
+  \\ fs [miscTheory.UNCURRY_eq_pair, PULL_EXISTS]
+  \\ rw []
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs []
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2, EVERY_REVERSE]
+  \\ rveq \\ fs []
+  \\ TRY (irule esgc_free_compile_pats \\ fs [EVERY_MAP, o_DEF])
+  \\ imp_res_tac compile_exp_set_globals
+  \\ fs [elist_globals_eq_empty, MEM_MAP, FORALL_PROD, PULL_EXISTS]
+  \\ rw []
+  \\ res_tac
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs []
+  \\ imp_res_tac compile_exp_set_globals
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2, EVERY_REVERSE]
+QED
+
+Theorem compile_decs_esgc_free:
+  !decs cfg decs' cfg'. compile_decs cfg decs = (cfg', decs') /\
+  EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet decs))
+  ==>
+  EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet decs'))
+Proof
+  Induct
+  \\ rw [compile_decs_def]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs []
+  \\ Cases_on `h` \\ fs [compile_dec_def]
+  \\ last_x_assum drule \\ rw []
+  \\ rveq \\ fs []
+  \\ qmatch_goalsub_abbrev_tac `compile_exp cfg exp`
+  \\ `?N sg e'. compile_exp cfg exp = (N, sg, e')` by metis_tac [pair_CASES]
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ drule (CONJUNCT1 compile_exp_esgc_free)
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2]
+QED
+
+Theorem naive_pattern_match_no_Mat:
+  !t xs. EVERY (no_Mat o SND) xs ==>
+  no_Mat (naive_pattern_match t xs)
+Proof
+  ho_match_mp_tac naive_pattern_match_ind
+  \\ simp [naive_pattern_match_def, Bool_def]
+  \\ rw []
+  \\ fs []
+  \\ fs [EVERY_EL]
+QED
+
+Theorem naive_pattern_matches_no_Mat:
+  !t x xs dflt. EVERY no_Mat (x :: dflt :: MAP SND xs) ==>
+  no_Mat (naive_pattern_matches t x xs dflt)
+Proof
+  ho_match_mp_tac naive_pattern_matches_ind
+  \\ simp [naive_pattern_matches_def, naive_pattern_match_no_Mat]
+QED
+
+Theorem compile_pat_bindings_no_Mat:
+  !t i n_bindings exp.
+  no_Mat exp /\
+  EVERY (\(_, _, v_exp). no_Mat v_exp) n_bindings ==>
+  no_Mat (SND (compile_pat_bindings t i n_bindings exp))
+Proof
+  ho_match_mp_tac compile_pat_bindings_ind
+  \\ rw [compile_pat_bindings_def]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ simp []
+  \\ DEP_REWRITE_TAC [Q.ISPEC `no_Mat` inv_on_FOLDR]
+  \\ simp [FORALL_PROD]
+  \\ fs [EVERY_MAP, ELIM_UNCURRY]
+QED
+
+Theorem decode_pos_no_Mat:
+  !p exp. no_Mat exp ==>
+  no_Mat (decode_pos t exp p)
+Proof
+  Induct \\ simp [decode_pos_def]
+QED
+
+Theorem decode_test_no_Mat:
+  no_Mat exp ==> no_Mat (decode_test t d exp)
+Proof
+  Cases_on `d`
+  \\ simp [decode_test_def]
+QED
+
+Theorem decode_guard_no_Mat:
+  no_Mat exp ==> no_Mat (decode_guard t exp gd)
+Proof
+  Induct_on `gd` \\ simp [decode_guard_def, Bool_def]
+  \\ simp [decode_test_no_Mat, decode_pos_no_Mat]
+QED
+
+Theorem decode_dtree_no_Mat:
+  no_Mat v_exp /\ no_Mat dflt /\
+  EVERY no_Mat (toList br_spt) ==>
+  no_Mat (decode_dtree t br_spt v_exp dflt dtree)
+Proof
+  Induct_on `dtree`
+  \\ simp [decode_dtree_def]
+  \\ rw []
+  \\ simp [decode_guard_no_Mat]
+  \\ CASE_TAC
+  \\ fs [MEM_toList, EVERY_MEM, FORALL_PROD]
+  \\ metis_tac []
+QED
+
+Theorem compile_pats_no_Mat:
+  no_Mat dflt /\ no_Mat x /\ EVERY no_Mat (MAP SND ps) ==>
+  no_Mat (compile_pats cfg naive t N x dflt ps)
+Proof
+  simp [compile_pats_def]
+  \\ rw []
+  \\ DEP_REWRITE_TAC [naive_pattern_matches_no_Mat, decode_dtree_no_Mat]
+  \\ simp [MAP_ZIP]
+  \\ fs [EVERY_MEM, set_toList_fromList, MEM_MAP, PULL_EXISTS, FORALL_PROD]
+  \\ rw [compile_pat_rhs_def]
+  \\ res_tac
+  \\ simp [compile_pat_bindings_no_Mat]
+QED
+
+Theorem compile_exp_no_Mat:
+  (!cfg exp N sg exp'.
+  compile_exp cfg exp = (N, sg, exp') ==>
+  no_Mat exp') /\
+  (!cfg exps N sg exps'.
+  compile_exps cfg exps = (N, sg, exps') ==>
+  EVERY no_Mat exps') /\
+  (!cfg pats N sg pats'.
+  compile_match cfg pats = (N, sg, pats') ==>
+  EVERY no_Mat (MAP SND pats'))
+Proof
+  ho_match_mp_tac compile_exp_ind
+  \\ simp [compile_exp_def]
+  \\ rw []
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs []
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2, listTheory.LENGTH_CONS]
+  \\ rveq \\ fs []
+  \\ fs [EVERY_REVERSE, Q.ISPEC `no_Mat` ETA_THM, compile_pats_no_Mat]
+  \\ simp [EVERY_MEM, MEM_MAP, FORALL_PROD, PULL_EXISTS]
+  \\ rw []
+  \\ res_tac
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2, listTheory.LENGTH_CONS]
+  \\ rveq \\ fs []
+QED
+
+Theorem compile_decs_no_Mat:
+  !decs cfg decs' cfg'. compile_decs cfg decs = (cfg', decs')
+  ==>
+  no_Mat_decs decs'
+Proof
+  Induct
+  \\ simp [compile_decs_def]
+  \\ Cases
+  \\ simp [compile_decs_def, compile_dec_def]
+  \\ rw []
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rveq \\ fs []
+  \\ res_tac
+  \\ fs []
+  \\ qmatch_goalsub_abbrev_tac `compile_exp cfg exp`
+  \\ `?N sg e'. compile_exp cfg exp = (N, sg, e')` by metis_tac [pair_CASES]
+  \\ imp_res_tac LENGTH_compile_exps_IMP
+  \\ drule (CONJUNCT1 compile_exp_no_Mat)
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2, listTheory.LENGTH_CONS]
+QED
+
+val _ = export_theory()
diff --git a/compiler/backend/proofs/flat_reorder_matchProofScript.sml b/compiler/backend/proofs/flat_reorder_matchProofScript.sml
deleted file mode 100644
index fe49f96d87..0000000000
--- a/compiler/backend/proofs/flat_reorder_matchProofScript.sml
+++ /dev/null
@@ -1,952 +0,0 @@
-(*
-  Correctness proof for flat_reorder_match
-*)
-open preamble flat_reorder_matchTheory flatSemTheory flatPropsTheory
-
-val _ = new_theory "flat_reorder_matchProof";
-
-val grammar_ancestry = ["flat_reorder_match", "flatSem", "flatProps",
-                        "misc", "ffi"];
-val _ = set_grammar_ancestry grammar_ancestry;
-
-Theorem list_result_map_result:
-   list_result (map_result f g r) = map_result (MAP f) g (list_result r)
-Proof
-  Cases_on`r` \\ EVAL_TAC
-QED
-
-Theorem MAP_FST_MAP_triple:
-   ! a b c y l. (MAP FST (MAP (\(a,b,c). a, b, (y c)) l)) = (MAP FST l)
-Proof
-  Induct_on `l` \\ fs [] \\ rw []
-  \\ pairarg_tac \\ fs []
-QED
-
-Theorem ALOOKUP_MAP3:
-   ALOOKUP (MAP (λ(a,b,c). (a,b, f c)) ls) =
-   OPTION_MAP (λ(b,c). (b, f c)) o (ALOOKUP ls)
-Proof
-  qmatch_goalsub_abbrev_tac`OPTION_MAP g o _`
-  \\ Q.ISPECL_THEN[`g`,`ls`](mp_tac o GSYM) ALOOKUP_MAP
-  \\ simp[Abbr`g`,LAMBDA_PROD]
-QED
-
-Overload None[local] = ``NONE``
-Overload Some[local] = ``SOME``
-Overload Length[local] = ``LENGTH``
-
-val BAG_OF_LIST_def = Define`
-  (BAG_OF_LIST [] = {||}) ∧
-  (BAG_OF_LIST (x::xs) = BAG_INSERT x (BAG_OF_LIST xs))`;
-val _ = export_rewrites["BAG_OF_LIST_def"];
-
-Theorem BAG_OF_LIST_empty[simp]:
-   (BAG_OF_LIST l = {||} ⇔ (l = []))
-Proof
-  Cases_on`l` \\ rw[]
-QED
-
-Theorem BAG_INSERT_BAG_UNION:
-   BAG_INSERT x (BAG_UNION b1 b2) = BAG_UNION (BAG_INSERT x b1) b2
-Proof
-  rw[BAG_INSERT_UNION,ASSOC_BAG_UNION]
-QED
-
-Theorem BAG_OF_LIST_APPEND:
-   ∀l1 l2. BAG_OF_LIST (l1 ++ l2) = BAG_UNION (BAG_OF_LIST l1) (BAG_OF_LIST l2)
-Proof
-  Induct \\ simp[BAG_INSERT_BAG_UNION]
-QED
-
-(* -- *)
-
-val s = ``s:'ffi flatSem$state``;
-
-(* value transformation *)
-
-Theorem MEM_size_mono:
-   !a b. (MEM a b) ==> ((v_size a) < 1 + v3_size b)
-Proof
-  Induct_on `b` \\ rw [v_size_def] \\ res_tac \\ rw []
-QED
-
-Theorem MEM_size_mono_v1_size:
-   ! a v env. MEM (a,v) env ==> v_size v  < 1 + v1_size env
-Proof
-  Induct_on `env` \\ rw[] \\ rw [v_size_def] \\ res_tac \\ rw []
-QED
-
-val compile_v_def = tDefine "compile_v" `
-  (compile_v (Litv l) = Litv l) /\
-  (compile_v (Conv n vs) = Conv n (MAP compile_v vs)) /\
-  (compile_v (Closure env name e) = Closure (MAP (\(a, v). (a, compile_v v) ) env) name (HD (compile [e]))) /\
-  (compile_v (Recclosure env funs name) = Recclosure (MAP (\(a, v). (a, compile_v v) ) env) (MAP (\(a, b, e). (a, b, HD(compile [e]))) funs) name) /\
-  (compile_v (Loc n) = Loc n) /\
-  (compile_v (Vectorv vs) = Vectorv (MAP compile_v vs)) `
-  (
-    WF_REL_TAC `measure v_size`
-    \\ rw []
-    \\ imp_res_tac MEM_size_mono_v1_size
-    \\ imp_res_tac MEM_size_mono
-    \\ rw []
-  )
-
-val _ = export_rewrites ["compile_v_def"];
-
-Overload compile_env[local] = ``MAP \(tn, v). (tn, compile_v v)``
-
-Theorem ALOOKUP_compile_env:
-   ! env q x.
-      (ALOOKUP (compile_env env) q) = OPTION_MAP compile_v (ALOOKUP env q)
-Proof
-  Induct \\ rw []
-  \\ pairarg_tac
-  \\ fs []
-  \\ rw []
-QED
-
-val compile_store_v_def = Define `
-    (compile_store_v (Refv v) = Refv (compile_v v)) /\
-    (compile_store_v (W8array l) = W8array l) /\
-    (compile_store_v (Varray vs) = Varray (MAP compile_v vs))`
-
-val compile_state_def = Define `
-    compile_state (^s) =
-    <| clock := s.clock;
-       refs := MAP compile_store_v s.refs;
-       ffi := s.ffi;
-       globals := MAP (OPTION_MAP compile_v) s.globals;
-       check_ctor := s.check_ctor;
-       exh_pat := s.exh_pat;
-       c := s.c
-    |>`;
-
-Theorem dec_clock_compile_state:
-   dec_clock (compile_state s) = compile_state (dec_clock s)
-Proof
-  EVAL_TAC
-QED
-
-Theorem compile_state_with_clock:
-   compile_state st with clock := k = compile_state (st with clock := k)
-Proof
-  EVAL_TAC
-QED
-
-val compile_state_simps = save_thm ("compile_state_simps", LIST_CONJ
-    [EVAL ``(compile_state s).globals``,
-     EVAL ``(compile_state s).clock``,
-     EVAL ``(compile_state s).ffi``,
-     EVAL ``(compile_state s).refs``]);
-
-val _ = export_rewrites ["compile_state_simps"];
-
-(* syntactic properties of the compiler *)
-
-Theorem isPcon_isPvar:
-   ∀x. isPcon x ==> ¬isPvar x
-Proof
-  Cases \\ rw[isPcon_def,isPvar_def]
-QED
-
-Theorem is_const_con_thm:
-   is_const_con x ⇔ ∃t. x = Pcon (SOME t) []
-Proof
-  Cases_on`x` \\ EVAL_TAC \\ rw[]
-  \\ rename1`Pcon t l` \\ Cases_on`t` \\ EVAL_TAC \\ rw[]
-QED
-
-Theorem is_Pcon_thm:
-   isPcon x ⇔ ∃t l. x = Pcon (SOME t) l
-Proof
-  Cases_on`x` \\ EVAL_TAC \\ rw[]
-  \\ rename1`Pcon t l` \\ Cases_on`t` \\ EVAL_TAC \\ rw[EXISTS_THM]
-QED
-
-Theorem is_const_con_is_Pcon:
-   is_const_con x ==> isPcon x
-Proof
-  rw[is_const_con_thm,is_Pcon_thm]
-QED
-
-Theorem same_con_is_const_con:
-   same_con x y ⇒ is_const_con x ∧ is_const_con y
-Proof
-  Cases_on`x` \\ Cases_on`y` \\ simp[]
-  \\ rename1`same_con (Pcon o1 _) (Pcon o2 _)`
-  \\ Cases_on`o1` \\ Cases_on`o2` \\ simp[]
-  \\ Cases_on`l` \\ Cases_on`l'` \\ simp[]
-QED
-
-Theorem is_const_con_pat_bindings_empty:
-     is_const_con x ==> pat_bindings x a = a
-Proof
-    rw [is_const_con_thm] \\ EVAL_TAC
-QED
-
-Theorem compile_append:
-   ! x h. compile (x ++ h) = (compile x) ++ (compile h)
-Proof
-  Induct_on `x` \\ fs [] \\ rw [Once compile_cons]
-  \\ qspec_then `h` strip_assume_tac compile_sing \\ fs []
-  \\ rw [Once compile_cons]
-QED
-
-Theorem compile_reverse:
-   ! x. REVERSE (compile x) = compile (REVERSE x)
-Proof
-  Induct \\ fs [] \\ rw [Once compile_cons]
-  \\ qspec_then `h` strip_assume_tac compile_sing \\ fs []
-  \\ rw [EQ_SYM_EQ, REVERSE_DEF, compile_append]
-QED
-
-(* alternative characterisation of pattern matching *)
-
-val find_match_def = Define`
-    find_match s v [] = No_match /\
-    find_match s v (pe::pes) =
-        if ALL_DISTINCT (pat_bindings (FST pe) []) then
-            case pmatch s (FST pe) v [] of
-            | Match env' => Match (env', SND pe)
-            | Match_type_error => Match_type_error
-            | _ => find_match s v pes
-        else Match_type_error `;
-
-Theorem evaluate_match_find_match_none:
-  s.exh_pat ∧ (!r. find_match s v pes ≠ Match r) ==>
-          evaluate_match env s v pes errv = (s, Rerr (Rabort Rtype_error))
-Proof
-  Induct_on `pes`
-  \\ fs [find_match_def, evaluate_def]
-  \\ Cases
-  \\ fs [evaluate_def]
-  \\ IF_CASES_TAC \\ fs[]
-  \\ TOP_CASE_TAC
-  \\ rw []
-QED
-
-Theorem evaluate_match_find_match_some:
-   find_match s v pes = Match (env',e) ==>
-      evaluate_match env s v pes errv = evaluate (env with v := env' ++ env.v) s [e]
-Proof
-  Induct_on `pes`
-  \\ fs [find_match_def,evaluate_def]
-  \\ Cases
-  \\ fs [evaluate_def]
-  \\ TOP_CASE_TAC
-  \\ CASE_TAC
-  \\ rw[]
-QED
-
-(* reordering operations are allowed *)
-
-Theorem pmatch_same_match:
-  pmatch s c1 v [] = Match a /\ is_const_con c1 /\
-   pmatch s c2 v [] = Match b /\ ~isPvar c2
-      ==> same_con c1 c2
-Proof
-  rw[is_const_con_thm]
-  \\ Cases_on`v` \\ fs[pmatch_def]
-  \\ rename1`Conv o1` \\ Cases_on`o1` \\ fs[pmatch_def]
-  \\ Cases_on`c2` \\ fs[pmatch_def]
-  \\ rename1`same_con _ (Pcon o1 _)`
-  \\ Cases_on`o1` \\ fs[pmatch_def]
-  \\ fs[bool_case_eq,same_ctor_def] \\ rw[] \\ rfs[pmatch_def]
-  \\ fs[FST_EQ_EQUIV] \\ rw[]
-  \\ pop_assum mp_tac \\ rw[] \\ fs[]
-  \\ Cases_on`x` \\ fs[]
-QED
-
-Theorem pmatch_match_match:
-   ¬s.check_ctor ∧
-   is_const_con x /\ isPcon y /\ pmatch s x v [] = Match_type_error ==>
-   pmatch s y v [] = Match_type_error
-Proof
-  rw[is_const_con_thm,is_Pcon_thm]
-  \\ Cases_on`v` \\ fs[pmatch_def]
-  \\ rename1`Conv tt _` \\ Cases_on`tt`
-  \\ fs[pmatch_def,semanticPrimitivesTheory.same_ctor_def]
-  \\ pop_assum mp_tac \\ simp[bool_case_eq]
-QED
-
-Theorem pmatch_no_match:
-   ¬s.check_ctor ∧ pmatch s x v [] = No_match ∧ same_con y x ⇒
-   pmatch s y v [] = No_match
-Proof
-  Cases_on`x` \\ Cases_on`y` \\ fs[pmatch_def]
-  \\ rename1`same_con (Pcon o1 _) (Pcon o2 _)`
-  \\ Cases_on`o1` \\ Cases_on`o2` \\ fs[pmatch_def]
-  \\ Cases_on`l` \\ Cases_on`l'` \\ fs[pmatch_def]
-  \\ Cases_on`x` \\ Cases_on`x'` \\ fs[pmatch_def]
-  \\ Cases_on`v` \\ fs[pmatch_def]
-  \\ Cases_on`o'` \\ fs[pmatch_def]
-  \\ Cases_on`x`
-  \\ rw[] \\ fs[same_ctor_def,ctor_same_type_def]
-  \\ rw[] \\ rfs[]
-QED
-
-Theorem find_match_drop_no_match:
-     ! a b. pmatch s (FST b) v [] = No_match /\ (is_const_con (FST b)) ==>
-     ((find_match s v ( a++ [b] ++c)) = find_match s v (a++c))
-Proof
-     Induct
-     \\ rw [find_match_def, is_const_con_pat_bindings_empty]
-QED
-
-Theorem find_match_may_drop_dup:
-     ¬s.check_ctor ⇒
-     ! a b. ((is_const_con (FST b)) /\ (EXISTS (same_con (FST b) o FST) a)) ==>
-     ((find_match s v ( a++ [b] ++c)) = find_match s v (a++c))
-Proof
-     strip_tac \\ Induct
-     \\ rw [find_match_def]
-     \\ CASE_TAC \\ fs[]
-     \\ match_mp_tac find_match_drop_no_match \\ fs[]
-     \\ match_mp_tac (GEN_ALL pmatch_no_match) \\ fs[]
-     \\ asm_exists_tac \\ fs[]
-QED
-
-Theorem find_match_may_reord:
-     ¬s.check_ctor ⇒
-     ! a b. is_const_con (FST b) /\ ¬(EXISTS (same_con (FST b) o FST) a)
-            /\ EVERY isPcon (MAP FST a) /\
-            find_match s v (a ++ [b] ++ c) ≠ Match_type_error
-            ==>
-        find_match s v (a ++ [b] ++ c) = find_match s v (b::a++c)
-Proof
-    strip_tac \\
-    Induct \\ fs []
-    \\ rw [find_match_def]
-    \\ every_case_tac \\ fs [find_match_def]
-    >- ( imp_res_tac pmatch_match_match \\ fs [])
-    >- ( imp_res_tac pmatch_match_match \\ fs [])
-    >- (
-        imp_res_tac isPcon_isPvar
-        \\ imp_res_tac pmatch_same_match)
-    >- (
-      CCONTR_TAC \\ fs[EVERY_MAP] \\
-      first_x_assum(qspec_then`b`mp_tac) \\ rw[]
-      \\ fs[EVERY_MEM])
-    >- (
-      CCONTR_TAC \\ fs[]
-      \\ fs[is_const_con_pat_bindings_empty] )
-QED
-
-Theorem find_match_drop_after_pvar:
-    ! a. isPvar (FST b) ==>
-        find_match s v (a ++ [b] ++ c) = find_match s v (a ++ [b])
-Proof
-    Induct \\ fs [find_match_def]
-    \\ rw []
-    \\ CASE_TAC
-    \\ Cases_on `FST b` \\ fs [pmatch_def, isPvar_def]
-QED
-
-(* characterisation of reordering operations as rules *)
-
-Inductive reord:
-  (isPvar (FST b) ==> reord (a ++ [b] ++ c) (a ++ [b])) /\
-  (is_const_con (FST b) /\
-   EXISTS (same_con (FST b) o FST) a ==>
-   reord (a ++ [b] ++ c) (a ++ c)) /\
-  (is_const_con (FST b) /\
-   ¬EXISTS (same_con (FST b) o FST) a /\
-   EVERY isPcon (MAP FST a) ==>
-   reord (a ++ [b] ++ c) ([b] ++ a ++ c))
-End
-
-Theorem const_cons_sep_reord:
-     ! a const_cons.
-        const_cons_sep pes a const_cons = (const_cons', a') /\
-        EVERY isPcon (MAP FST a) /\
-        EVERY ($~ o is_const_con) (MAP FST a) /\
-        EVERY is_const_con (MAP FST const_cons)
-         ==>
-        reord^* (const_cons ++ (REVERSE a) ++ pes) (const_cons' ++ (REVERSE a'))
-Proof
-    Induct_on `pes` \\ fs [] \\ rw [const_cons_sep_def]
-    >- (
-        rw []
-        \\ match_mp_tac RTC_SUBSET
-        \\ rw [reord_cases]
-    )
-    >- (
-       rw [Once RTC_CASES1]
-       \\ disj2_tac
-       \\ fs []
-       \\ first_x_assum drule \\ strip_tac
-       \\ rfs []
-       \\ HINT_EXISTS_TAC
-       \\ rw [reord_cases]
-       \\ METIS_TAC[EXISTS_APPEND]
-    )
-    >-(
-      fs []
-      \\ first_x_assum drule \\ strip_tac
-      \\ rfs []
-      \\ rw [Once RTC_CASES1]
-      \\ disj2_tac
-      \\ HINT_EXISTS_TAC
-      \\ rw [reord_cases]
-      \\ disj2_tac \\ disj2_tac
-      \\ qexists_tac`const_cons ++ REVERSE a`
-      \\ simp[MAP_REVERSE,EVERY_REVERSE]
-      \\ fs[EVERY_MEM,MEM_MAP,PULL_EXISTS]
-      \\ metis_tac[is_const_con_is_Pcon,same_con_is_const_con] )
-    >- (
-      first_x_assum drule \\ strip_tac
-      \\ rfs[]
-      \\ metis_tac[CONS_APPEND,APPEND_ASSOC] )
-    >- (
-      rw[REVERSE_APPEND] )
-QED
-
-Theorem const_cons_fst_reord:
-     reord^* pes (const_cons_fst pes)
-Proof
-    fs [const_cons_fst_def]
-    \\ pairarg_tac
-    \\ fs []
-    \\ imp_res_tac const_cons_sep_reord \\ fs[]);
-
-Theorem find_match_preserved_reord:
-     ¬s.check_ctor ⇒
-     ! pes pes'. reord pes pes' ==>
-        find_match s v pes <> Match_type_error ==>
-            find_match s v pes = find_match s v pes'
-Proof
-    strip_tac \\
-    ho_match_mp_tac reord_ind
-    \\ strip_tac
-    >-(
-        METIS_TAC [find_match_drop_after_pvar]
-    )
-    \\ strip_tac
-    >- (
-        METIS_TAC [find_match_may_drop_dup]
-    )
-    \\ METIS_TAC [find_match_may_reord, APPEND_ASSOC, CONS_APPEND]
-QED
-
-Theorem find_match_preserved_reord_RTC:
-    ¬s.check_ctor ⇒ ! pes pes'. reord^* pes pes' ==>
-        find_match s v pes <> Match_type_error ==>
-            find_match s v pes = find_match s v pes'
-Proof
-    strip_tac \\ ho_match_mp_tac RTC_INDUCT
-    \\ METIS_TAC [find_match_preserved_reord]
-QED
-
-(* main lemma: find_match semantics preserved by compilation *)
-
-Theorem const_cons_fst_find_match:
-     ¬s.check_ctor ∧ find_match s v pes <> Match_type_error ==>
-        find_match s v pes = find_match s v (const_cons_fst pes)
-Proof
-    METIS_TAC [find_match_preserved_reord_RTC, const_cons_fst_reord]
-QED
-
-(* semantic auxiliaries respect transformation of values *)
-
-Theorem pmatch_compile:
-   (!(s:'ffi state) p err_v acc.
-     pmatch (compile_state s) p (compile_v err_v) (compile_env acc) =
-     map_match compile_env (pmatch s p err_v acc)) /\
-   (!(s:'ffi state) ps vs acc.
-      pmatch_list (compile_state s) ps (MAP compile_v vs) (compile_env acc) =
-      map_match compile_env (pmatch_list s ps vs acc))
-Proof
-  ho_match_mp_tac pmatch_ind \\ rw [pmatch_def, compile_state_def]
-  >- (fs [ETA_AX] >> rfs [])
-  >- (fs [ETA_AX] >> rfs [])
-  >- (
-    fs [semanticPrimitivesTheory.store_lookup_def]
-    \\ rw [EL_MAP]
-    \\ match_mp_tac EQ_SYM
-    \\ CASE_TAC \\ fs[compile_store_v_def]
-  )
-  >- (
-    every_case_tac \\ fs []
-    \\ rw []
-  )
-QED
-
-val pmatch_compile_nil = pmatch_compile |> CONJUNCT1
-    |> SPEC_ALL
-    |> Q.GEN`acc`
-    |> Q.SPEC`[]`
-    |> SIMP_RULE (srw_ss())[]
-
-Theorem find_match_compile:
-   find_match (compile_state s)
-              (compile_v v) (MAP (I ## f) pes) =
-   map_match (compile_env ## f) (find_match s v pes)
-Proof
-   Induct_on `pes`
-   \\ fs [find_match_def]
-   \\ rw []
-   \\ fs [pmatch_compile_nil]
-   \\ every_case_tac \\ fs []
-QED
-
-Theorem find_match_imp_compile:
-   find_match s v pes = Match (env',e) ==>
-   find_match (compile_state s) (compile_v v)
-       (MAP (\(p,e). (p,HD(compile[e]))) pes) =
-           Match (compile_env env', HD(compile[e]))
-Proof
-  strip_tac \\
-  (Q.GENL[`f`,`s`,`v`,`pes`]find_match_compile
-   |> Q.ISPECL_THEN[`\e. HD(compile[e])`,`s`,`v`,`pes`]mp_tac) \\
-  simp[] \\
-  disch_then(SUBST1_TAC o SYM) \\
-  rpt(AP_TERM_TAC ORELSE AP_THM_TAC) \\
-  simp[FUN_EQ_THM,FORALL_PROD]
-QED
-
-Theorem do_opapp_compile[simp]:
-   do_opapp (MAP compile_v as) =
-    OPTION_MAP (λ(env,e). (compile_env env, HD (compile [e]))) (do_opapp as)
-Proof
-  rw[do_opapp_def]
-  \\ every_case_tac
-  \\ fs[semanticPrimitivesPropsTheory.find_recfun_ALOOKUP,build_rec_env_merge]
-  \\ rw[] \\ fsrw_tac[ETA_ss][ALOOKUP_MAP3,MAP_MAP_o,o_DEF,UNCURRY]
-QED
-
-Theorem do_eq_compile[simp]:
-   (∀v1 v2. do_eq (compile_v v1) (compile_v v2) = do_eq v1 v2) ∧
-   (∀v1 v2. do_eq_list (MAP compile_v v1) (MAP compile_v v2) = do_eq_list v1 v2)
-Proof
-  ho_match_mp_tac do_eq_ind
-  \\ srw_tac[ETA_ss][do_eq_def]
-  \\ every_case_tac \\ fs[]
-QED
-
-Theorem store_v_same_type_compile[simp]:
-   (store_v_same_type (compile_store_v v1) v2 ⇔ store_v_same_type v1 v2) ∧
-   (store_v_same_type v1 (compile_store_v v2) ⇔ store_v_same_type v1 v2) ∧
-   (store_v_same_type (Refv (compile_v x1)) v2 ⇔ store_v_same_type (Refv x1) v2) ∧
-   (store_v_same_type v1 (Refv (compile_v x2)) ⇔ store_v_same_type v1 (Refv x2))
-Proof
-  Cases_on`v1` \\ Cases_on`v2` \\ EVAL_TAC
-QED
-
-Theorem v_to_char_list_compile[simp]:
-   ∀ls. v_to_char_list (compile_v ls) = v_to_char_list ls
-Proof
-  ho_match_mp_tac v_to_char_list_ind \\ rw[v_to_char_list_def]
-QED
-
-Theorem v_to_list_compile[simp]:
-   ∀v. v_to_list (compile_v v) = OPTION_MAP (MAP compile_v) (v_to_list v)
-Proof
-  ho_match_mp_tac v_to_list_ind \\ rw[v_to_list_def]
-  \\ every_case_tac \\ fs[]
-QED
-
-Theorem vs_to_strings_compile[simp]:
-   ∀vs. vs_to_string (MAP compile_v vs) = vs_to_string vs
-Proof
-  ho_match_mp_tac vs_to_string_ind \\ rw[vs_to_string_def]
-QED
-
-Theorem list_to_v_compile_APPEND:
-   !xs ys.
-     list_to_v (MAP compile_v xs) = compile_v (list_to_v xs) /\
-     list_to_v (MAP compile_v ys) = compile_v (list_to_v ys) ==>
-       list_to_v (MAP compile_v (xs ++ ys)) =
-       compile_v (list_to_v (xs ++ ys))
-Proof
-  Induct \\ rw [compile_v_def, list_to_v_def] \\ rfs []
-QED
-
-Theorem list_to_v_compile:
-   !xs. list_to_v (MAP compile_v xs) = compile_v (list_to_v xs)
-Proof
-  Induct \\ rw [compile_v_def, list_to_v_def]
-QED
-
-Theorem do_app_compile[simp]:
-   do_app cc (compile_state s) op (MAP compile_v as) =
-   OPTION_MAP (λ(s,r). (compile_state s, map_result compile_v compile_v r))
-              (do_app cc s op as)
-Proof
-  Cases_on `op = ListAppend`
-  >-
-   (Cases_on `do_app cc s op as` \\ fs [] \\ rveq
-    \\ pop_assum mp_tac
-    \\ simp [do_app_def] \\ fs [case_eq_thms] \\ rw []
-    \\ pairarg_tac \\ fs [] \\ rveq
-    \\ metis_tac [list_to_v_compile, list_to_v_compile_APPEND, MAP_APPEND])
-  \\ Cases_on `do_app cc s op as` \\ Cases_on `op`
-  \\ pop_assum mp_tac
-  \\ fs[do_app_def, compile_state_def,
-        semanticPrimitivesTheory.store_assign_def,
-        semanticPrimitivesTheory.store_alloc_def,
-        semanticPrimitivesTheory.store_lookup_def,
-        EL_MAP,compile_store_v_def]
-  \\ rpt (PURE_TOP_CASE_TAC \\ fs [])
-  \\ rfs[EL_MAP,semanticPrimitivesTheory.store_v_same_type_def]
-  \\ every_case_tac \\ fs [compile_store_v_def]
-  \\ rw [EL_MAP, METIS_PROVE [] ``a \/ b <=> ~a ==> b``, ELIM_UNCURRY]
-  \\ fs [] \\ EVAL_TAC
-  \\ fs [LUPDATE_MAP,compile_store_v_def,map_replicate, IS_SOME_EXISTS]
-  \\ rename [`MAP (λc. Litv (Char c)) str`]
-  \\ Induct_on `str` \\ fs [compile_v_def,list_to_v_def]
-QED
-
-(* main results *)
-
-Theorem compile_evaluate:
-   (!env ^s es s1 r1.
-     evaluate env s es = (s1, r1) /\
-     r1 <> Rerr (Rabort Rtype_error) /\
-     s.exh_pat /\
-     ~s.check_ctor
-     ==>
-     evaluate (env with v := compile_env env.v)
-              (compile_state s)
-              (compile es) =
-       (compile_state s1, map_result (MAP compile_v) compile_v r1)) /\
-   (!env ^s v pes err_v s1 r1.
-     evaluate_match env ^s v pes err_v = (s1,r1) /\
-     r1 <> Rerr (Rabort Rtype_error) /\
-     s.exh_pat /\
-     ~s.check_ctor
-     ==>
-     evaluate_match (env with v := compile_env env.v)
-                    (compile_state s)
-                    (compile_v v)
-                    (MAP (\(p,e). (p,HD(compile[e]))) pes)
-                    (compile_v err_v) =
-       (compile_state s1, map_result (MAP compile_v) compile_v r1))
-Proof
-  ho_match_mp_tac evaluate_ind
-  \\ rw [compile_def] \\ fs [evaluate_def] \\ rw []
-  \\ fs [MAP_FST_MAP_triple]
-  >-
-   (fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs []
-    \\ once_rewrite_tac [evaluate_append] \\ fs []
-    \\ imp_res_tac evaluate_sing \\ fs [] >>
-    imp_res_tac evaluate_state_unchanged >>
-    fs [])
-  >-
-   (fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ qspec_then `e` strip_assume_tac compile_sing \\ fs []
-    \\ imp_res_tac evaluate_sing \\ fs [] >>
-    imp_res_tac evaluate_state_unchanged >>
-    fs [])
-  >-
-   (fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ qspec_then `e` strip_assume_tac compile_sing \\ fs []
-    \\ qmatch_asmsub_rename_tac `(compile_state s2, _)` >>
-    drule (CONJUNCT1 evaluate_state_unchanged) >> rw []
-    \\ `?m. find_match s2 v pes = Match m`
-      by (CCONTR_TAC \\ fs []
-          \\ imp_res_tac evaluate_match_find_match_none \\ fs [])
-    \\ PairCases_on `m` >>
-    fs []
-    \\ first_x_assum (CHANGED_TAC o (SUBST1_TAC o SYM))
-    \\ qmatch_assum_rename_tac`_ = Match (env1,e1)`
-    \\ `find_match s2 v (const_cons_fst pes) = Match (env1, e1)`
-      by metis_tac [const_cons_fst_find_match,
-                    semanticPrimitivesTheory.match_result_distinct]
-    \\ imp_res_tac find_match_imp_compile
-    \\ imp_res_tac evaluate_match_find_match_some \\ fs [])
-  >-
-   (fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ rfs [compile_reverse, MAP_REVERSE, ETA_AX, compile_state_def])
-  >- (
-    fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ rfs [compile_reverse, MAP_REVERSE, ETA_AX, compile_state_def] >>
-    fs [])
-  >- (
-    fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ rfs [compile_reverse, MAP_REVERSE, ETA_AX, compile_state_def] >>
-    fs [])
-  >- (every_case_tac \\ fs [ALOOKUP_compile_env, PULL_EXISTS, compile_state_def])
-  >-
-   (fs [case_eq_thms, pair_case_eq, bool_case_eq] \\ rw []
-    \\ fs [compile_reverse, PULL_EXISTS, GSYM MAP_REVERSE]
-    \\ fs [list_result_map_result, dec_clock_compile_state]
-    >- (
-      first_x_assum drule >>
-      disch_then drule >> simp [] >>
-      qpat_x_assum `(_,_) = _` (assume_tac o GSYM) \\ fs [] >>
-      fs [dec_clock_def] >>
-      imp_res_tac evaluate_state_unchanged >> fs [] >> rw [] >>
-      qspec_then `e` strip_assume_tac compile_sing >> fs [])
-    >- (
-      simp [compile_state_def, list_result_map_result]))
-  >-
-   (fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ qspec_then `e1` strip_assume_tac compile_sing \\ fs []
-    \\ imp_res_tac evaluate_sing \\ rw [] \\ fs []
-    \\ fs [do_if_def]
-    \\ rfs [case_eq_thms, bool_case_eq]
-    \\ rw [] \\ fs [compile_v_def, Boolv_def] >>
-    imp_res_tac (CONJUNCT1 evaluate_state_unchanged) >> rw []
-    \\ qspec_then `e` strip_assume_tac compile_sing \\ fs [])
-  >-
-   (fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ qspec_then `e` strip_assume_tac compile_sing \\ fs []
-    \\ imp_res_tac evaluate_sing \\ fs [] \\ rw []
-    \\ qmatch_asmsub_rename_tac `(compile_state s2, _)` >>
-    imp_res_tac (CONJUNCT1 evaluate_state_unchanged) >> rw []
-    \\ `?m. find_match s2 x0 pes = Match m`
-      by (CCONTR_TAC \\ fs []
-          \\ imp_res_tac evaluate_match_find_match_none \\ fs [])
-    \\ PairCases_on `m`
-    \\ qmatch_assum_rename_tac`_ = Match (env1,e1)`
-    \\ `find_match s2 x0 (const_cons_fst pes) = Match (env1, e1)`
-      by metis_tac [const_cons_fst_find_match,
-                    semanticPrimitivesTheory.match_result_distinct]
-    \\ imp_res_tac find_match_imp_compile
-    \\ imp_res_tac evaluate_match_find_match_some \\ fs [])
-  >-
-   (fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
-    \\ qspec_then `e1` strip_assume_tac compile_sing \\ fs []
-    \\ imp_res_tac evaluate_sing \\ fs [] \\ rw []
-    \\ qspec_then `e2` strip_assume_tac compile_sing \\ fs []
-    \\ qpat_x_assum `evaluate _ _ [e2] = _` mp_tac
-    \\ `env with v updated_by opt_bind n x0 =
-        env with v := opt_bind n x0 env.v`
-      by fs [environment_component_equality]
-    \\ pop_assum SUBST1_TAC
-    \\ fs [libTheory.opt_bind_def]
-    \\ PURE_CASE_TAC \\ fs [] >>
-    imp_res_tac (CONJUNCT1 evaluate_state_unchanged) >> rw [] >>
-    metis_tac [])
-  >-
-   (fs [build_rec_env_merge, MAP_MAP_o, o_DEF, UNCURRY]
-    \\ qspec_then `e` strip_assume_tac compile_sing \\ fs [])
-  \\ fs [pmatch_compile_nil]
-  \\ every_case_tac \\ fs [] \\ rfs []
-  \\ qspec_then `e` strip_assume_tac compile_sing \\ fs []
-QED
-
-Theorem compile_dec_evaluate:
-   !d env s t r.
-     evaluate_dec s d = (t, r) /\
-     s.exh_pat /\
-     ~s.check_ctor /\
-     r <> SOME (Rabort Rtype_error)
-     ==>
-     ?r2.
-       evaluate_dec (compile_state s) (HD (compile_decs [d])) =
-         (compile_state t, r2) /\
-       r2 = OPTION_MAP (map_error_result compile_v) r
-Proof
-  Cases \\ rw [evaluate_dec_def]
-  \\ fs [evaluate_dec_def, compile_decs_def]
-  \\ fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs []
-  \\ qspec_then `e` strip_assume_tac compile_sing \\ fs []
-  \\ TRY (fs [compile_state_def] >> NO_TAC)
-  \\ qispl_then [`<| v := [] |>`,`s`] mp_tac (CONJUNCT1 compile_evaluate)
-  \\ disch_then drule
-  \\ rw [evaluate_dec_def] >>
-  every_case_tac >>
-  fs [compile_state_def, Unitv_def] >>
-  rw []
-QED
-
-Theorem compile_decs_CONS:
-  compile_decs (d::ds) = compile_decs [d] ++ compile_decs ds
-Proof
-  rw [compile_decs_def] \\ every_case_tac \\ fs []
-QED
-
-Theorem compile_decs_SING:
-  !y. ?x. compile_decs [y] = [x]
-Proof
-  Cases \\ rw [compile_decs_def] \\ fs []
-QED
-
-Theorem compile_decs_evaluate:
-  !ds s t r.
-     evaluate_decs s ds = (t, r) /\
-     s.exh_pat /\
-     ~s.check_ctor /\
-     r <> SOME (Rabort Rtype_error)
-     ==>
-     ?r2.
-       evaluate_decs (compile_state s) (compile_decs ds) = (compile_state t, r2) /\
-         r2 = OPTION_MAP (map_error_result compile_v) r
-Proof
-  Induct >- (rw [evaluate_decs_def, compile_decs_def] \\ rw []) \\ rw[]
-  \\ fs [evaluate_decs_def, case_eq_thms, pair_case_eq] \\ rw [] \\ fs []
-  \\ once_rewrite_tac [compile_decs_CONS]
-  \\ drule compile_dec_evaluate \\ rw [] \\ fs []
-  \\ qspec_then `h` strip_assume_tac compile_decs_SING \\ fs []
-  >- (
-    last_x_assum drule \\ rw [evaluate_decs_def] \\ fs [] >>
-    imp_res_tac evaluate_dec_state_unchanged >> fs []
-  )
-  \\ simp [evaluate_decs_def]
-  \\ every_case_tac \\ fs []
-  \\ Cases_on `e` \\ Cases_on `a` \\ fs []
-QED
-
-Theorem compile_decs_eval_sim:
-   eval_sim
-     (ffi:'ffi ffi_state) T F ds1 T F
-     (compile_decs ds1)
-     (\p1 p2. p2 = compile_decs p1) F
-Proof
-  rw [eval_sim_def]
-  \\ qexists_tac `0`
-  \\ CONV_TAC (RESORT_EXISTS_CONV rev)
-  \\ Q.LIST_EXISTS_TAC [`compile_state s2`]
-  \\ drule compile_decs_evaluate
-  \\ impl_tac >- fs [initial_state_def] \\ rw []
-  \\ fs[initial_state_def, compile_state_def]
-QED
-
-val compile_decs_semantics = save_thm ("compile_decs_semantics",
-  MATCH_MP (REWRITE_RULE [GSYM AND_IMP_INTRO] IMP_semantics_eq)
-           compile_decs_eval_sim
-  |> DISCH_ALL
-  |> SIMP_RULE (srw_ss()) [AND_IMP_INTRO]);
-
-(* syntactic results *)
-
-Theorem compile_elist_globals_eq_empty:
-   ∀es. elist_globals es = {||} ⇒ elist_globals (compile es) = {||}
-Proof
-  ho_match_mp_tac compile_ind
-  \\ rw[compile_def]
-  \\ TRY (Cases_on `compile [e]` \\ fs [] \\ NO_TAC)
-  \\ fs [elist_globals_eq_empty]
-  \\ fs [MEM_MAP, MAP_MAP_o, o_DEF, PULL_EXISTS, FORALL_PROD]
-  \\ rw []
-  \\ imp_res_tac const_cons_fst_MEM \\ fs []
-  \\ res_tac
-  \\ rename1 `compile [x]`
-  \\ Cases_on `compile [x]` \\ fs []
-QED
-
-Theorem compile_set_globals_eq_empty:
-   set_globals e = {||} ⇒ set_globals (HD (compile [e])) = {||}
-Proof
-  qspec_then`[e]`mp_tac compile_elist_globals_eq_empty
-  \\ rw[] \\ fs[] \\ Cases_on `compile [e]` \\ fs []
-QED
-
-Theorem compile_esgc_free:
-   ∀es. EVERY esgc_free es ⇒ EVERY esgc_free (compile es)
-Proof
-  ho_match_mp_tac compile_ind
-  \\ rw[compile_def] \\ fs[]
-  \\ TRY (Cases_on `compile [e]` \\ fs [] \\ NO_TAC)
-  \\ fs[EVERY_MAP,EVERY_MEM,FORALL_PROD,elist_globals_eq_empty]
-  \\ fs[MEM_MAP,MAP_MAP_o,PULL_EXISTS,FORALL_PROD]
-  \\ rw[]
-  \\ TRY(
-    match_mp_tac compile_set_globals_eq_empty
-    \\ res_tac )
-  \\ METIS_TAC[compile_sing,HD,MEM,const_cons_fst_MEM,compile_set_globals_eq_empty]
-QED
-
-Theorem compile_decs_esgc_free:
-   ∀ds. EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet ds)) ⇒
-        EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet (flat_reorder_match$compile_decs ds)))
-Proof
-  Induct \\ simp[flat_reorder_matchTheory.compile_decs_def]
-  \\ Cases \\ simp[] \\ rw[] \\ fs[]
-  \\ qspec_then`[e]`mp_tac compile_esgc_free
-  \\ strip_assume_tac (SPEC_ALL flat_reorder_matchTheory.compile_sing)
-  \\ rw[]
-QED
-
-Theorem const_cons_sep_sub_bag:
-   ∀pes a const_cons c a'.
-    const_cons_sep pes a const_cons = (c,a') ⇒
-    elist_globals (MAP SND (c ++ REVERSE a')) ≤
-    elist_globals (MAP SND (const_cons ++ REVERSE a ++ pes))
-Proof
-  Induct_on`pes` \\ rw[const_cons_sep_def]
-  \\ fs[elist_globals_append,REVERSE_APPEND]
-  \\ fs[SUB_BAG_UNION]
-  \\ first_x_assum drule \\ rw[elist_globals_append]
-  \\ metis_tac[SUB_BAG_UNION,ASSOC_BAG_UNION,COMM_BAG_UNION]
-QED
-
-Theorem const_cons_fst_sub_bag:
-   elist_globals (MAP SND (const_cons_fst pes)) ≤
-   elist_globals (MAP SND pes)
-Proof
-  rw[const_cons_fst_def]
-  \\ pairarg_tac \\ fs[]
-  \\ imp_res_tac const_cons_sep_sub_bag \\ fs[]
-QED
-
-Theorem const_cons_fst_distinct_globals:
-   BAG_ALL_DISTINCT (elist_globals (MAP SND pes)) ⇒
-   BAG_ALL_DISTINCT (elist_globals (MAP SND (const_cons_fst pes)))
-Proof
-  METIS_TAC[const_cons_fst_sub_bag,BAG_ALL_DISTINCT_SUB_BAG]
-QED
-
-Theorem compile_sub_bag:
-   ∀es. (elist_globals (compile es)) ≤ (elist_globals es)
-Proof
-  ho_match_mp_tac compile_ind
-  \\ rw [compile_def]
-  \\ TRY (qspec_then `e` assume_tac compile_sing \\ fs [] \\ fs [])
-  \\ fs [SUB_BAG_UNION, elist_globals_append] \\ rfs []
-  \\ fs [MAP_MAP_o, UNCURRY, o_DEF] \\ fs [LAMBDA_PROD]
-  \\ TRY
-   (map_every (fn tm => qspec_then tm assume_tac compile_sing) [`e1`,`e2`,`e3`]
-    \\ fs [] \\ fs []
-    \\ fs [SUB_BAG_UNION]
-    \\ NO_TAC)
-  \\ (FIRST
-    (map (fn th => match_mp_tac (MP_CANON th) \\ conj_tac >- simp[])
-         (CONJUNCTS SUB_BAG_UNION)))
-  \\ TRY
-   (ntac 2 (pop_assum kall_tac)
-    \\ pop_assum mp_tac
-    \\ Induct_on `funs` \\ fs [FORALL_PROD] \\ rw []
-    \\ qspec_then `p_2` assume_tac compile_sing \\ fs [] \\ fs []
-    \\ first_x_assum(fn th => mp_tac th \\ impl_tac >- METIS_TAC[])
-    \\ fsrw_tac [DNF_ss] [SUB_BAG_UNION] \\ rw [])
-  \\ match_mp_tac SUB_BAG_TRANS
-  \\ qexists_tac`elist_globals (MAP SND (const_cons_fst pes))`
-  \\ (reverse conj_tac >- METIS_TAC[const_cons_fst_sub_bag])
-  \\ ntac 2 (pop_assum kall_tac)
-  \\ pop_assum mp_tac
-  \\ Q.SPEC_TAC(`const_cons_fst pes`,`ls`)
-  \\ Induct \\ rw[]
-  \\ pairarg_tac \\ fs[]
-  \\ qspec_then `p2` assume_tac compile_sing \\ fs [] \\ fs []
-  \\ first_x_assum (fn th => mp_tac th \\ impl_tac >- METIS_TAC[])
-  \\ fsrw_tac[DNF_ss][UNCURRY,SUB_BAG_UNION]
-QED
-
-Theorem compile_distinct_globals:
-   BAG_ALL_DISTINCT (elist_globals es) ⇒ BAG_ALL_DISTINCT (elist_globals (compile es))
-Proof
-  METIS_TAC[compile_sub_bag,BAG_ALL_DISTINCT_SUB_BAG]
-QED
-
-Theorem compile_decs_sub_bag:
-   (elist_globals (MAP dest_Dlet (FILTER is_Dlet (flat_reorder_match$compile_decs ds)))) ≤ (elist_globals (MAP dest_Dlet (FILTER is_Dlet ds)))
-Proof
-  Induct_on`ds` \\ rw [flat_reorder_matchTheory.compile_decs_def]
-  \\ fs [UNCURRY] \\ rw []
-  \\ Cases_on `h` \\ fs []
-  \\ qspec_then `e` assume_tac flat_reorder_matchTheory.compile_sing \\ fs []
-  \\ `elist_globals [e2] <= elist_globals [e]`
-    by metis_tac [compile_sub_bag]
-  \\ fs [SUB_BAG_UNION]
-QED
-
-Theorem compile_decs_distinct_globals:
-   BAG_ALL_DISTINCT (elist_globals (MAP dest_Dlet (FILTER is_Dlet ds))) ⇒
-   BAG_ALL_DISTINCT (elist_globals (MAP dest_Dlet (FILTER is_Dlet (flat_reorder_match$compile_decs ds))))
-Proof
-  metis_tac [compile_decs_sub_bag, BAG_ALL_DISTINCT_SUB_BAG]
-QED
-
-val () = export_theory();
diff --git a/compiler/backend/proofs/flat_to_closProofScript.sml b/compiler/backend/proofs/flat_to_closProofScript.sml
new file mode 100644
index 0000000000..568add5169
--- /dev/null
+++ b/compiler/backend/proofs/flat_to_closProofScript.sml
@@ -0,0 +1,1585 @@
+(*
+  Correctness proof for flat_to_clos
+*)
+open preamble
+     semanticPrimitivesTheory semanticPrimitivesPropsTheory
+     flatLangTheory flatSemTheory flatPropsTheory backendPropsTheory
+     closLangTheory closSemTheory closPropsTheory flat_to_closTheory;
+local open helperLib in end;
+
+val _ = new_theory"flat_to_closProof"
+
+val _ = set_grammar_ancestry ["misc","ffi","flatProps","closProps",
+                              "flat_to_clos","backendProps","backend_common"];
+
+Theorem LIST_REL_EL: (* TODO: move *)
+  !xs ys r.
+    LIST_REL r xs ys <=>
+    (LENGTH xs = LENGTH ys) /\
+    !n. n < LENGTH ys ==> r (EL n xs) (EL n ys)
+Proof
+  Induct \\ Cases_on `ys` \\ fs [] \\ rw [] \\ eq_tac \\ rw []
+  THEN1 (Cases_on `n` \\ fs [])
+  THEN1 (first_x_assum (qspec_then `0` mp_tac) \\ fs [])
+  \\ first_x_assum (qspec_then `SUC n` mp_tac) \\ fs []
+QED
+
+Inductive v_rel:
+  (!n. v_rel (Loc n) (RefPtr n)) /\
+  (!i. v_rel (Litv (IntLit i)) (Number i)) /\
+  (!c. v_rel (Litv (Char c)) (Number (& (ORD c)))) /\
+  (!s. v_rel (Litv (StrLit s)) (ByteVector (MAP (n2w o ORD) s))) /\
+  (!b. v_rel (Litv (Word8 b)) (Number (& (w2n b)))) /\
+  (!w. v_rel (Litv (Word64 w)) (Word64 w)) /\
+  (!vs ws. LIST_REL v_rel vs ws ==> v_rel (Conv NONE vs) (Block 0 ws)) /\
+  (!vs ws t r. LIST_REL v_rel vs ws ==> v_rel (Conv (SOME (t,r)) vs) (Block t ws)) /\
+  (!vs ws. LIST_REL v_rel vs ws ==> v_rel (Vectorv vs) (Block 0 ws)) /\
+  (!env m db.
+    (!n x. ALOOKUP env.v n = SOME x ==>
+           findi (SOME n) m < LENGTH db /\
+           v_rel x (EL (findi (SOME n) m) db)) ==>
+     env_rel env (m:string option list) (db:closSem$v list)) /\
+  (!env m db n e.
+     env_rel env m db /\ no_Mat e ==>
+     v_rel (Closure env.v n e)
+           (Closure NONE [] db 1 (HD (compile (SOME n::m) [e])))) /\
+  (!funs n env m db.
+    n < LENGTH funs /\ env_rel env m db /\ ALL_DISTINCT (MAP FST funs) /\
+    EVERY no_Mat (MAP (SND o SND) funs) ==>
+     v_rel (Recclosure env.v funs (FST (EL n funs)))
+      (Recclosure NONE [] db (MAP
+            (λ(f,v,x). (1, HD (compile
+                       (SOME v::(MAP (λn. SOME (FST n)) funs ++ m))
+                       [x]))) funs) n))
+End
+
+Theorem v_rel_def =
+  [``v_rel (Loc n) x1``,
+   ``v_rel (Litv (IntLit l1)) x1``,
+   ``v_rel (Litv (StrLit s)) x1``,
+   ``v_rel (Litv (Char c)) x1``,
+   ``v_rel (Litv (Word8 b)) x1``,
+   ``v_rel (Litv (Word64 w)) x1``,
+   ``v_rel (Vectorv y) x1``,
+   ``v_rel (Conv x y) x1``,
+   ``v_rel (Closure x y z) x1``,
+   ``v_rel (Recclosure x y t) x1``]
+  |> map (SIMP_CONV (srw_ss()) [Once v_rel_cases])
+  |> LIST_CONJ
+
+Theorem env_rel_def = ``env_rel env m db`` |> ONCE_REWRITE_CONV [v_rel_cases];
+
+Definition opt_rel_def[simp]:
+  opt_rel f NONE NONE = T /\
+  opt_rel f (SOME x) (SOME y) = f x y /\
+  opt_rel f _ _ = F
+End
+
+Definition store_rel_def:
+  store_rel refs t_refs =
+    !i. if LENGTH refs <= i then FLOOKUP t_refs i = NONE else
+          case EL i refs of
+          | Refv v => (?x. FLOOKUP t_refs i = SOME (ValueArray [x]) /\ v_rel v x)
+          | Varray vs => (?xs. FLOOKUP t_refs i = SOME (ValueArray xs) /\
+                               LIST_REL v_rel vs xs)
+          | W8array bs => FLOOKUP t_refs i = SOME (ByteArray F bs)
+End
+
+Definition state_rel_def:
+  state_rel (s:'ffi flatSem$state) (t:('c,'ffi) closSem$state) <=>
+    s.check_ctor /\
+    1 <= t.max_app /\
+    s.ffi = t.ffi /\
+    s.clock = t.clock /\
+    store_rel s.refs t.refs /\
+    LIST_REL (opt_rel v_rel) s.globals t.globals
+End
+
+Theorem v_rel_to_list:
+  !x y xs. v_rel x y /\ flatSem$v_to_list x = SOME xs ==>
+           ?ys. closSem$v_to_list y = SOME ys /\ LIST_REL v_rel xs ys
+Proof
+  ho_match_mp_tac flatSemTheory.v_to_list_ind \\ fs [v_rel_def]
+  \\ rpt strip_tac \\ fs [flatSemTheory.v_to_list_def,v_to_list_def]
+  \\ rveq \\ fs [] \\ fs [option_case_eq] \\ rveq \\ fs [PULL_EXISTS]
+QED
+
+Theorem IMP_v_rel_to_list:
+  !xs ys.
+    LIST_REL v_rel xs ys ==>
+    v_rel (list_to_v xs) (list_to_v ys)
+Proof
+  Induct \\ Cases_on `ys`
+  \\ fs [flatSemTheory.list_to_v_def,list_to_v_def,v_rel_def]
+QED
+
+Theorem lookup_byte_array:
+  state_rel s1 t1 /\ store_lookup i s1.refs = SOME (W8array bytes) ==>
+  FLOOKUP t1.refs i = SOME (ByteArray F bytes)
+Proof
+  fs [state_rel_def,store_rel_def] \\ rw []
+  \\ fs [store_lookup_def]
+  \\ first_x_assum (qspec_then `i` mp_tac) \\ fs []
+QED
+
+Theorem lookup_array:
+  state_rel s1 t1 /\ store_lookup i s1.refs = SOME (Varray vs) ==>
+  ?ws. FLOOKUP t1.refs i = SOME (ValueArray ws) /\ LIST_REL v_rel vs ws
+Proof
+  fs [state_rel_def,store_rel_def] \\ rw []
+  \\ fs [store_lookup_def]
+  \\ first_x_assum (qspec_then `i` mp_tac) \\ fs []
+QED
+
+Triviality env_rel_CONS:
+  env_rel <| v := xs |> m db /\ v_rel v1 v2 ==>
+  env_rel <| v := (n,v1) :: xs |> (SOME n :: m) (v2 :: db)
+Proof
+  fs [env_rel_def,findi_def,GSYM ADD1]
+  \\ rw [] \\ fs [] \\ rw [] \\ fs []
+QED
+
+Triviality env_rel_APPEND:
+  !name_prefix prefix db_prefix env m db.
+    env_rel env m db /\
+    LIST_REL v_rel (MAP SND prefix) db_prefix /\
+    name_prefix = MAP (SOME o FST) prefix ==>
+    env_rel <| v := prefix ++ env.v |> (name_prefix ++ m) (db_prefix ++ db)
+Proof
+  Induct \\ fs []
+  THEN1 (rw[env_rel_def])
+  \\ Cases_on `prefix` \\ fs [PULL_EXISTS] \\ rw []
+  \\ PairCases_on `h` \\ fs []
+  \\ match_mp_tac env_rel_CONS
+  \\ fs []
+QED
+
+Theorem state_rel_initial_state:
+  0 < max_app ==>
+  state_rel (initial_state ffi k T)
+            (initial_state ffi max_app FEMPTY co cc k)
+Proof
+  fs [state_rel_def,flatSemTheory.initial_state_def,initial_state_def,store_rel_def]
+QED
+
+Triviality state_rel_IMP_check_ctor:
+  state_rel s t ==> s.check_ctor
+Proof
+  fs [state_rel_def]
+QED
+
+val goal =
+  ``\env (s:'ffi flatSem$state) es.
+      !m db res1 s1 (t:('c,'ffi) closSem$state).
+        evaluate env s es = (s1,res1) /\ state_rel s t /\ env_rel env m db /\
+        EVERY no_Mat es /\ res1 <> Rerr (Rabort Rtype_error) ==>
+        ?res2 t1.
+          evaluate (compile m es, db, t) = (res2,t1) /\ state_rel s1 t1 /\
+          result_rel (LIST_REL v_rel) v_rel res1 res2``
+
+local
+  val ind_thm = flatSemTheory.evaluate_ind
+    |> ISPEC goal
+    |> CONV_RULE (DEPTH_CONV BETA_CONV) |> REWRITE_RULE [];
+  val ind_goals = ind_thm |> concl |> dest_imp |> fst |> helperLib.list_dest dest_conj
+in
+  fun get_goal s = first (can (find_term (can (match_term (Term [QUOTE s]))))) ind_goals
+  fun compile_correct_tm () = ind_thm |> concl |> rand
+  fun the_ind_thm () = ind_thm
+end
+
+Theorem compile_nil:
+  ^(get_goal "[]")
+Proof
+  fs [evaluate_def,flatSemTheory.evaluate_def,compile_def]
+QED
+
+Theorem compile_cons:
+  ^(get_goal "_::_::_")
+Proof
+  rpt strip_tac
+  \\ fs [evaluate_def,compile_def,flatSemTheory.evaluate_def]
+  \\ fs [pair_case_eq] \\ fs []
+  \\ first_x_assum drule
+  \\ disch_then drule
+  \\ impl_tac THEN1 (CCONTR_TAC \\ fs [])
+  \\ strip_tac \\ fs [evaluate_APPEND]
+  \\ fs [result_case_eq] \\ rveq \\ fs []
+  \\ fs [pair_case_eq] \\ fs []
+  \\ rveq \\ fs []
+  \\ first_x_assum drule
+  \\ disch_then drule
+  \\ impl_tac THEN1 (CCONTR_TAC \\ fs [])
+  \\ strip_tac \\ fs []
+  \\ qpat_x_assum `_ = (s1,res1)` mp_tac
+  \\ TOP_CASE_TAC \\ fs []
+  \\ strip_tac \\ rveq \\ fs []
+  \\ imp_res_tac evaluate_sing \\ fs [] \\ rveq \\ fs []
+QED
+
+Theorem compile_Lit:
+  ^(get_goal "flatLang$Lit")
+Proof
+  fs [flatSemTheory.evaluate_def,compile_def]
+  \\ Cases_on `l` \\ fs [PULL_EXISTS]
+  \\ once_rewrite_tac [CONJUNCT2 v_rel_cases] \\ fs []
+  \\ fs [compile_lit_def,evaluate_def,do_app_def]
+QED
+
+Theorem compile_Raise:
+  ^(get_goal "flatLang$Raise")
+Proof
+  fs [evaluate_def,flatSemTheory.evaluate_def,compile_def] \\ rw []
+  \\ reverse (fs [pair_case_eq,result_case_eq]) \\ rveq \\ fs []
+  \\ first_x_assum drule
+  \\ disch_then drule \\ strip_tac \\ rveq \\ fs []
+  \\ imp_res_tac flatPropsTheory.evaluate_sing \\ fs []
+QED
+
+Theorem dest_pat_from_case:
+  (case pes of [(Pvar _, _)] => T | _ => F) ==>
+  ?nm rhs. dest_pat pes = SOME (nm, rhs)
+Proof
+  EVERY_CASE_TAC \\ simp [dest_pat_def]
+QED
+
+Theorem compile_Handle:
+  ^(get_goal "flatLang$Handle")
+Proof
+  rpt strip_tac
+  \\ fs [evaluate_def,compile_def,flatSemTheory.evaluate_def]
+  \\ fs [pair_case_eq] \\ fs []
+  \\ imp_res_tac dest_pat_from_case
+  \\ fs []
+  \\ fs [dest_pat_thm] \\ rveq \\ fs []
+  \\ fs [flatSemTheory.evaluate_def,evaluate_def,
+         EVAL ``ALL_DISTINCT (pat_bindings (Pvar x) [])``,
+         EVAL ``pmatch s' (Pvar x) v []``,pmatch_rows_def]
+  \\ first_x_assum drule
+  \\ disch_then drule
+  \\ impl_tac THEN1 (CCONTR_TAC \\ fs [])
+  \\ strip_tac \\ fs []
+  \\ fs [result_case_eq] \\ rveq \\ fs []
+  \\ rveq \\ fs []
+  \\ fs [error_result_case_eq] \\ rveq \\ fs [] \\ rveq \\ fs []
+  \\ first_x_assum drule
+  \\ rename [`v_rel v1 v2`]
+  \\ `env_rel <|v := (nm,v1)::env.v|> (SOME nm::m) (v2::db)` by
+    (match_mp_tac env_rel_CONS \\ fs [env_rel_def])
+  \\ disch_then drule
+  \\ strip_tac \\ fs []
+QED
+
+Theorem compile_Let:
+  ^(get_goal "flatLang$Let")
+Proof
+  rpt strip_tac
+  \\ fs [evaluate_def,compile_def,flatSemTheory.evaluate_def]
+  \\ fs [pair_case_eq] \\ fs []
+  \\ first_x_assum drule
+  \\ disch_then drule
+  \\ impl_tac THEN1 (CCONTR_TAC \\ fs [])
+  \\ strip_tac \\ fs []
+  \\ fs [result_case_eq] \\ rveq \\ fs []
+  \\ rveq \\ fs []
+  \\ first_x_assum drule
+  \\ imp_res_tac evaluate_sing \\ fs [] \\ rveq \\ fs []
+  \\ rename [`v_rel v1 v2`]
+  \\ `env_rel (env with v updated_by opt_bind n v1) (n::m) (v2::db)` by
+   (fs [env_rel_def]
+    \\ Cases_on `n` \\ fs [libTheory.opt_bind_def,findi_def,GSYM ADD1]
+    \\ rw [] \\ fs [])
+  \\ disch_then drule
+  \\ strip_tac \\ fs []
+QED
+
+Triviality LIST_REL_MAP_GENLIST:
+  !funs f1 f2 R.
+    (!n. n < LENGTH funs ==> R (f1 (EL n funs)) (f2 n)) ==>
+    LIST_REL R (MAP f1 funs) (GENLIST f2 (LENGTH funs))
+Proof
+  recInduct SNOC_INDUCT \\ fs []
+  \\ fs [GENLIST,MAP_SNOC,LIST_REL_SNOC] \\ rpt strip_tac
+  THEN1
+   (first_x_assum match_mp_tac
+    \\ metis_tac [EL_SNOC,DECIDE ``n<m ==> n < SUC m``])
+  \\ first_x_assum (qspec_then `LENGTH l` mp_tac)
+  \\ fs [SNOC_APPEND,EL_LENGTH_APPEND]
+QED
+
+Theorem compile_Letrec:
+  ^(get_goal "flatLang$Letrec")
+Proof
+  rpt strip_tac
+  \\ fs [evaluate_def,compile_def,flatSemTheory.evaluate_def]
+  \\ fs [EVERY_MAP]
+  \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ fs []
+  \\ rpt strip_tac \\ `1 <= t.max_app` by fs [state_rel_def] \\ fs []
+  \\ fs [bool_case_eq]
+  \\ qpat_x_assum `(_,_) = _` (assume_tac o GSYM) \\ fs []
+  \\ qmatch_goalsub_abbrev_tac `GENLIST recc`
+  \\ first_x_assum drule
+  \\ disch_then match_mp_tac
+  \\ fs [build_rec_env_eq_MAP]
+  \\ match_mp_tac env_rel_APPEND \\ fs []
+  \\ reverse conj_tac
+  THEN1
+   (qspec_tac (`Recclosure env.v funs`,`rr`)
+    \\ qid_spec_tac `funs`
+    \\ Induct \\ fs [FORALL_PROD])
+  \\ fs [MAP_MAP_o,o_DEF]
+  \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ fs []
+  \\ match_mp_tac LIST_REL_MAP_GENLIST \\ fs [Abbr`recc`]
+  \\ once_rewrite_tac [v_rel_cases] \\ fs []
+  \\ rw [] \\ qexists_tac `env` \\ qexists_tac `m` \\ fs [o_DEF]
+  \\ simp [EVERY_MAP]
+QED
+
+Theorem compile_Fun:
+  ^(get_goal "flatLang$Fun")
+Proof
+  fs [evaluate_def,flatSemTheory.evaluate_def,PULL_EXISTS,compile_def]
+  \\ rpt strip_tac \\ `1 <= t.max_app` by fs [state_rel_def] \\ fs []
+  \\ once_rewrite_tac [v_rel_cases] \\ fs []
+  \\ metis_tac []
+QED
+
+Theorem compile_Con:
+  ^(get_goal "flatLang$Con") /\
+  ^(get_goal "s.check_ctor ∧ _")
+Proof
+  rpt strip_tac
+  \\ fs [evaluate_def,compile_def,flatSemTheory.evaluate_def]
+  \\ imp_res_tac state_rel_IMP_check_ctor \\ fs []
+  \\ fs [pair_case_eq,CaseEq"bool"] \\ fs []
+  \\ first_x_assum drule
+  \\ fs [EVERY_REVERSE, Q.ISPEC `no_Mat` ETA_THM]
+  \\ (disch_then drule \\ impl_tac THEN1 (CCONTR_TAC \\ fs []))
+  \\ strip_tac \\ fs []
+  \\ fs [result_case_eq] \\ rveq \\ fs []
+  \\ rveq \\ fs [] \\ fs [do_app_def]
+  \\ once_rewrite_tac [v_rel_cases] \\ fs []
+  \\ PairCases_on `cn` \\ fs []
+QED
+
+Theorem compile_Var_local:
+  ^(get_goal "flatLang$Var_local")
+Proof
+  fs [evaluate_def,flatSemTheory.evaluate_def,compile_def] \\ rpt strip_tac
+  \\ pop_assum mp_tac \\ TOP_CASE_TAC \\ fs [env_rel_def]
+QED
+
+Triviality find_recfun_EL:
+  !l0 n.
+    n < LENGTH l0 /\ ALL_DISTINCT (MAP FST l0) ==>
+    find_recfun (FST (EL n l0)) l0 = SOME (SND (EL n l0))
+Proof
+  Induct \\ fs [] \\ simp [Once find_recfun_def,FORALL_PROD]
+  \\ rpt strip_tac \\ Cases_on `n` \\ fs []
+  \\ rw [] \\ fs [MEM_MAP] \\ fs [FORALL_PROD] \\ fs [MEM_EL]
+  \\ metis_tac [PAIR,PAIR_EQ,FST]
+QED
+
+Triviality IMP_PAIR:
+  z = (x,y) ==> x = FST z /\ y = SND z
+Proof
+  Cases_on `z` \\ fs []
+QED
+
+Theorem compile_If:
+  ^(get_goal "flatLang$If")
+Proof
+  rpt strip_tac
+  \\ fs [evaluate_def,compile_def,flatSemTheory.evaluate_def]
+  \\ fs [pair_case_eq] \\ fs []
+  \\ first_x_assum drule
+  \\ disch_then drule
+  \\ impl_tac THEN1 (CCONTR_TAC \\ fs [])
+  \\ strip_tac \\ fs []
+  \\ fs [result_case_eq] \\ rveq \\ fs []
+  \\ imp_res_tac evaluate_sing \\ fs [] \\ rveq \\ fs []
+  \\ fs [option_case_eq] \\ fs []
+  \\ fs [do_if_def,bool_case_eq] \\ rveq \\ fs []
+  \\ first_x_assum drule
+  \\ disch_then drule
+  \\ strip_tac \\ fs []
+  \\ fs [flatSemTheory.Boolv_def]
+  \\ qpat_x_assum `v_rel _ _` mp_tac
+  \\ once_rewrite_tac [v_rel_cases] \\ fs [Boolv_def]
+QED
+
+Theorem compile_Mat:
+  ^(get_goal "flatLang$Mat")
+Proof
+  fs [no_Mat_def,dest_pat_thm] \\ rw []
+  \\ fs [EVAL ``pmatch s (Pvar p') v []``]
+  \\ fs [EVAL ``ALL_DISTINCT (pat_bindings (Pvar p') [])``]
+QED
+
+Theorem state_rel_LEAST:
+  state_rel s1 t1 ==>
+  (LEAST ptr. ptr ∉ FDOM t1.refs) = LENGTH s1.refs
+Proof
+  fs [state_rel_def,store_rel_def] \\ rw []
+  \\ ho_match_mp_tac
+    (whileTheory.LEAST_ELIM
+     |> ISPEC ``\x. x = LENGTH s1.refs``
+     |> CONV_RULE (DEPTH_CONV BETA_CONV))
+  \\ fs [] \\ rpt strip_tac \\ fs [FLOOKUP_DEF]
+  THEN1
+   (first_x_assum (qspec_then `LENGTH s1.refs` mp_tac)
+    \\ fs [] \\ rw [] \\ asm_exists_tac \\ fs [])
+  \\ `!i. i IN FDOM t1.refs <=> ~(LENGTH s1.refs <= i)` by
+   (strip_tac \\ last_x_assum (qspec_then `i` mp_tac) \\ rw []
+    \\ every_case_tac \\ fs[])
+  \\ fs [] \\ CCONTR_TAC \\ fs []
+  \\ `LENGTH s1.refs < ptr` by fs []
+  \\ res_tac \\ fs []
+QED
+
+Theorem compile_op_evaluates_args:
+  evaluate (xs,db,t) = (Rerr err,t1) /\ op <> Opapp ==>
+  evaluate ([compile_op tra op xs],db,t) = (Rerr err,t1)
+Proof
+  Cases_on `op`
+  \\ fs [compile_op_def,evaluate_def,evaluate_APPEND,arg1_def,arg2_def]
+  \\ every_case_tac \\ fs [evaluate_def]
+  \\ fs [pair_case_eq,result_case_eq]
+  \\ rw [] \\ fs [PULL_EXISTS,do_app_def]
+QED
+
+Theorem v_rel_Boolv[simp]:
+  v_rel (Boolv b) v = (v = Boolv b)
+Proof
+  Cases_on `b` \\ fs [Once v_rel_cases,flatSemTheory.Boolv_def]
+  \\ rw [] \\ eq_tac \\ rw [] \\ EVAL_TAC
+QED
+
+val op_goal =
+  ``do_app T s1 op vs = SOME (s2,res2) /\
+    state_rel s1 (t1:('c,'ffi) closSem$state) /\
+    evaluate (xs,db,t) = (Rval ws,t1) /\
+    LIST_REL v_rel vs (REVERSE ws) /\
+    LENGTH xs = LENGTH vs /\ op <> Opapp ==>
+    ∃res2' t1.
+      evaluate ([compile_op tt op xs],db,t) = (res2',t1) ∧
+      state_rel s2 t1 ∧
+      result_rel (LIST_REL v_rel) v_rel (list_result res2) res2'``
+
+Theorem op_refs:
+  (op = Opref) \/
+  (?n. op = El n) \/
+  (op = Opassign) ==>
+  ^op_goal
+Proof
+  Cases_on `op = Opref` THEN1
+   (fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+           CaseEq "ast$lit",store_assign_def,option_case_eq]
+    \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+    \\ fs [store_alloc_def] \\ rveq \\ fs [PULL_EXISTS]
+    \\ simp [Once v_rel_cases]
+    \\ fs [compile_op_def,evaluate_def,do_app_def,arg1_def]
+    \\ imp_res_tac state_rel_LEAST \\ fs []
+    \\ fs [state_rel_def,store_rel_def]
+    \\ strip_tac
+    \\ first_assum (qspec_then `i` mp_tac)
+    \\ rewrite_tac [GSYM NOT_LESS,FLOOKUP_UPDATE,EL_LUPDATE]
+    \\ Cases_on `LENGTH s1.refs = i` \\ rveq \\ fs [EL_LENGTH_APPEND]
+    \\ IF_CASES_TAC \\ fs [EL_APPEND1])
+  \\ Cases_on `?n. op = El n` THEN1
+   (fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+           CaseEq "ast$lit",store_assign_def,option_case_eq]
+    \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+    THEN1
+     (qpat_x_assum `v_rel (Conv _ _) _` mp_tac
+      \\ simp [Once v_rel_cases] \\ rw [] \\ fs [compile_op_def,arg1_def]
+      \\ fs [compile_op_def,evaluate_def,do_app_def,arg1_def]
+      \\ imp_res_tac LIST_REL_LENGTH \\ fs []
+      \\ fs [LIST_REL_EL])
+    \\ qpat_x_assum `v_rel (Loc _) _` mp_tac
+    \\ simp [Once v_rel_cases]
+    \\ Cases_on `v2` \\ fs []
+    \\ fs [SWAP_REVERSE_SYM] \\ rw [] \\ fs [PULL_EXISTS]
+    \\ fs [compile_op_def,evaluate_def,do_app_def,arg1_def]
+    \\ fs [pair_case_eq,result_case_eq] \\ rveq \\ fs []
+    \\ fs [state_rel_def,store_rel_def,store_lookup_def]
+    \\ rename [`i < LENGTH s1.refs`]
+    \\ first_assum (qspec_then `i` mp_tac)
+    \\ rewrite_tac [GSYM NOT_LESS]
+    \\ Cases_on `EL i s1.refs` \\ fs [store_v_same_type_def]
+    \\ rpt strip_tac \\ fs []
+    \\ strip_tac
+    \\ fs [GSYM NOT_LESS,FLOOKUP_UPDATE,EL_LUPDATE])
+  \\ Cases_on `op = Opassign` THEN1
+   (fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+           CaseEq "ast$lit",store_assign_def,option_case_eq]
+    \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+    \\ qpat_x_assum `v_rel (Loc _) _` mp_tac
+    \\ simp [Once v_rel_cases]
+    \\ fs [SWAP_REVERSE_SYM] \\ rw [] \\ fs [PULL_EXISTS]
+    \\ fs [compile_op_def,evaluate_def,do_app_def]
+    \\ fs [pair_case_eq,result_case_eq] \\ rveq \\ fs []
+    \\ imp_res_tac evaluate_SING \\ rveq \\ fs [] \\ rveq \\ fs []
+    \\ fs [arg2_def,evaluate_def,do_app_def]
+    \\ fs [state_rel_def,store_rel_def]
+    \\ rename [`i < LENGTH s1.refs`]
+    \\ first_assum (qspec_then `i` mp_tac)
+    \\ rewrite_tac [GSYM NOT_LESS]
+    \\ Cases_on `EL i s1.refs` \\ fs [store_v_same_type_def]
+    \\ rpt strip_tac \\ fs []
+    \\ reverse conj_tac
+    THEN1 (simp [Unit_def,Once v_rel_cases] \\ EVAL_TAC)
+    \\ strip_tac
+    \\ fs [GSYM NOT_LESS,FLOOKUP_UPDATE,EL_LUPDATE]
+    \\ rename [`if i = j then _ else _`]
+    \\ Cases_on `i = j` \\ fs [] \\ fs [LUPDATE_def])
+  \\ fs []
+QED
+
+Theorem op_chars:
+  (?chop. op = Chopb chop) \/
+  (op = Ord) \/
+  (op = Chr) ==>
+  ^op_goal
+Proof
+  Cases_on `?chop. op = Chopb chop` THEN1
+   (fs [] \\ Cases_on `chop`
+    \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+           CaseEq "ast$lit"]
+    \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+    \\ qpat_x_assum `v_rel _ _` mp_tac
+    \\ simp [Once v_rel_cases]
+    \\ qpat_x_assum `v_rel _ _` mp_tac
+    \\ simp [Once v_rel_cases]
+    \\ fs [SWAP_REVERSE_SYM] \\ rw []
+    \\ fs [compile_op_def,evaluate_def,do_app_def,opb_lookup_def])
+  \\ Cases_on `op = Ord \/ op = Chr` THEN1
+   (fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+        CaseEq "ast$lit"]
+    \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute]
+    \\ qpat_x_assum `v_rel _ _` mp_tac
+    \\ simp [Once v_rel_cases] \\ rw []
+    \\ fs [compile_op_def,evaluate_def,evaluate_APPEND,do_app_def,evaluate_def,arg1_def]
+    \\ simp [Once v_rel_cases] \\ rw [ORD_CHR,chr_exn_v_def]
+    \\ TRY (rename1 `~(ii < 0i)` \\ Cases_on `ii` \\ fs [])
+    \\ TRY (rename1 `(0i <= ii)` \\ Cases_on `ii` \\ fs [])
+    \\ `F` by intLib.COOPER_TAC)
+  \\ rw [] \\ fs []
+QED
+
+Theorem op_ints:
+  (?b. op = Opb b) \/
+  (?b. op = Opn b) ==>
+  ^op_goal
+Proof
+  rpt strip_tac \\ Cases_on `b` \\ rveq
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq,CaseEq "store_v"]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ rpt (qpat_x_assum `v_rel _ _` mp_tac)
+  \\ once_rewrite_tac [v_rel_cases] \\ fs []
+  \\ rpt strip_tac \\ rveq \\ fs [do_word_op_def]
+  \\ rveq \\ fs [compile_op_def,arg1_def]
+  \\ fs [] \\ rveq \\ fs [PULL_EXISTS,SWAP_REVERSE_SYM,v_rel_def] \\ rveq \\ fs []
+  \\ simp [evaluate_def,do_app_def,opb_lookup_def,opn_lookup_def,do_eq_def]
+  \\ IF_CASES_TAC \\ fs [] \\ rveq \\ fs [div_exn_v_def,v_rel_def,opn_lookup_def]
+QED
+
+Theorem op_words:
+  (?w w1. op = Opw w w1) \/
+  (?w. op = WordFromInt w) \/
+  (?w. op = WordToInt w) ==>
+  ^op_goal
+Proof
+  rw [] \\ Cases_on `w` \\ rveq \\ fs [] \\ TRY (Cases_on `w1`)
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq,CaseEq "store_v"]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ rpt (qpat_x_assum `v_rel _ _` mp_tac)
+  \\ once_rewrite_tac [v_rel_cases] \\ fs []
+  \\ rpt strip_tac \\ rveq \\ fs [do_word_op_def]
+  \\ rveq \\ fs [compile_op_def,arg1_def]
+  \\ fs [] \\ rveq \\ fs [PULL_EXISTS,SWAP_REVERSE_SYM,v_rel_def] \\ rveq \\ fs []
+  \\ simp [evaluate_def,do_app_def]
+  \\ fs [some_def,EXISTS_PROD]
+  \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV)
+  \\ `!x. b = FST x ∧ b' = SND x <=> x = (b,b')` by (fs [FORALL_PROD] \\ metis_tac [])
+  \\ simp [integer_wordTheory.w2n_i2w]
+QED
+
+Theorem op_shifts:
+  (?w s n. op = Shift w s n) ==>
+  ^op_goal
+Proof
+  rw [] \\ Cases_on `w` \\ Cases_on `s` \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq,CaseEq "store_v"]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [] \\ rveq \\ fs [PULL_EXISTS,SWAP_REVERSE_SYM,v_rel_def] \\ rveq \\ fs []
+  \\ rename [`v_rel (Litv ww) y`] \\ Cases_on `ww`
+  \\ fs [v_rel_def,do_shift_def] \\ rveq \\ fs []
+  \\ fs [compile_op_def,evaluate_def,do_app_def,v_rel_def]
+QED
+
+Theorem op_floats:
+  (?f. op = FP_cmp f) \/
+  (?f. op = FP_uop f) \/
+  (?f. op = FP_bop f) \/
+  (?f. op = FP_top f) ==>
+  ^op_goal
+Proof
+  rw [] \\ Cases_on `f` \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq,CaseEq "store_v"]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [] \\ rveq \\ fs [PULL_EXISTS,SWAP_REVERSE_SYM,v_rel_def] \\ rveq \\ fs []
+  \\ simp [compile_op_def,evaluate_def,do_app_def]
+QED
+
+Theorem op_byte_arrays:
+  op = Aw8length \/
+  op = Aw8alloc \/
+  op = Aw8sub_unsafe \/
+  op = Aw8sub \/
+  op = Aw8update_unsafe \/
+  op = Aw8update ==>
+  ^op_goal
+Proof
+  rpt strip_tac \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq,CaseEq "store_v"]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [] \\ rveq \\ fs [PULL_EXISTS,SWAP_REVERSE_SYM,v_rel_def] \\ rveq \\ fs []
+  \\ imp_res_tac lookup_byte_array
+  \\ fs [compile_op_def,subscript_exn_v_def,v_rel_def]
+  THEN1 fs [evaluate_def,do_app_def]
+  THEN1
+   (fs [evaluate_def,do_app_def,integerTheory.int_le]
+    \\ rw [] \\ fs [] \\ rveq \\ fs [v_rel_def]
+    \\ fs [store_alloc_def] \\ rveq \\ fs []
+    \\ imp_res_tac state_rel_LEAST \\ fs []
+    \\ fs [state_rel_def,store_rel_def,FLOOKUP_UPDATE,v_rel_def]
+    \\ strip_tac
+    \\ last_x_assum (qspec_then `i` mp_tac)
+    \\ rename [`¬(k < 0)`]
+    \\ `ABS k = k` by intLib.COOPER_TAC \\ simp []
+    \\ Cases_on `i = LENGTH s1.refs` \\ fs [EL_APPEND2]
+    \\ IF_CASES_TAC \\ fs [EL_APPEND1])
+  THEN1
+   (fs [evaluate_def,do_app_def,integerTheory.int_le]
+    \\ rename [`¬(k < 0)`]
+    \\ `Num (ABS k) < LENGTH ws' <=> k < &LENGTH ws'` by intLib.COOPER_TAC
+    \\ fs [GREATER_EQ,GSYM NOT_LESS]
+    \\ `ABS k = k` by intLib.COOPER_TAC \\ simp [])
+  THEN1
+   (fs [evaluate_def,do_app_def,integerTheory.int_le]
+    \\ Cases_on `i < 0` \\ fs [] \\ rveq \\ fs [v_rel_def]
+    \\ rename [`¬(k < 0)`]
+    \\ `Num (ABS k) < LENGTH ws' <=> k < &LENGTH ws'` by intLib.COOPER_TAC
+    \\ fs [GREATER_EQ,GSYM NOT_LESS]
+    \\ IF_CASES_TAC \\ fs [] \\ rveq \\ fs [v_rel_def]
+    \\ `ABS k = k` by intLib.COOPER_TAC \\ simp [])
+  THEN1
+   (fs [evaluate_def,do_app_def,integerTheory.int_le]
+    \\ rename [`¬(k < 0)`]
+    \\ `Num (ABS k) < LENGTH ws' <=> k < &LENGTH ws'` by intLib.COOPER_TAC
+    \\ fs [GREATER_EQ,GSYM NOT_LESS]
+    \\ fs [option_case_eq] \\ rveq \\ fs [v_rel_def,Unit_def,EVAL ``tuple_tag``]
+    \\ rename [`store_v_same_type (EL j s1.refs)`]
+    \\ Cases_on `EL j s1.refs` \\ fs [store_v_same_type_def]
+    \\ fs [state_rel_def,store_rel_def]
+    \\ strip_tac
+    \\ last_x_assum (qspec_then `i` mp_tac)
+    \\ fs [FLOOKUP_UPDATE] \\ IF_CASES_TAC \\ fs [EL_LUPDATE]
+    \\ Cases_on `i = j` \\ fs []
+    \\ rveq \\ fs [] \\ rpt strip_tac \\ rveq \\ fs []
+    \\ `ABS k = k` by intLib.COOPER_TAC \\ simp [])
+  THEN1
+   (fs [evaluate_def,do_app_def,integerTheory.int_le]
+    \\ rename [`¬(k < 0)`]
+    \\ Cases_on `k < 0` \\ fs [] \\ rveq \\ fs [v_rel_def]
+    \\ `Num (ABS k) < LENGTH ws' <=> k < &LENGTH ws'` by intLib.COOPER_TAC
+    \\ fs [GREATER_EQ,GSYM NOT_LESS]
+    \\ IF_CASES_TAC \\ fs [] \\ rveq \\ fs [v_rel_def]
+    \\ fs [option_case_eq] \\ rveq \\ fs [v_rel_def,Unit_def,EVAL ``tuple_tag``]
+    \\ rename [`store_v_same_type (EL j s1.refs)`]
+    \\ Cases_on `EL j s1.refs` \\ fs [store_v_same_type_def]
+    \\ fs [state_rel_def,store_rel_def]
+    \\ strip_tac
+    \\ last_x_assum (qspec_then `i` mp_tac)
+    \\ fs [FLOOKUP_UPDATE] \\ IF_CASES_TAC \\ fs [EL_LUPDATE]
+    \\ Cases_on `i = j` \\ fs []
+    \\ rveq \\ fs [] \\ rpt strip_tac \\ rveq \\ fs []
+    \\ `ABS k = k` by intLib.COOPER_TAC \\ simp [])
+QED
+
+Theorem op_byte_copy:
+  op = CopyStrAw8 \/
+  op = CopyAw8Str \/
+  op = CopyAw8Aw8 \/
+  op = CopyStrStr ==>
+  ^op_goal
+Proof
+  rpt strip_tac \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq,CaseEq "store_v"]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [] \\ rveq \\ fs [PULL_EXISTS,SWAP_REVERSE_SYM,v_rel_def] \\ rveq \\ fs []
+  \\ imp_res_tac lookup_byte_array
+  \\ fs [compile_op_def,subscript_exn_v_def,v_rel_def,CopyByteAw8_def,CopyByteStr_def]
+  \\ simp [evaluate_def,do_app_def]
+  THEN1
+   (fs [copy_array_def]
+    \\ qpat_x_assum `IS_SOME _ ==> _` mp_tac
+    \\ rpt (IF_CASES_TAC \\ fs [ws_to_chars_def])
+    \\ intLib.COOPER_TAC)
+  THEN1
+   (fs [copy_array_def] \\ fs [ws_to_chars_def]
+    \\ reverse IF_CASES_TAC THEN1 (fs [] \\ intLib.COOPER_TAC)
+    \\ reverse IF_CASES_TAC THEN1 (fs [] \\ intLib.COOPER_TAC)
+    \\ fs [Unit_def,EVAL ``tuple_tag``] \\ rveq \\ fs []
+    \\ fs [state_rel_def,store_rel_def]
+    \\ strip_tac \\ last_x_assum (qspec_then `i` mp_tac)
+    \\ fs [FLOOKUP_UPDATE,EL_LUPDATE]
+    \\ IF_CASES_TAC \\ fs []
+    \\ Cases_on `i=dst` \\ fs []
+    \\ fs [chars_to_ws_def,MAP_TAKE,MAP_DROP,MAP_MAP_o,o_DEF,ORD_CHR,
+           integer_wordTheory.i2w_pos])
+  THEN1
+   (fs [copy_array_def]
+    \\ rpt (IF_CASES_TAC \\ fs [ws_to_chars_def])
+    \\ intLib.COOPER_TAC)
+  THEN1
+   (fs [copy_array_def] \\ fs [ws_to_chars_def]
+    \\ reverse IF_CASES_TAC THEN1 (fs [] \\ intLib.COOPER_TAC)
+    \\ fs [MAP_MAP_o,o_DEF])
+  THEN1
+   (fs [copy_array_def] \\ fs [ws_to_chars_def]
+    \\ qpat_x_assum `IS_SOME _ ==> _` mp_tac
+    \\ IF_CASES_TAC \\ fs [] \\ rpt strip_tac \\ fs []
+    \\ rpt (IF_CASES_TAC \\ fs [] \\ rpt strip_tac \\ fs [])
+    \\ intLib.COOPER_TAC)
+  THEN1
+   (fs [copy_array_def] \\ fs [ws_to_chars_def]
+    \\ reverse IF_CASES_TAC THEN1 (fs [] \\ intLib.COOPER_TAC)
+    \\ reverse IF_CASES_TAC THEN1 (fs [] \\ intLib.COOPER_TAC)
+    \\ fs [Unit_def,EVAL ``tuple_tag``] \\ rveq \\ fs []
+    \\ fs [state_rel_def,store_rel_def]
+    \\ strip_tac \\ last_x_assum (qspec_then `i` mp_tac)
+    \\ fs [FLOOKUP_UPDATE,EL_LUPDATE]
+    \\ IF_CASES_TAC \\ fs []
+    \\ Cases_on `i=dst'` \\ fs [])
+  THEN1
+   (fs [copy_array_def] \\ fs [ws_to_chars_def]
+    \\ rpt (IF_CASES_TAC \\ fs [] \\ rpt strip_tac \\ fs [])
+    \\ intLib.COOPER_TAC)
+  THEN1
+   (fs [copy_array_def] \\ fs [ws_to_chars_def]
+    \\ reverse IF_CASES_TAC THEN1 (fs [] \\ intLib.COOPER_TAC)
+    \\ fs [] \\ rveq \\ fs [MAP_TAKE,MAP_DROP])
+QED
+
+Theorem op_eq_gc:
+  op = ConfigGC \/
+  op = Equality ==>
+  ^op_goal
+Proof
+  rpt strip_tac \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [] \\ rveq \\ fs [PULL_EXISTS,SWAP_REVERSE_SYM] \\ rveq \\ fs []
+  THEN1
+   (ntac 2 (pop_assum mp_tac) \\ once_rewrite_tac [v_rel_cases] \\ fs []
+    \\ rw [] \\ fs [compile_op_def,evaluate_def,do_app_def,Unit_def] \\ EVAL_TAC)
+  \\ fs [CaseEq"eq_result"] \\ rveq \\ fs []
+  \\ fs [compile_op_def,evaluate_def,do_app_def]
+  \\ qsuff_tac `
+       (!v1 v2 x1 x2 b.
+         v_rel v1 x1 /\ v_rel v2 x2 /\ do_eq v1 v2 = Eq_val b ==>
+         do_eq x1 x2 = Eq_val b) /\
+       (!v1 v2 x1 x2 b.
+         LIST_REL v_rel v1 x1 /\ LIST_REL v_rel v2 x2 /\ do_eq_list v1 v2 = Eq_val b ==>
+         do_eq_list x1 x2 = Eq_val b)`
+  THEN1 (rw [] \\ res_tac \\ fs [])
+  \\ rpt (pop_assum kall_tac)
+  \\ ho_match_mp_tac flatSemTheory.do_eq_ind \\ rw []
+  \\ fs [v_rel_def,flatSemTheory.do_eq_def,bool_case_eq] \\ rveq \\ fs []
+  \\ imp_res_tac LIST_REL_LENGTH
+  THEN1
+   (rename [`lit_same_type l1 l2`]
+    \\ Cases_on `l1` \\ Cases_on `l2` \\ fs [lit_same_type_def,v_rel_def]
+    \\ fs [do_eq_def] \\ rveq \\ fs [ORD_11]
+    \\ rename [`MAP _ l1 = MAP _ l2`]
+    \\ qid_spec_tac `l2` \\ qid_spec_tac `l1`
+    \\ Induct \\ Cases_on `l2` \\ fs [ORD_BOUND,ORD_11])
+  \\ TRY (fs [do_eq_def] \\ rveq \\ fs [v_rel_def] \\ NO_TAC)
+  \\ rveq \\ fs [ctor_same_type_def]
+  \\ fs [CaseEq"eq_result",bool_case_eq] \\ rveq \\ fs []
+  \\ fs [do_eq_def]
+  \\ qpat_x_assum `Eq_val b = _` (assume_tac o GSYM)
+  \\ res_tac \\ fs []
+QED
+
+Theorem v_rel_v_to_char_list:
+  !x ls y.
+    v_to_char_list x = SOME ls /\ v_rel x y ==>
+    v_to_list y = SOME (MAP (Number ∘ $&) (MAP ORD ls))
+Proof
+  ho_match_mp_tac v_to_char_list_ind \\ rw []
+  \\ fs [v_rel_def,v_to_list_def,v_to_char_list_def]
+  \\ rveq \\ fs [option_case_eq] \\ rveq \\ fs []
+QED
+
+Theorem op_str:
+  op = Explode \/
+  op = Implode \/
+  op = Strlen \/
+  op = Strsub \/
+  op = Strcat ==>
+  ^op_goal
+Proof
+  rpt strip_tac \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [] \\ rveq \\ fs [PULL_EXISTS]
+  \\ fs [compile_op_def,evaluate_def,do_app_def,get_global_def,v_rel_def]
+  \\ rveq \\ fs [SWAP_REVERSE_SYM]
+  \\ rveq \\ fs [SWAP_REVERSE_SYM]
+  THEN1
+   (match_mp_tac IMP_v_rel_to_list \\ rename [`MAP _ xs`]
+    \\ qid_spec_tac `xs` \\ Induct \\ fs [v_rel_def,ORD_BOUND])
+  THEN1
+   (imp_res_tac v_rel_v_to_char_list \\ fs []
+    \\ `!xs. MAP (Number ∘ $&) (MAP ORD ls) =
+             MAP (Number ∘ $&) xs <=> xs = (MAP ORD ls)` by
+       (qid_spec_tac `ls` \\ Induct \\ Cases_on `xs`
+        \\ fs [] \\ rw [] \\ eq_tac \\ rw[])
+    \\ fs []
+    \\ `(!xs. xs = MAP ORD ls /\ EVERY (λn. n < 256n) xs <=>
+              xs = MAP ORD ls /\ EVERY (λn. n < 256n) (MAP ORD ls))` by
+          metis_tac [] \\ fs []
+    \\ `!ls. EVERY (λn. n < 256) (MAP ORD ls)` by (Induct \\ fs [ORD_BOUND]) \\ fs []
+    \\ fs [MAP_MAP_o,stringTheory.IMPLODE_EXPLODE_I])
+  THEN1
+   (fs [integerTheory.int_le] \\ rename [`~(i4 < 0)`]
+    \\ Cases_on `i4 < 0` \\ fs [] \\ rveq \\ fs [subscript_exn_v_def,v_rel_def]
+    \\ rename [`i4 < &LENGTH str`] \\ fs [GREATER_EQ,GSYM NOT_LESS]
+    \\ `Num (ABS i4) < STRLEN str <=> i4 < &STRLEN str` by intLib.COOPER_TAC \\ fs []
+    \\ IF_CASES_TAC \\ fs [] \\ rveq \\ fs [v_rel_def]
+    \\ Cases_on `i4` \\ fs []
+    \\ fs [EL_MAP,ORD_BOUND] \\ Cases_on `str` \\ fs [EL_MAP,ORD_BOUND])
+  \\ qsuff_tac `!x vs str y.
+        v_to_list x = SOME vs /\ vs_to_string vs = SOME str /\ v_rel x y ==>
+        ?wss. v_to_list y = SOME (MAP ByteVector wss) /\
+              MAP (CHR o w2n) (FLAT wss) = str`
+  THEN1
+   (rpt (disch_then drule \\ fs []) \\ strip_tac \\ fs []
+    \\ `!xs ys. MAP ByteVector xs = MAP ByteVector ys <=> xs = ys` by
+           (Induct \\ Cases_on `ys` \\ fs []) \\ fs [] \\ rveq
+    \\ fs [MAP_MAP_o,o_DEF])
+  \\ rpt (pop_assum kall_tac)
+  \\ recInduct flatSemTheory.v_to_list_ind \\ rw [] \\ fs [v_rel_def]
+  \\ rveq \\ fs [flatSemTheory.v_to_list_def] \\ rveq \\ fs [vs_to_string_def]
+  \\ rveq \\ fs [] THEN1 (qexists_tac `[]` \\ EVAL_TAC)
+  \\ fs [option_case_eq] \\ rveq
+  \\ Cases_on `v1` \\ fs [flatSemTheory.v_to_list_def,vs_to_string_def]
+  \\ Cases_on `l` \\ fs [flatSemTheory.v_to_list_def,vs_to_string_def,option_case_eq]
+  \\ rveq \\ fs [v_rel_def,v_to_list_def,option_case_eq,PULL_EXISTS]
+  \\ res_tac \\ fs [] \\ rveq \\ fs []
+  \\ qexists_tac `(MAP (n2w ∘ ORD) s) :: wss`
+  \\ fs [MAP_MAP_o,o_DEF,ORD_BOUND,CHR_ORD]
+QED
+
+Theorem op_globals:
+  (?n. op = GlobalVarLookup n) \/
+  (?n. op = GlobalVarInit n) \/
+  (?n. op = GlobalVarAlloc n) ==>
+  ^op_goal
+Proof
+  rpt strip_tac \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [] \\ rveq \\ fs [PULL_EXISTS]
+  \\ fs [compile_op_def,evaluate_def,do_app_def,get_global_def]
+  THEN1
+   (Cases_on `EL n s1.globals` \\ fs [state_rel_def]
+    \\ imp_res_tac LIST_REL_LENGTH \\ fs []
+    \\ fs [LIST_REL_EL] \\ res_tac \\ fs []
+    \\ qpat_x_assum `_ = SOME x` assume_tac
+    \\ Cases_on `EL n t.globals` \\ fs [])
+  THEN1
+   (fs [state_rel_def]
+    \\ imp_res_tac LIST_REL_LENGTH \\ fs []
+    \\ fs [LIST_REL_EL] \\ res_tac \\ fs []
+    \\ qpat_x_assum `_ = NONE` assume_tac
+    \\ Cases_on `EL n t1.globals` \\ fs []
+    \\ fs [EL_LUPDATE]
+    \\ simp [Once v_rel_cases,Unit_def]
+    \\ rw [] \\ EVAL_TAC)
+  \\ simp [Once v_rel_cases,Unit_def]
+  \\ fs [compile_op_def,evaluate_def,do_app_def,arg1_def]
+  \\ qsuff_tac `!n db (t:('c,'ffi) closSem$state).
+       evaluate ([AllocGlobals tt n],db,t) =
+         (Rval [Block 0 []],t with globals := t.globals ++ REPLICATE n NONE)`
+  THEN1
+   (fs [state_rel_def] \\ rw []
+    \\ match_mp_tac EVERY2_APPEND_suff \\ fs []
+    \\ qid_spec_tac `n` \\ Induct \\ fs [])
+  \\ Induct \\ simp [Once AllocGlobals_def,evaluate_def,do_app_def]
+  THEN1 (fs [state_component_equality])
+  \\ rw []
+  THEN1 (simp [Once AllocGlobals_def,evaluate_def,do_app_def,Unit_def] \\ EVAL_TAC)
+  \\ simp [evaluate_def,do_app_def,Unit_def]
+  \\ fs [state_component_equality]
+QED
+
+Theorem op_vectors:
+  op = Vlength \/
+  op = Vsub \/
+  op = VfromList ==>
+  ^op_goal
+Proof
+  rpt strip_tac \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [v_rel_def] \\ rveq \\ fs [PULL_EXISTS]
+  \\ fs [compile_op_def,evaluate_def,do_app_def]
+  \\ imp_res_tac LIST_REL_LENGTH \\ fs [SWAP_REVERSE_SYM]
+  THEN1
+   (rveq \\ fs [] \\ rename [`0 <= i5`]
+    \\ Cases_on `i5` \\ fs [bool_case_eq] \\ rveq \\ fs []
+    \\ fs [subscript_exn_v_def,v_rel_def,GREATER_EQ]
+    \\ fs [LIST_REL_EL]
+    \\ first_x_assum (qspec_then `0` mp_tac) \\ fs []
+    \\ rename [`wss <> []`] \\ Cases_on `wss` \\ fs [])
+  \\ rename [`v_rel x y`]
+  \\ imp_res_tac v_rel_to_list \\ fs []
+QED
+
+Theorem op_arrays:
+  op = Aalloc \/
+  op = Asub_unsafe \/
+  op = Asub \/
+  op = Alength \/
+  op = Aupdate_unsafe \/
+  op = Aupdate ==>
+  ^op_goal
+Proof
+  rpt strip_tac \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq,store_alloc_def]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [v_rel_def] \\ rveq \\ fs [PULL_EXISTS]
+  \\ fs [compile_op_def,evaluate_def,do_app_def,arg1_def]
+  \\ imp_res_tac LIST_REL_LENGTH \\ fs [SWAP_REVERSE_SYM,list_case_eq]
+  \\ rveq \\ fs [bool_case_eq] \\ rveq \\ fs []
+  \\ fs [subscript_exn_v_def,v_rel_def,integerTheory.INT_NOT_LT,CaseEq"store_v"]
+  \\ rveq \\ fs [PULL_EXISTS]
+  \\ imp_res_tac state_rel_LEAST \\ fs []
+  THEN1
+   (rename [`0<=i`]
+    \\ `Num (ABS i) = Num i` by intLib.COOPER_TAC \\ fs []
+    \\ fs [state_rel_def,store_rel_def,EL_LUPDATE]
+    \\ strip_tac
+    \\ first_x_assum (qspec_then `i'` mp_tac)
+    \\ IF_CASES_TAC
+    \\ fs [FLOOKUP_UPDATE,EL_LUPDATE,EL_APPEND1,EL_APPEND2]
+    \\ Cases_on `LENGTH s1.refs = i'` \\ fs [] \\ rveq \\ fs [] \\ rw []
+    \\ qspec_tac (`Num i`,`j`) \\ Induct \\ fs [])
+  THEN1
+   (imp_res_tac lookup_array \\ fs [GREATER_EQ,GSYM NOT_LESS,v_rel_def]
+    \\ fs [bool_case_eq] \\ rveq \\ fs [integerTheory.int_le]
+    \\ fs [v_rel_def]
+    \\ imp_res_tac LIST_REL_LENGTH
+    \\ fs [PULL_EXISTS]
+    \\ rename [`i6 < _:int`]
+    \\ reverse IF_CASES_TAC THEN1 `F` by intLib.COOPER_TAC \\ fs []
+    \\ fs [LIST_REL_EL]
+    \\ Cases_on `i6` \\ fs []
+    \\ first_x_assum (qspec_then `0` mp_tac)
+    \\ Cases_on `ws` \\ fs [])
+  THEN1
+   (imp_res_tac lookup_array \\ fs [GREATER_EQ,GSYM NOT_LESS,v_rel_def]
+    \\ fs [bool_case_eq] \\ rveq \\ fs [integerTheory.int_le]
+    \\ fs [v_rel_def]
+    \\ imp_res_tac LIST_REL_LENGTH THEN1 intLib.COOPER_TAC
+    \\ fs [PULL_EXISTS]
+    \\ rename [`i6 < _:int`]
+    \\ Cases_on `i6` \\ fs []
+    \\ fs [LIST_REL_EL]
+    \\ first_x_assum (qspec_then `0` mp_tac)
+    \\ Cases_on `ws` \\ fs [])
+  THEN1
+   (imp_res_tac lookup_array \\ fs [GREATER_EQ,GSYM NOT_LESS,v_rel_def]
+    \\ imp_res_tac LIST_REL_LENGTH \\ decide_tac)
+  THEN1
+   (imp_res_tac lookup_array \\ fs [GREATER_EQ,GSYM NOT_LESS,v_rel_def]
+    \\ fs [bool_case_eq,CaseEq"option"]
+    \\ rveq \\ fs [integerTheory.int_le,v_rel_def]
+    \\ rename [`~(i7 < 0i)`]
+    \\ `Num (ABS i7) = Num i7 /\
+        (i7 < &LENGTH ws <=> Num i7 < LENGTH ws)` by intLib.COOPER_TAC
+    \\ fs [] \\ imp_res_tac LIST_REL_LENGTH \\ fs []
+    \\ fs [option_case_eq] \\ rveq \\ fs [v_rel_def,Unit_def,EVAL ``tuple_tag``]
+    \\ fs [state_rel_def,store_rel_def,EL_LUPDATE]
+    \\ strip_tac
+    \\ first_x_assum (qspec_then `i` mp_tac)
+    \\ IF_CASES_TAC
+    \\ fs [FLOOKUP_UPDATE,EL_LUPDATE,EL_APPEND1,EL_APPEND2]
+    \\ IF_CASES_TAC \\ fs []
+    \\ CASE_TAC \\ fs [] \\ strip_tac \\ rveq \\ fs [LUPDATE_def]
+    \\ match_mp_tac EVERY2_LUPDATE_same \\ fs [])
+  \\ imp_res_tac lookup_array \\ fs [GREATER_EQ,GSYM NOT_LESS,v_rel_def]
+  \\ fs [bool_case_eq] \\ rveq \\ fs [integerTheory.int_le,v_rel_def]
+  \\ rename [`~(i7 < 0i)`]
+  \\ `Num (ABS i7) = Num i7 /\
+      (i7 < &LENGTH ws <=> Num i7 < LENGTH ws)` by intLib.COOPER_TAC
+  \\ fs [] \\ imp_res_tac LIST_REL_LENGTH \\ fs []
+  \\ qpat_x_assum `SOME (s2,res2) = _` (assume_tac o GSYM)
+  \\ fs [option_case_eq] \\ rveq \\ fs [v_rel_def,Unit_def,EVAL ``tuple_tag``]
+  \\ fs [state_rel_def,store_rel_def,EL_LUPDATE]
+  \\ strip_tac
+  \\ first_x_assum (qspec_then `i` mp_tac)
+  \\ IF_CASES_TAC
+  \\ fs [FLOOKUP_UPDATE,EL_LUPDATE,EL_APPEND1,EL_APPEND2]
+  \\ IF_CASES_TAC \\ fs []
+  \\ CASE_TAC \\ fs [] \\ strip_tac \\ rveq \\ fs [LUPDATE_def]
+  \\ match_mp_tac EVERY2_LUPDATE_same \\ fs []
+QED
+
+Theorem op_blocks:
+  (?n0 n1. op = TagLenEq n0 n1) \/
+  (?l. op = LenEq l) \/
+  op = ListAppend ==>
+  ^op_goal
+Proof
+  rpt strip_tac \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [v_rel_def] \\ rveq \\ fs [PULL_EXISTS]
+  \\ fs [compile_op_def,evaluate_def,do_app_def,arg1_def]
+  \\ imp_res_tac LIST_REL_LENGTH \\ fs [SWAP_REVERSE_SYM,list_case_eq]
+  \\ rveq \\ fs []
+  \\ imp_res_tac v_rel_to_list \\ fs []
+  \\ rveq \\ fs []
+  \\ match_mp_tac IMP_v_rel_to_list
+  \\ match_mp_tac EVERY2_APPEND_suff \\ fs []
+QED
+
+Theorem op_ffi:
+  (?n. op = FFI n) ==>
+  ^op_goal
+Proof
+  rpt strip_tac \\ rveq \\ fs []
+  \\ fs [flatSemTheory.do_app_def,list_case_eq,CaseEq "flatSem$v",PULL_EXISTS,
+         CaseEq "ast$lit",store_assign_def,option_case_eq]
+  \\ rw [] \\ fs [] \\ rveq \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
+  \\ fs [v_rel_def] \\ rveq \\ fs [PULL_EXISTS]
+  \\ fs [compile_op_def,evaluate_def,do_app_def,arg1_def]
+  \\ fs [CaseEq "store_v",CaseEq"ffi_result",option_case_eq,bool_case_eq]
+  \\ rveq \\ fs [SWAP_REVERSE_SYM] \\ rveq \\ fs []
+  \\ imp_res_tac lookup_byte_array \\ fs []
+  \\ `t1.ffi = s1.ffi` by fs[state_rel_def] \\ fs [o_DEF]
+  \\ fs [v_rel_def,Unit_def,EVAL ``tuple_tag``]
+  \\ fs [state_rel_def,store_rel_def,EL_LUPDATE]
+  \\ strip_tac
+  \\ first_x_assum (qspec_then `i` mp_tac)
+  \\ IF_CASES_TAC \\ fs [FLOOKUP_UPDATE]
+  \\ IF_CASES_TAC \\ fs []
+  \\ CASE_TAC \\ fs []
+QED
+
+Theorem compile_op_correct:
+  ^op_goal
+Proof
+  EVERY (map assume_tac
+    [op_refs, op_chars, op_ints, op_words, op_str, op_shifts,
+     op_floats, op_eq_gc, op_byte_arrays, op_vectors, op_arrays,
+     op_globals, op_blocks, op_ffi, op_byte_copy])
+  \\ `?this_is_case. this_is_case op` by (qexists_tac `K T` \\ fs [])
+  \\ rpt strip_tac \\ fs [] \\ Cases_on `op` \\ fs []
+QED
+
+Theorem compile_App:
+  ^(get_goal "flatLang$App")
+Proof
+  rpt strip_tac
+  \\ fs [evaluate_def,compile_def,flatSemTheory.evaluate_def]
+  \\ rfs [pair_case_eq]
+  \\ fs [EVERY_REVERSE, Q.ISPEC `no_Mat` ETA_THM]
+  \\ first_x_assum drule
+  \\ disch_then drule
+  \\ impl_tac THEN1 (CCONTR_TAC \\ fs [])
+  \\ strip_tac
+  \\ Cases_on `op = Opapp` \\ fs []
+  THEN1
+   (fs [compile_op_def] \\ rveq
+    \\ reverse (fs [result_case_eq] \\ rveq \\ fs [] \\ rveq \\ fs [])
+    THEN1
+     (Cases_on `compile m (REVERSE es)` \\ fs [arg2_def]
+      \\ fs [evaluate_def]
+      \\ rename [`_ = _::ys`] \\ Cases_on `ys` \\ fs [arg2_def]
+      \\ fs [evaluate_def]
+      \\ rename [`_ = _::_::ys`] \\ Cases_on `ys` \\ fs [arg2_def]
+      \\ fs [evaluate_def] \\ fs [pair_case_eq,result_case_eq])
+    \\ fs [option_case_eq,pair_case_eq] \\ rveq \\ fs []
+    \\ fs [flatSemTheory.do_opapp_def]
+    \\ `?f x. vs = [x;f]` by fs [list_case_eq,SWAP_REVERSE_SYM]
+    \\ rveq \\ fs [] \\ rveq \\ fs []
+    \\ `?ef ex. es = [ex;ef]` by
+      (imp_res_tac evaluate_IMP_LENGTH \\ fs [LENGTH_compile]
+       \\ Cases_on `es` \\ fs [] \\ Cases_on `t'` \\ fs [])
+    \\ rveq \\ fs [] \\ rveq \\ fs []
+    \\ `compile m [ef; ex] = HD (compile m [ef]) :: HD (compile m [ex]) :: []` by
+          fs [compile_def,LENGTH_compile]
+    \\ asm_rewrite_tac [arg2_def] \\ fs []
+    \\ fs [evaluate_def,LENGTH_compile]
+    \\ qpat_x_assum `evaluate _ = _` mp_tac
+    \\ once_rewrite_tac [evaluate_CONS] \\ fs []
+    \\ fs [pair_case_eq,result_case_eq,PULL_EXISTS]
+    \\ rpt strip_tac \\ rveq \\ fs []
+    \\ `?vx. v = [vx]` by
+        (imp_res_tac evaluate_IMP_LENGTH \\ fs [LENGTH_compile] \\ Cases_on `v` \\ fs [])
+    \\ rveq \\ fs []
+    \\ fs [evaluate_def]
+    \\ Cases_on `f` \\ fs [] \\ rveq \\ fs []
+    \\ qpat_x_assum `v_rel _ _` mp_tac
+    \\ once_rewrite_tac [v_rel_cases] \\ fs []
+    \\ strip_tac \\ fs []
+    \\ rename [`state_rel s1 t1`]
+    \\ `1 <= t1.max_app /\ t1.clock = s1.clock` by fs [state_rel_def]
+    \\ fs [dest_closure_def,check_loc_def] \\ rveq \\ fs []
+    THEN1
+     (Cases_on `s1.clock = 0`
+      THEN1 (fs [] \\ fs [state_rel_def] \\ rveq \\ fs[])
+      \\ fs []
+      \\ rename [`compile (SOME vn::m1) [e],vx::db1,dec_clock 1 t1`]
+      \\ `state_rel (dec_clock s1) (dec_clock 1 t1)` by
+           fs [flatSemTheory.dec_clock_def,dec_clock_def,state_rel_def]
+      \\ first_x_assum drule
+      \\ `env_rel <|v := (vn,x)::env'.v|> (SOME vn::m1) (vx::db1)` by
+            (match_mp_tac env_rel_CONS \\ fs [env_rel_def])
+      \\ disch_then drule \\ strip_tac \\ fs []
+      \\ Cases_on `res1` \\ fs [] \\ rveq \\ fs []
+      \\ imp_res_tac evaluate_sing \\ rveq \\ fs [])
+    \\ fs [EL_MAP]
+    \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ fs []
+    \\ Cases_on `s1.clock = 0`
+    THEN1 (fs [] \\ fs [state_rel_def] \\ rveq \\ fs[])
+    \\ fs [option_case_eq,pair_case_eq] \\ rveq \\ fs []
+    \\ `state_rel (dec_clock s1) (dec_clock 1 t1)` by
+         fs [flatSemTheory.dec_clock_def,dec_clock_def,state_rel_def]
+    \\ first_x_assum drule
+    \\ qpat_x_assum `ALL_DISTINCT (MAP FST l0)` assume_tac
+    \\ fs [find_recfun_EL]
+    \\ qpat_x_assum `SND (EL n l0) = (_,_)` assume_tac
+    \\ drule IMP_PAIR \\ strip_tac \\ rveq
+    \\ fs []
+    \\ qmatch_goalsub_abbrev_tac `evaluate (compile m2 _, db2, _)`
+    \\ disch_then (qspecl_then [`m2`,`db2`] mp_tac)
+    \\ reverse impl_tac
+    THEN1
+     (strip_tac \\ fs []
+      \\ rpt (goal_assum (first_assum o mp_then Any mp_tac))
+      \\ Cases_on `res1` \\ fs []
+      \\ rveq \\ fs [] \\ imp_res_tac evaluate_sing \\ fs [])
+    \\ unabbrev_all_tac
+    \\ reverse conj_tac
+    THEN1 (fs [EVERY_EL] \\ fs [EL_MAP])
+    \\ fs []
+    \\ match_mp_tac env_rel_CONS
+    \\ fs [build_rec_env_eq_MAP]
+    \\ match_mp_tac env_rel_APPEND \\ fs []
+    \\ fs [MAP_MAP_o,o_DEF]
+    \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ fs []
+    \\ match_mp_tac LIST_REL_MAP_GENLIST \\ fs [] \\ rw []
+    \\ once_rewrite_tac [v_rel_cases] \\ fs []
+    \\ rename [`env_rel env3 m3 db3`]
+    \\ qexists_tac `env3` \\ qexists_tac `m3` \\ fs []
+    \\ fs [o_DEF])
+  \\ reverse (fs [result_case_eq])
+  \\ rveq \\ fs [] \\ rveq \\ fs []
+  THEN1 (drule compile_op_evaluates_args \\ fs [])
+  \\ fs [option_case_eq,pair_case_eq] \\ rveq \\ fs []
+  \\ rename [`state_rel s1 t1`,`LIST_REL v_rel vs ws`,`_ = SOME (s2,res2)`]
+  \\ qmatch_goalsub_rename_tac `compile_op tt op cexps`
+  \\ drule EVERY2_REVERSE
+  \\ qmatch_goalsub_rename_tac `LIST_REL _ vvs`
+  \\ imp_res_tac state_rel_IMP_check_ctor \\ fs [] \\ rw []
+  \\ match_mp_tac (GEN_ALL compile_op_correct)
+  \\ rpt (asm_exists_tac \\ fs [])
+  \\ imp_res_tac evaluate_IMP_LENGTH
+  \\ imp_res_tac LIST_REL_LENGTH \\ fs []
+QED
+
+Theorem compile_correct:
+  ^(compile_correct_tm())
+Proof
+  match_mp_tac (the_ind_thm())
+  \\ EVERY (map strip_assume_tac [compile_nil, compile_cons,
+       compile_Lit, compile_Handle, compile_Raise, compile_Let,
+       compile_Letrec, compile_Fun, compile_Con, compile_App,
+       compile_If, compile_Mat, compile_Var_local])
+  \\ asm_rewrite_tac []
+QED
+
+Theorem compile_decs_correct:
+  ∀ds s res1 s1 (t:('c,'ffi) closSem$state).
+    evaluate_decs s ds = (s1,res1) ∧ state_rel s t ∧
+    no_Mat_decs ds /\ res1 ≠ SOME (Rabort Rtype_error) ⇒
+    ∃res2 t1.
+      evaluate (compile_decs ds,[],t) = (res2,t1) ∧ state_rel s1 t1 /\
+      ?v.
+        let res1' = (case res1 of NONE => Rval v | SOME e => Rerr e) in
+          result_rel (LIST_REL (\x y. T)) v_rel res1' res2
+Proof
+  Induct
+  THEN1 fs [evaluate_decs_def,compile_decs_def,closSemTheory.evaluate_def]
+  \\ reverse Cases \\ rw []
+  \\ imp_res_tac state_rel_IMP_check_ctor \\ fs [compile_decs_def]
+  \\ TRY (first_x_assum match_mp_tac)
+  \\ fs [evaluate_decs_def,compile_decs_def,closSemTheory.evaluate_def,evaluate_dec_def]
+  \\ fs [pair_case_eq,CaseEq"result",CaseEq"bool"] \\ rveq \\ fs []
+  \\ TRY asm_exists_tac \\ fs [] \\ rveq \\ fs []
+  \\ TRY (fs [state_rel_def] \\ NO_TAC)
+  \\ drule compile_correct
+  \\ fs [evaluate_APPEND]
+  \\ `env_rel <|v := []|> [] []` by fs [env_rel_def]
+  \\ disch_then drule
+  \\ disch_then drule
+  \\ strip_tac \\ fs []
+  \\ rveq \\ fs []
+  \\ first_x_assum drule \\ fs []
+  \\ disch_then drule
+  \\ rw [] \\ fs []
+  \\ Cases_on `res1` \\ fs []
+  \\ asm_exists_tac \\ fs []
+QED
+
+Theorem compile_semantics:
+   0 < max_app /\ no_Mat_decs ds ==>
+   flatSem$semantics T (ffi:'ffi ffi_state) ds ≠ Fail ==>
+   closSem$semantics ffi max_app FEMPTY co cc (compile_decs ds) =
+   flatSem$semantics T ffi ds
+Proof
+  strip_tac
+  \\ simp[flatSemTheory.semantics_def]
+  \\ IF_CASES_TAC \\ fs[]
+  \\ DEEP_INTRO_TAC some_intro \\ simp[]
+  \\ conj_tac >- (
+    rw[] \\ simp[closSemTheory.semantics_def]
+    \\ IF_CASES_TAC \\ fs[]
+    THEN1
+     (qhdtm_x_assum`flatSem$evaluate_decs`kall_tac
+      \\ last_x_assum(qspec_then`k'`mp_tac) \\ simp[]
+      \\ (fn g => subterm (fn tm => Cases_on`^(assert(has_pair_type)tm)`) (#2 g) g)
+      \\ spose_not_then strip_assume_tac
+      \\ drule (compile_decs_correct |> INST_TYPE [``:'c``|->``:'a``])
+      \\ qmatch_asmsub_abbrev_tac `([],init)`
+      \\ `state_rel (initial_state ffi k' T) init` by
+           fs [Abbr`init`,state_rel_initial_state]
+      \\ disch_then drule
+      \\ impl_tac THEN1 fs []
+      \\ strip_tac
+      \\ every_case_tac \\ fs [] \\ rw [] \\ fs [])
+    \\ DEEP_INTRO_TAC some_intro \\ simp[]
+    \\ conj_tac >- (
+      rw[]
+      \\ qmatch_assum_abbrev_tac`flatSem$evaluate_decs ss es = _`
+      \\ qmatch_assum_abbrev_tac`closSem$evaluate bp = _`
+      \\ fs [option_case_eq,result_case_eq]
+      \\ drule evaluate_decs_add_to_clock_io_events_mono_alt
+      \\ Q.ISPEC_THEN`bp`(mp_tac o Q.GEN`extra`)
+            (CONJUNCT1 closPropsTheory.evaluate_add_to_clock_io_events_mono)
+      \\ simp[Abbr`ss`,Abbr`bp`]
+      \\ disch_then(qspec_then`k`strip_assume_tac)
+      \\ disch_then(qspec_then`k'`strip_assume_tac)
+      \\ drule(GEN_ALL(SIMP_RULE std_ss [](CONJUNCT1 closPropsTheory.evaluate_add_to_clock)))
+      \\ disch_then(qspec_then `k` mp_tac)
+      \\ impl_tac >- rpt(PURE_FULL_CASE_TAC \\ fs[])
+      \\ drule(GEN_ALL(SIMP_RULE std_ss []
+           (ONCE_REWRITE_RULE [CONJ_COMM] flatPropsTheory.evaluate_decs_add_to_clock)))
+      \\ disch_then(qspec_then `k'` mp_tac)
+      \\ impl_tac >- rpt(PURE_FULL_CASE_TAC \\ fs[])
+      \\ ntac 2 strip_tac \\ fs[]
+      \\ drule (compile_decs_correct |> INST_TYPE [``:'c``|->``:'a``]) \\ rfs []
+      \\ disch_then (qspec_then `initial_state ffi max_app FEMPTY co cc k' with
+           clock := k + k'` mp_tac)
+      \\ impl_tac >-
+       (reverse conj_tac THEN1 (CCONTR_TAC \\ fs [])
+        \\ fs [flatPropsTheory.initial_state_clock,
+               closPropsTheory.initial_state_clock,
+               state_rel_initial_state])
+      \\ strip_tac \\ unabbrev_all_tac \\ fs[]
+      \\ fs[initial_state_def] \\ rfs[]
+      \\ rveq \\ fs []
+      \\ every_case_tac
+      \\ fs[state_component_equality] \\ fs [state_rel_def])
+    \\ drule (compile_decs_correct |> INST_TYPE [``:'c``|->``:'a``])
+    \\ `state_rel (initial_state ffi k T)
+         (initial_state ffi max_app FEMPTY co cc k)` by
+       (match_mp_tac state_rel_initial_state \\ fs []) \\ rfs []
+    \\ disch_then drule
+    \\ impl_tac THEN1 (CCONTR_TAC \\ fs [])
+    \\ strip_tac \\ fs []
+    \\ qexists_tac `k` \\ fs []
+    \\ every_case_tac
+    \\ fs[state_component_equality] \\ fs [state_rel_def])
+  \\ strip_tac
+  \\ simp[closSemTheory.semantics_def]
+  \\ IF_CASES_TAC \\ fs [] >- (
+    last_x_assum(qspec_then`k`strip_assume_tac)
+    \\ qmatch_assum_abbrev_tac`SND p ≠ _`
+    \\ Cases_on`p` \\ fs[markerTheory.Abbrev_def]
+    \\ pop_assum(assume_tac o SYM)
+    \\ drule (compile_decs_correct |> INST_TYPE [``:'c``|->``:'a``])
+    \\ `state_rel (initial_state ffi k T)
+         (initial_state ffi max_app FEMPTY co cc k)` by
+       (match_mp_tac state_rel_initial_state \\ fs [])
+    \\ disch_then drule
+    \\ impl_tac THEN1 (fs [] \\ CCONTR_TAC \\ fs [])
+    \\ strip_tac \\ fs []
+    \\ rveq \\ fs [] \\ every_case_tac \\ fs [])
+  \\ DEEP_INTRO_TAC some_intro \\ simp[]
+  \\ conj_tac >- (
+    spose_not_then strip_assume_tac
+    \\ last_x_assum(qspec_then`k`mp_tac)
+    \\ (fn g => subterm (fn tm => Cases_on`^(assert (can dest_prod o type_of) tm)` g) (#2 g))
+    \\ strip_tac
+    \\ drule (compile_decs_correct |> INST_TYPE [``:'c``|->``:'a``])
+    \\ `state_rel (initial_state ffi k T)
+         (initial_state ffi max_app FEMPTY co cc k)` by
+       (match_mp_tac state_rel_initial_state \\ fs [])
+    \\ disch_then drule
+    \\ impl_tac THEN1 (fs [] \\ CCONTR_TAC \\ fs [])
+    \\ strip_tac \\ fs [] \\ rveq \\ fs []
+    \\ qpat_x_assum `!k s. _` (qspecl_then [`k`] mp_tac)
+    \\ strip_tac \\ rfs []
+    \\ every_case_tac \\ fs [])
+  \\ strip_tac
+  \\ rpt (AP_TERM_TAC ORELSE AP_THM_TAC)
+  \\ simp[FUN_EQ_THM] \\ gen_tac
+  \\ rpt (AP_TERM_TAC ORELSE AP_THM_TAC)
+  \\ qpat_abbrev_tac`s0 = closSem$initial_state _ _ _ _ _`
+  \\ Cases_on `evaluate_decs (initial_state ffi k T) ds`
+  \\ drule (compile_decs_correct |> INST_TYPE [``:'c``|->``:'a``])
+  \\ `state_rel (initial_state ffi k T)
+       (initial_state ffi max_app FEMPTY co cc k)` by
+     (match_mp_tac state_rel_initial_state \\ fs [])
+  \\ disch_then drule
+  \\ impl_tac THEN1 (fs [] \\ last_x_assum (qspec_then `k` mp_tac) \\ fs [])
+  \\ fs [] \\ strip_tac \\ fs [state_rel_def]
+QED
+
+Theorem contains_App_SOME_APPEND:
+  closProps$contains_App_SOME ma (xs ++ ys) <=>
+  closProps$contains_App_SOME ma xs \/ closProps$contains_App_SOME ma ys
+Proof
+  simp [Once closPropsTheory.contains_App_SOME_EXISTS]
+  \\ simp [GSYM closPropsTheory.contains_App_SOME_EXISTS]
+QED
+
+val props_defs = [closPropsTheory.contains_App_SOME_def,
+    closPropsTheory.every_Fn_vs_NONE_def,
+    closPropsTheory.no_mti_def, Q.ISPEC `no_mti` ETA_THM,
+    closPropsTheory.esgc_free_def]
+
+Theorem EVERY_IMP_HD:
+  EVERY P xs /\ ~ NULL xs ==> P (HD xs)
+Proof
+  Cases_on `xs` \\ simp []
+QED
+
+Theorem compile_single_DEEP_INTRO:
+  !P. (!exp'. flat_to_clos$compile m [exp] = [exp'] ==> P [exp']) ==>
+  P (flat_to_clos$compile m [exp])
+Proof
+  qspecl_then [`m`, `[exp]`] assume_tac LENGTH_compile
+  \\ fs [quantHeuristicsTheory.LIST_LENGTH_2]
+QED
+
+Theorem elist_globals_empty:
+   !es. closProps$elist_globals es = {||} <=>
+        !e. MEM e es ==> set_globals e = {||}
+Proof
+  Induct \\ fs [] \\ rw [] \\ eq_tac \\ rw [] \\ fs []
+QED
+
+Theorem compile_set_globals:
+  ∀m e. EVERY no_Mat e ==>
+  closProps$elist_globals (compile m e) = flatProps$elist_globals e
+Proof
+  ho_match_mp_tac flat_to_closTheory.compile_ind
+  \\ simp [compile_def, elist_globals_REVERSE]
+  \\ rw []
+  \\ fs [EVERY_REVERSE, Q.ISPEC `no_Mat` ETA_THM]
+  \\ TRY (qmatch_goalsub_abbrev_tac `compile_lit _ lit` \\ Cases_on `lit`
+    \\ simp [compile_lit_def])
+  \\ TRY (qmatch_goalsub_abbrev_tac `compile_op _ op` \\ Cases_on `op`
+    \\ simp ([compile_op_def] @ props_defs)
+    \\ rpt (CASE_TAC \\ simp props_defs))
+  \\ TRY (qmatch_goalsub_abbrev_tac `AllocGlobals _ n` \\ Induct_on `n`
+    \\ simp [Once AllocGlobals_def]
+    \\ rw props_defs)
+  \\ simp [compile_def, closPropsTheory.op_gbag_def,
+    flatPropsTheory.op_gbag_def, closPropsTheory.elist_globals_append]
+  \\ rpt (
+    DEEP_INTRO_TAC compile_single_DEEP_INTRO
+    \\ rw [] \\ fs []
+  )
+  \\ simp ([CopyByteAw8_def, CopyByteStr_def] @ props_defs)
+  \\ simp [arg1_def, arg2_def]
+  \\ EVERY_CASE_TAC
+  \\ simp [flatPropsTheory.op_gbag_def, closPropsTheory.op_gbag_def]
+  \\ fs [Q.ISPEC `{||}` EQ_SYM_EQ, COMM_BAG_UNION]
+  \\ rpt (DEEP_INTRO_TAC compile_single_DEEP_INTRO
+    \\ rw [] \\ fs [])
+  \\ fs [dest_pat_def]
+  \\ simp [flatPropsTheory.elist_globals_FOLDR,
+        closPropsTheory.elist_globals_FOLDR]
+  \\ irule FOLDR_CONG
+  \\ simp [MAP_MAP_o]
+  \\ irule MAP_CONG
+  \\ simp [FORALL_PROD]
+  \\ rw []
+  \\ fs [EVERY_MAP]
+  \\ fs [EVERY_MEM]
+  \\ res_tac
+  \\ fs []
+  \\ qpat_x_assum `_ = flatProps$set_globals _` (assume_tac o GSYM)
+  \\ simp []
+  \\ rpt (DEEP_INTRO_TAC compile_single_DEEP_INTRO
+    \\ rw [] \\ fs [])
+QED
+
+Theorem compile_eq_set_globals:
+  flat_to_clos$compile m exps = exps' /\
+  EVERY no_Mat exps ==>
+  closProps$elist_globals exps' = flatProps$elist_globals exps
+Proof
+  metis_tac [compile_set_globals]
+QED
+
+Theorem compile_decs_set_globals:
+  ∀decs. no_Mat_decs decs ==>
+  closProps$elist_globals (compile_decs decs) =
+  flatProps$elist_globals (MAP dest_Dlet (FILTER is_Dlet decs))
+Proof
+  Induct
+  \\ simp [compile_decs_def]
+  \\ Cases
+  \\ simp [compile_decs_def, closPropsTheory.elist_globals_append]
+  \\ simp [compile_set_globals]
+QED
+
+Theorem compile_esgc_free:
+  !m e. EVERY flatProps$esgc_free e /\ EVERY no_Mat e ==>
+    EVERY closProps$esgc_free (flat_to_clos$compile m e)
+Proof
+  ho_match_mp_tac compile_ind
+  \\ simp [compile_def, closPropsTheory.esgc_free_def]
+  \\ simp [EVERY_REVERSE]
+  \\ rw []
+  \\ fs [EVERY_REVERSE, Q.ISPEC `no_Mat` ETA_THM]
+  \\ TRY (qmatch_goalsub_abbrev_tac `compile_lit _ lit` \\ Cases_on `lit`
+    \\ simp [compile_lit_def])
+  \\ TRY (qmatch_goalsub_abbrev_tac `compile_op _ op` \\ Cases_on `op`
+    \\ simp ([compile_op_def] @ props_defs)
+    \\ rpt (CASE_TAC \\ simp props_defs))
+  \\ TRY (qmatch_goalsub_abbrev_tac `AllocGlobals _ n` \\ Induct_on `n`
+    \\ simp [Once AllocGlobals_def]
+    \\ rw props_defs)
+  \\ simp [compile_def, closPropsTheory.op_gbag_def,
+    flatPropsTheory.op_gbag_def, closPropsTheory.elist_globals_append]
+  \\ rpt (
+    DEEP_INTRO_TAC compile_single_DEEP_INTRO
+    \\ rw [] \\ fs []
+  )
+  \\ simp ([CopyByteAw8_def, CopyByteStr_def] @ props_defs)
+  \\ simp [arg1_def, arg2_def]
+  \\ EVERY_CASE_TAC
+  \\ simp [flatPropsTheory.op_gbag_def, closPropsTheory.op_gbag_def]
+  \\ fs [Q.ISPEC `{||}` EQ_SYM_EQ, EVERY_REVERSE]
+  \\ imp_res_tac compile_eq_set_globals
+  \\ fs []
+  \\ rpt (DEEP_INTRO_TAC compile_single_DEEP_INTRO
+    \\ rw [] \\ fs [])
+  \\ fs [dest_pat_def]
+  \\ simp [elglobals_EQ_EMPTY, MEM_MAP, PULL_EXISTS]
+  \\ fs [flatPropsTheory.elist_globals_eq_empty,
+    FORALL_PROD, MEM_MAP, PULL_EXISTS]
+  \\ rw []
+  \\ res_tac
+  \\ DEEP_INTRO_TAC compile_single_DEEP_INTRO
+  \\ rw [] \\ fs []
+  \\ imp_res_tac compile_eq_set_globals
+  \\ fs [EVERY_MEM, MEM_MAP, PULL_EXISTS, FORALL_PROD]
+  \\ res_tac
+  \\ fs []
+QED
+
+Theorem compile_decs_esgc_free:
+  !decs. EVERY (flatProps$esgc_free o dest_Dlet) (FILTER is_Dlet decs) /\
+  no_Mat_decs decs ==>
+  EVERY closProps$esgc_free (compile_decs decs)
+Proof
+  Induct
+  \\ simp [compile_decs_def]
+  \\ Cases
+  \\ simp [compile_decs_def]
+  \\ simp [compile_esgc_free]
+QED
+
+Theorem compile_syntactic_props:
+  0 < max_app ⇒ ∀m e.
+    ¬closProps$contains_App_SOME max_app (compile m e) /\
+    EVERY closProps$no_mti (compile m e) /\
+    closProps$every_Fn_vs_NONE (compile m e)
+Proof
+  disch_tac
+  \\ ho_match_mp_tac compile_ind
+  \\ simp ([compile_def] @ props_defs)
+  \\ simp [contains_App_SOME_APPEND, EVERY_REVERSE]
+  \\ rw []
+  \\ TRY (qmatch_goalsub_abbrev_tac `compile_lit _ lit` \\ Cases_on `lit`
+    \\ simp [compile_lit_def])
+  \\ TRY (qmatch_goalsub_abbrev_tac `compile_op _ op` \\ Cases_on `op`
+    \\ simp ([compile_op_def] @ props_defs)
+    \\ rpt (CASE_TAC \\ simp props_defs))
+  \\ TRY (qmatch_goalsub_abbrev_tac `AllocGlobals _ n` \\ Induct_on `n`
+    \\ simp [Once AllocGlobals_def]
+    \\ rw props_defs)
+  \\ simp ([CopyByteAw8_def, CopyByteStr_def] @ props_defs)
+  \\ simp [arg1_def, arg2_def]
+  \\ EVERY_CASE_TAC
+  \\ fs props_defs
+  \\ imp_res_tac EVERY_IMP_HD
+  \\ fs [NULL_LENGTH, EVERY_REVERSE]
+  \\ simp [Once closPropsTheory.contains_App_SOME_EXISTS,
+        Once closPropsTheory.every_Fn_vs_NONE_EVERY,
+        EVERY_MAP, ELIM_UNCURRY]
+  \\ rw [EVERY_MEM, FORALL_PROD]
+  \\ first_x_assum drule
+  \\ rw []
+  \\ imp_res_tac EVERY_IMP_HD
+  \\ fs [NULL_LENGTH]
+QED
+
+Theorem compile_decs_syntactic_props:
+  !decs. EVERY closProps$no_mti (compile_decs decs) /\
+    closProps$every_Fn_vs_NONE (compile_decs decs) /\
+    (0 < max_app ==> ¬closProps$contains_App_SOME max_app (compile_decs decs))
+Proof
+  Induct
+  \\ simp ([compile_decs_def] @ props_defs)
+  \\ Cases
+  \\ simp ([compile_decs_def, contains_App_SOME_APPEND] @ props_defs)
+  \\ rw [] \\ simp [compile_syntactic_props]
+QED
+
+val _ = export_theory()
diff --git a/compiler/backend/proofs/flat_to_patProofScript.sml b/compiler/backend/proofs/flat_to_patProofScript.sml
deleted file mode 100644
index 99895595a6..0000000000
--- a/compiler/backend/proofs/flat_to_patProofScript.sml
+++ /dev/null
@@ -1,3594 +0,0 @@
-(*
-  Correctness proof for flat_to_pat
-*)
-open preamble
-     semanticPrimitivesTheory semanticPrimitivesPropsTheory
-     flatLangTheory flatPropsTheory flat_to_patTheory backendPropsTheory
-     patLangTheory patPropsTheory
-
-val _ = new_theory"flat_to_patProof"
-
-val _ = temp_bring_to_front_overload"pure_op"{Name="pure_op",Thy="flat_to_pat"};
-val _ = temp_bring_to_front_overload"Loc"{Name="Loc",Thy="patSem"};
-
-val _ = set_grammar_ancestry ["misc","ffi","bag","flatProps","patProps",
-                              "flat_to_pat","backendProps","backend_common"];
-
-val _ = Parse.hide"U";
-val drule = old_drule
-
-val pmatch_flat_def = flatSemTheory.pmatch_def
-
-val NoRun_def = tDefine "NoRun" `
-  (NoRun (Raise t e)      <=> NoRun e) /\
-  (NoRun (Handle t e1 e2) <=> NoRun e1 /\ NoRun e2) /\
-  (NoRun (Con t n es)     <=> EVERY NoRun es) /\
-  (NoRun (Fun t e)        <=> NoRun e) /\
-  (NoRun (App t op es)    <=> op <> Run /\ EVERY NoRun es) /\
-  (NoRun (If t e1 e2 e3)  <=> NoRun e1 /\ NoRun e2 /\ NoRun e3) /\
-  (NoRun (Let t e1 e2)    <=> NoRun e1 /\ NoRun e2) /\
-  (NoRun (Seq t e1 e2)    <=> NoRun e1 /\ NoRun e2) /\
-  (NoRun (Letrec t es e)  <=> EVERY NoRun es /\ NoRun e) /\
-  (NoRun expr             <=> T)`
-  (WF_REL_TAC `measure exp_size` \\ rw []
-   \\ imp_res_tac exp_size_MEM \\ fs [])
-
-Theorem sLet_NoRun:
-   !e1 e2.
-     NoRun e1 /\ NoRun e2
-     ==>
-     !t. NoRun (sLet t e1 e2)
-Proof
-  recInduct (theorem"NoRun_ind") \\ rw [NoRun_def]
-  \\ simp [sLet_def]
-  \\ every_case_tac \\ fs [NoRun_def]
-QED
-
-Theorem sIf_NoRun:
-   !e1 e2 e3.
-     NoRun e1 /\ NoRun e2 /\ NoRun e3
-     ==>
-     !t. NoRun (sIf t e1 e2 e3)
-Proof
-  recInduct (theorem"NoRun_ind") \\ rw [NoRun_def]
-  \\ simp [sIf_def]
-  \\ every_case_tac \\ fs [NoRun_def]
-QED
-
-Theorem compile_row_NoRun:
-   (!t bvs p ns n f e.
-      NoRun e /\
-      compile_row t bvs p = (ns, n, f)
-      ==>
-      NoRun (f e)) /\
-   (!t bvs n1 n2 ps ns n f e.
-      NoRun e /\
-      compile_cols t bvs n1 n2 ps = (ns, n, f)
-      ==>
-      NoRun (f e))
-Proof
-   ho_match_mp_tac compile_row_ind \\ rw [compile_row_def] \\ fs []
-   \\ rpt (pairarg_tac \\ fs []) \\ rveq \\ fs []
-   \\ irule sLet_NoRun \\ fs [NoRun_def]
-QED
-
-Theorem Let_Els_NoRun:
-   !t n m e. NoRun e ==> NoRun (Let_Els t n m e)
-Proof
-  recInduct Let_Els_ind \\ rw [NoRun_def] \\ fs [Let_Els_def]
-  \\ irule sLet_NoRun \\ fs [NoRun_def]
-QED
-
-Theorem compile_pat_NoRun:
-   (!t p. NoRun (compile_pat t p)) /\
-   (!t n ps. NoRun (compile_pats t n ps))
-Proof
-  ho_match_mp_tac compile_pat_ind \\ rw [compile_pat_def] \\ fs [NoRun_def]
-  \\ TRY (irule sIf_NoRun) \\ fs [NoRun_def]
-  \\ TRY (irule sLet_NoRun) \\ fs [NoRun_def]
-  \\ TRY (irule Let_Els_NoRun) \\ fs []
-QED
-
-Theorem compile_exp_NoRun:
-   (!bvs x. NoRun (compile_exp bvs x)) /\
-   (!bvs xs. EVERY NoRun (compile_exps bvs xs)) /\
-   (!bvs xs. EVERY NoRun (compile_funs bvs xs)) /\
-   (!tr bvs xs. NoRun (compile_pes tr bvs xs))
-Proof
-  ho_match_mp_tac compile_exp_ind \\ rw [NoRun_def] \\ fs [ETA_AX]
-  \\ rpt CASE_TAC \\ fs [NoRun_def]
-  \\ TRY (metis_tac [sLet_NoRun, compile_row_NoRun])
-  \\ metis_tac [compile_row_NoRun, sIf_NoRun, compile_pat_NoRun]
-QED
-
-Theorem compile_NoRun:
-   ∀decs. EVERY NoRun (compile decs)
-Proof
-  Induct \\ simp[compile_def]
-  \\ Cases \\ rw[compile_def, compile_exp_NoRun]
-QED
-
-val v_size_MEM = Q.prove (
-  `!vs (v: patSem$v). MEM v vs ==> v_size v < v1_size vs`,
-  Induct \\ rw [patSemTheory.v_size_def]
-  \\ res_tac \\ fs []);
-
-(* Closure and Recclosure are tricky when used with v_rel *)
-val NoRun_v_def = tDefine "NoRun_v" `
-  (NoRun_v (Conv _ vs)          <=> EVERY NoRun_v vs) /\
-  (NoRun_v (Closure vs e)       <=> NoRun e /\ EVERY NoRun_v vs) /\
-  (NoRun_v (Recclosure vs es _) <=> EVERY NoRun_v vs /\ EVERY NoRun es) /\
-  (NoRun_v (Vectorv vs)         <=> EVERY NoRun_v vs) /\
-  (NoRun_v v                    <=> T)`
-  (WF_REL_TAC `measure v_size` \\ rw []
-  \\ imp_res_tac v_size_MEM \\ fs []);
-
-val NoRun_store_v_def = Define `
-  (NoRun_store_v (Refv v)    <=> NoRun_v v) /\
-  (NoRun_store_v (Varray vs) <=> EVERY NoRun_v vs) /\
-  (NoRun_store_v _           <=> T)`
-
-val NoRun_state_def = Define `
-  NoRun_state st <=>
-    EVERY NoRun_store_v st.refs /\
-    EVERY (\g. !x. g = SOME x ==> NoRun_v x) st.globals`
-
-Theorem NoRun_state_dec_clock:
-   NoRun_state s <=> NoRun_state (dec_clock s)
-Proof
-  rw [NoRun_state_def, patSemTheory.dec_clock_def]
-QED
-
-Theorem build_rec_env_NoRun:
-   !funs cl_env.
-     EVERY NoRun_v cl_env /\
-     EVERY NoRun funs
-     ==>
-     EVERY NoRun_v (build_rec_env funs cl_env)
-Proof
-   gen_tac
-   \\ Induct_on `LENGTH funs` \\ rw []
-   >- simp [patSemTheory.build_rec_env_def]
-   \\ Cases_on `funs` \\ fs []
-   \\ first_x_assum (qspec_then `t` mp_tac) \\ fs []
-   \\ disch_then drule
-   \\ simp [patSemTheory.build_rec_env_def, EVERY_GENLIST]
-   \\ rw [] \\ fs [NoRun_v_def, ETA_AX]
-QED
-
-Theorem do_opapp_NoRun:
-   EVERY NoRun_v vs /\
-   do_opapp vs = SOME (env, e)
-   ==>
-   EVERY NoRun_v env /\
-   NoRun e
-Proof
-   simp [patSemTheory.do_opapp_def]
-   \\ rpt (PURE_CASE_TAC \\ fs [NoRun_v_def])
-   \\ rw [] \\ fs [ETA_AX, build_rec_env_NoRun, EVERY_EL]
-QED
-
-Theorem store_assign_NoRun:
-   !n r x t.
-     NoRun_v x /\
-     EVERY NoRun_store_v r /\
-     store_assign n (Refv x) r = SOME t
-     ==>
-     EVERY NoRun_store_v t
-Proof
-  Induct \\ rw [store_assign_def]
-  \\ Cases_on `r` \\ fs [LUPDATE_def, NoRun_store_v_def]
-  \\ first_x_assum drule
-  \\ disch_then drule
-  \\ simp [store_assign_def]
-QED
-
-Theorem v_to_list_NoRun:
-   !x xs.
-     NoRun_v x /\
-     v_to_list x = SOME xs
-     ==>
-     EVERY NoRun_v xs
-Proof
-  recInduct patSemTheory.v_to_list_ind \\ rw []
-  \\ fs [patSemTheory.v_to_list_def] \\ rw [] \\ fs []
-  \\ FULL_CASE_TAC \\ fs []
-  \\ rw [] \\ fs [NoRun_v_def]
-QED
-
-Theorem NoRun_list_to_v:
-   !xs.
-     EVERY NoRun_v xs
-     ==>
-     NoRun_v (list_to_v xs)
-Proof
-   Induct \\ rw [patSemTheory.list_to_v_def, NoRun_v_def]
-QED
-
-Theorem do_app_NoRun:
-   do_app s op vs = SOME (t, res) /\
-   EVERY NoRun_v vs /\
-   op <> Run /\
-   NoRun_state s
-   ==>
-   NoRun_state t /\
-   case res of
-     Rval v => NoRun_v v
-   | Rerr (Rraise e) => NoRun_v e
-   | _ => T
-Proof
-  simp [patSemTheory.do_app_def]
-  \\ rpt (PURE_TOP_CASE_TAC \\ fs [])
-  \\ rw [] \\ fs [patSemTheory.prim_exn_def, NoRun_v_def, patSemTheory.Boolv_def]
-  \\ rpt (pairarg_tac \\ fs []) \\ rw []
-  \\ TRY (imp_res_tac store_assign_NoRun \\ fs [NoRun_state_def] \\ NO_TAC)
-  \\ fs [store_alloc_def, store_lookup_def, store_assign_def, NoRun_state_def] \\ rveq
-  \\ fs [NoRun_store_v_def, NoRun_v_def]
-  \\ TRY (fs [EVERY_EL] \\ metis_tac [NoRun_store_v_def])
-  \\ TRY
-   (irule IMP_EVERY_LUPDATE \\ fs [NoRun_store_v_def]
-    \\ fs [EVERY_EL]
-    \\ `NoRun_store_v (Varray l)` by (res_tac \\ fs [EQ_SYM_EQ])
-    \\ fs [NoRun_store_v_def]
-    \\ rw [] \\ fs []
-    \\ fs [EL_LUPDATE]
-    \\ rw [] \\ fs [EVERY_EL]
-    \\ NO_TAC)
-  \\ imp_res_tac v_to_list_NoRun \\ fs [ETA_AX]
-  \\ fs [EVERY_REPLICATE]
-  \\ TRY (fs [EVERY_EL, IS_SOME_EXISTS] \\ res_tac \\ NO_TAC)
-  \\ TRY
-   (fs [EVERY_EL, NoRun_store_v_def]
-    \\ `NoRun_store_v (Varray l)` by (res_tac \\ fs [EQ_SYM_EQ])
-    \\ fs [NoRun_store_v_def, EVERY_EL]
-    \\ NO_TAC)
-  \\ irule NoRun_list_to_v \\ fs []
-  \\ rename [`MAP (λc. Litv (Char c)) ll`]
-  \\ Induct_on `ll` \\ fs [NoRun_v_def]
-QED
-
-Theorem do_if_NoRun:
-   do_if v x y = SOME z /\
-   NoRun_v v /\ NoRun x /\ NoRun y ==> NoRun z
-Proof
-  rw [patSemTheory.do_if_def] \\ fs []
-QED
-
-Theorem evaluate_NoRun:
-   !env s es t res.
-     evaluate env s es = (t, res) /\
-     EVERY NoRun es /\
-     EVERY NoRun_v env /\
-     NoRun_state s
-     ==>
-     NoRun_state t /\
-     case res of
-       Rval vs => EVERY NoRun_v vs
-     | Rerr (Rraise e) => NoRun_v e
-    | _ => T
-Proof
-  recInduct patSemTheory.evaluate_ind
-  \\ rpt conj_tac
-  >- (rw [patSemTheory.evaluate_def] \\ fs [patSemTheory.do_opapp_def])
-  >-
-   (rw [] \\ qhdtm_x_assum `evaluate` mp_tac \\ once_rewrite_tac [evaluate_cons]
-    \\ rpt (PURE_TOP_CASE_TAC \\ fs []) \\ rw [] \\ fs [])
-  >- (rw [patSemTheory.evaluate_def] \\ fs [NoRun_v_def])
-  \\ rw [] \\ qhdtm_x_assum `evaluate` mp_tac
-  \\ simp [patSemTheory.evaluate_def]
-  \\ rpt (PURE_TOP_CASE_TAC \\ fs []) \\ rw [] \\ fs []
-  \\ fs [NoRun_def]
-  \\ imp_res_tac evaluate_sing \\ fs []
-  \\ TRY
-   (fs [ETA_AX, EVERY_REVERSE, NoRun_v_def, EVERY_EL]
-    \\ fs [NoRun_state_def, EVERY_EL, IS_SOME_EXISTS]
-    \\ res_tac \\ fs []
-    \\ NO_TAC)
-  \\ TRY (* do_if *) (drule (GEN_ALL do_if_NoRun) \\ rw [])
-  \\ TRY (* do_app *)
-   (imp_res_tac do_opapp_NoRun \\ fs []
-    \\ fs [ETA_AX, EVERY_REVERSE, NoRun_v_def]
-    \\ every_case_tac \\ fs []
-    \\ TRY (imp_res_tac NoRun_state_dec_clock \\ fs [] \\ NO_TAC)
-    \\ drule (GEN_ALL do_app_NoRun) \\ fs [EVERY_REVERSE])
-  \\ TRY
-   (drule do_app_NoRun \\ fs [EVERY_REVERSE]
-    \\ Cases_on `r` \\ fs [] \\ rveq \\ fs [] \\ NO_TAC)
-  \\ every_case_tac \\ fs [ETA_AX]
-  \\ imp_res_tac build_rec_env_NoRun \\ fs []
-  \\ fs [NoRun_state_def, EVERY_GENLIST, NoRun_v_def]
-QED
-
-(* value translation *)
-
-val compile_tag_def = Define`
-  compile_tag (SOME (tag,_)) = tag ∧
-  compile_tag NONE = backend_common$tuple_tag`;
-val _ = export_rewrites["compile_tag_def"];
-
-val compile_v_def = tDefine"compile_v"`
-  (compile_v (Litv l) = Litv l) ∧
-  (compile_v (Conv tag vs) = Conv (compile_tag tag) (compile_vs vs)) ∧
-  (compile_v (Closure env x e) =
-    Closure
-      (MAP compile_v (MAP SND env))
-      (compile_exp (SOME x :: MAP (SOME o FST) env) e)) ∧
-  (compile_v (Recclosure env funs f) =
-    Recclosure
-      (MAP compile_v (MAP SND env))
-      (compile_funs (MAP (SOME o FST) funs ++ MAP (SOME o FST) env) funs)
-      (the (LENGTH funs) (find_index f (MAP FST funs) 0))) ∧
-  (compile_v (Loc n) = Loc n) ∧
-  (compile_v (Vectorv vs) = Vectorv (compile_vs vs)) ∧
-  (compile_vs [] = []) ∧
-  (compile_vs (v::vs) = compile_v v :: compile_vs vs)`
-(WF_REL_TAC`inv_image $< (\x. case x of INL v => v_size v
-                                      | INR vs => v3_size vs)` >>
- simp[] >> conj_tac >> rpt gen_tac >> Induct_on`env` >> simp[] >>
- Cases >> simp[flatSemTheory.v_size_def] >> srw_tac[][] >> res_tac >> simp[])
-val compile_v_def = save_thm("compile_v_def[compute]",
-  compile_v_def |> SIMP_RULE (srw_ss()++ETA_ss) [MAP_MAP_o])
-val _ = export_rewrites["compile_v_def"]
-
-Theorem compile_vs_map:
-   ∀vs. compile_vs vs = MAP compile_v vs
-Proof
-  Induct >> simp[]
-QED
-val _ = export_rewrites["compile_vs_map"]
-
-Theorem map_result_compile_vs_list_result[simp]:
-   map_result compile_vs f (list_result r) = list_result (map_result compile_v f r)
-Proof
-  Cases_on`r`>>simp[]
-QED
-
-Theorem compile_v_NoRun_v:
-   (!v. NoRun_v (compile_v v)) /\
-   (!vs. EVERY NoRun_v (compile_vs vs))
-Proof
-  ho_match_mp_tac (theorem"compile_v_ind") \\ rw []
-  \\ rw [NoRun_v_def] \\ fs [ETA_AX, compile_exp_NoRun]
-  \\ rw [EVERY_MEM] \\ fs [MEM_MAP] \\ rw []
-  \\ res_tac \\ fs []
-QED
-
-val compile_state_def = Define`
-  compile_state co cc (s:'ffi flatSem$state) :('c,'ffi) patSem$state =
-    <| clock := s.clock;
-       refs := MAP (map_sv compile_v) s.refs;
-       ffi := s.ffi;
-       globals := MAP (OPTION_MAP compile_v) s.globals;
-       compile := cc;
-       compile_oracle := pure_co compile o co (* s.compile_oracle *)
-     |>`;
-
-val compile_state_dec_clock = Q.prove(
-  `compile_state co cc (dec_clock s) = dec_clock (compile_state co cc s)`,
-  EVAL_TAC)
-
-val compile_state_with_clock = Q.prove(
-  `compile_state co cc (s with clock := k) = compile_state co cc s with clock := k`,
-  EVAL_TAC)
-
-Theorem compile_state_NoRun:
-   NoRun_state (compile_state co cc s)
-Proof
-  rw [compile_state_def, NoRun_state_def, EVERY_MEM]
-  \\ fs [MEM_MAP] \\ rw [] \\ fs [compile_v_NoRun_v]
-  \\ Cases_on `y` \\ fs [NoRun_store_v_def, compile_v_NoRun_v, EVERY_MAP,
-                         EVERY_MEM, compile_v_NoRun_v]
-QED
-
-(* semantic functions obey translation *)
-
-val do_eq = Q.prove(
-  `(∀v1 v2. do_eq v1 v2 ≠ Eq_type_error ⇒ do_eq v1 v2 = do_eq (compile_v v1) (compile_v v2)) ∧
-    (∀vs1 vs2. do_eq_list vs1 vs2 ≠ Eq_type_error ⇒ do_eq_list vs1 vs2 = do_eq_list (compile_vs vs1) (compile_vs vs2))`,
-  ho_match_mp_tac flatSemTheory.do_eq_ind >>
-  simp[flatSemTheory.do_eq_def,patSemTheory.do_eq_def] >>
-  srw_tac[][] >>
-  TRY (BasicProvers.CASE_TAC >> srw_tac[][])
-  \\ fs[] \\ rfs[]
-  \\ TRY (qpat_x_assum`Eq_val _ = X`(assume_tac o SYM) \\ fs[])
-  \\ Cases_on`cn1` \\ Cases_on`cn2`
-  \\ TRY (Cases_on`x`) \\ TRY (Cases_on`x'`)
-  \\ fs[flatSemTheory.ctor_same_type_def]);
-
-val do_opapp = Q.prove(
-  `∀vs env exp.
-    do_opapp vs = SOME (env,exp) ⇒
-    do_opapp (compile_vs vs) =
-      SOME (MAP (compile_v o SND) env, compile_exp (MAP (SOME o FST) env) exp)`,
-  rpt gen_tac >> simp[flatSemTheory.do_opapp_def] >>
-  BasicProvers.CASE_TAC >>
-  Cases_on`t`>>simp[]>>
-  Cases_on`t'`>>simp[]>>
-  Cases_on`h`>>simp[patSemTheory.do_opapp_def]>>
-  TRY(srw_tac[][] >> srw_tac[][]>>NO_TAC) >>
-  BasicProvers.CASE_TAC >>
-  BasicProvers.CASE_TAC >>
-  strip_tac >> rpt BasicProvers.VAR_EQ_TAC >>
-  full_simp_tac(srw_ss())[find_recfun_ALOOKUP,compile_funs_map,patSemTheory.build_rec_env_def,flatPropsTheory.build_rec_env_merge,FST_triple] >>
-  imp_res_tac ALOOKUP_find_index_SOME >>
-  simp[EL_MAP,UNCURRY,LIST_EQ_REWRITE,compile_funs_map,libTheory.the_def] >>
-  simp[MAP_MAP_o,combinTheory.o_DEF,UNCURRY] >>
-  `∃x y z. EL i l0 = (x,y,z)` by metis_tac[PAIR]>>full_simp_tac(srw_ss())[]>>
-  imp_res_tac find_index_ALL_DISTINCT_EL >>
-  full_simp_tac(srw_ss())[EL_MAP,libTheory.the_def])
-
-val v_to_list = Q.prove (
-  `!v1 v2 vs1.
-    compile_v v1 = v2 ∧
-    v_to_list v1 = SOME vs1
-    ⇒
-    ?vs2.
-      v_to_list v2 = SOME vs2 ∧
-      compile_vs vs1 = vs2`,
-  ho_match_mp_tac flatSemTheory.v_to_list_ind >>
-  srw_tac[][flatSemTheory.v_to_list_def] >>
-  BasicProvers.EVERY_CASE_TAC >>
-  full_simp_tac(srw_ss())[compile_v_def, patSemTheory.v_to_list_def] >>
-  srw_tac[][]);
-
-val v_to_char_list = Q.prove (
-  `!v1 v2 vs1.
-    compile_v v1 = v2 ∧
-    v_to_char_list v1 = SOME vs1
-    ⇒
-    v_to_char_list v2 = SOME vs1`,
-  ho_match_mp_tac flatSemTheory.v_to_char_list_ind >>
-  srw_tac[][flatSemTheory.v_to_char_list_def] >>
-  BasicProvers.EVERY_CASE_TAC >>
-  full_simp_tac(srw_ss())[compile_v_def, patSemTheory.v_to_char_list_def]);
-
-val vs_to_string = Q.prove(
-  `∀v. vs_to_string (MAP compile_v v) = vs_to_string v`,
-  ho_match_mp_tac flatSemTheory.vs_to_string_ind
-  \\ rw[flatSemTheory.vs_to_string_def,patSemTheory.vs_to_string_def]);
-
-Theorem list_to_v_compile:
-   !x xs.
-   v_to_list x = SOME xs /\
-   v_to_list (compile_v x) = SOME (MAP compile_v xs) ==>
-     list_to_v (MAP compile_v xs) = compile_v (list_to_v xs)
-Proof
-  ho_match_mp_tac flatSemTheory.v_to_list_ind
-  \\ rw [flatSemTheory.v_to_list_def] \\ fs []
-  \\ fs [patSemTheory.list_to_v_def, flatSemTheory.list_to_v_def]
-  \\ PURE_FULL_CASE_TAC \\ fs [] \\ rveq
-  \\ fs [patSemTheory.list_to_v_def, flatSemTheory.list_to_v_def,
-         patSemTheory.v_to_list_def, flatSemTheory.v_to_list_def]
-  \\ PURE_FULL_CASE_TAC \\ fs [] \\ rveq
-QED
-
-Theorem list_to_v_compile_APPEND:
-   !xs ys.
-     list_to_v (MAP compile_v xs) = compile_v (list_to_v xs) /\
-     list_to_v (MAP compile_v ys) = compile_v (list_to_v ys) ==>
-       list_to_v (MAP compile_v (xs ++ ys)) =
-       compile_v (list_to_v (xs ++ ys))
-Proof
-  Induct \\ rw [patSemTheory.list_to_v_def]
-  \\ fs [flatSemTheory.list_to_v_def, patSemTheory.list_to_v_def]
-QED
-
-Theorem compile_v_list_to_v_MAP_Litv_Char:
-  compile_v (list_to_v (MAP (λc. Litv (Char c)) str)) =
-             list_to_v (MAP (λc. Litv (Char c)) str)
-Proof
-  Induct_on `str`
-  \\ fs [patSemTheory.list_to_v_def,flatSemTheory.list_to_v_def]
-QED
-
-val do_app = Q.prove(
-  `∀cc co op vs s0 s res.
-     do_app b s0 op vs = SOME (s,res)
-     ⇒
-     do_app (compile_state co cc s0) (Op op) (compile_vs vs) =
-       SOME (compile_state co cc s,map_result compile_v compile_v res)`,
-  srw_tac[][compile_state_def] >>
-  fs[flatSemTheory.do_app_cases] >> rw[] >>
-  rw[patSemTheory.do_app_def,
-     patSemTheory.prim_exn_def,
-     flatSemTheory.div_exn_v_def,
-     flatSemTheory.subscript_exn_v_def,
-     flatSemTheory.chr_exn_v_def,
-     patSemTheory.Boolv_def, flatSemTheory.Boolv_def,
-     GSYM do_eq ] >>
-  rfs [store_assign_def, store_lookup_def, store_alloc_def, LET_THM, EL_MAP, LUPDATE_MAP] >>
-  rveq >>
-  rfs [store_v_same_type_def, LUPDATE_MAP,map_replicate] >>
-  imp_res_tac v_to_list >>
-  imp_res_tac v_to_char_list >>
-  fs[vs_to_string, IS_SOME_EXISTS, flatSemTheory.Unitv_def] >>
-  TRY (last_x_assum mp_tac) >>
-  TRY TOP_CASE_TAC \\ fs[]
-  \\ rw[flatSemTheory.Boolv_def,flatSemTheory.Boolv_def, backend_commonTheory.tuple_tag_def]
-  \\ fs [compile_v_list_to_v_MAP_Litv_Char]
-  \\ metis_tac [list_to_v_compile, list_to_v_compile_APPEND, MAP_APPEND]);
-
-(* pattern compiler correctness *)
-
-Theorem sIf_correct:
-   ∀env s e1 e2 e3 res.
-    evaluate env s [If t e1 e2 e3] = res ∧
-    (SND res ≠ Rerr (Rabort Rtype_error)) ⇒
-    evaluate env s [sIf t e1 e2 e3] = res
-Proof
-  rpt gen_tac >>
-  Cases_on`isBool T e2 ∧ isBool F e3` >- (
-    simp[sIf_def] >>
-    simp[patSemTheory.evaluate_def,patSemTheory.do_if_def] >>
-    fs[isBool_def] >>
-    every_case_tac >> fs[] >> rw[] >>
-    full_simp_tac(srw_ss())[evaluate_Con_nil] >>
-    imp_res_tac evaluate_sing >> fs[] >>
-    EVAL_TAC) >>
-  simp[sIf_def] >>
-  Cases_on`e1`>>simp[]>>
-  Cases_on`l`>>simp[]>>
-  simp[patSemTheory.evaluate_def] >>
-  simp[patSemTheory.do_if_def] >> srw_tac[][] >> full_simp_tac(srw_ss())[evaluate_Con_nil] >>
-  full_simp_tac(srw_ss())[patSemTheory.Boolv_def,backend_commonTheory.true_tag_def,backend_commonTheory.false_tag_def]
-QED
-
-Theorem sIf_intro:
-   P (evaluate env s [If t e1 e2 e3]) ∧
-   SND (evaluate env s [If t e1 e2 e3]) ≠ Rerr (Rabort Rtype_error) ⇒
-   P (evaluate env s [sIf t e1 e2 e3])
-Proof
-  metis_tac[sIf_correct]
-QED
-
-val v_to_list_no_closures = Q.prove (
-  `!v vs.
-    v_to_list v = SOME vs ∧
-    no_closures v
-    ⇒
-    EVERY no_closures vs`,
-  ho_match_mp_tac patSemTheory.v_to_list_ind >>
-  srw_tac[][patSemTheory.v_to_list_def] >>
-  srw_tac[][] >>
-  BasicProvers.EVERY_CASE_TAC >>
-  full_simp_tac(srw_ss())[compile_v_def, patSemTheory.v_to_list_def] >>
-  srw_tac[][]);
-
-val s = mk_var("s",
-  ``patSem$evaluate`` |> type_of |> strip_fun |> #1 |> el 2
-  |> type_subst[alpha|->gamma,beta|->``:'ffi``])
-
-val lemmas =
-  [PAIR_EQ,
-   semanticPrimitivesTheory.result_distinct,
-   semanticPrimitivesTheory.result_11,
-   semanticPrimitivesTheory.error_result_distinct,
-   semanticPrimitivesTheory.error_result_11,
-   semanticPrimitivesTheory.abort_distinct]
-
-Theorem pure_correct:
-   (∀e. pure e ⇒
-        ∀env ^s. (∃v. evaluate env s [e] = (s,Rval v)) ∨
-                 (evaluate env s [e] = (s,Rerr(Rabort Rtype_error)))) ∧
-   (∀es. pure_list es ⇒
-        ∀env ^s. ((∃vs. evaluate env s es = (s,Rval vs)) ∨
-                  (evaluate env s es = (s,Rerr(Rabort Rtype_error)))) ∧
-                 ((∃vs. evaluate env s (REVERSE es) = (s,Rval vs)) ∨
-                  (evaluate env s (REVERSE es) = (s,Rerr(Rabort Rtype_error)))))
-Proof
-  ho_match_mp_tac(TypeBase.induction_of(``:patLang$exp``)) >>
-  simp[pure_def] >> srw_tac[][] >> full_simp_tac(srw_ss())[] >>
-  srw_tac[][patSemTheory.evaluate_def] >>
-  every_case_tac >> full_simp_tac(srw_ss())[] >>
-  TRY (
-    rename1`op ≠ (Op Opapp)` >>
-    fs[patSemTheory.do_app_cases] >> rw[] >>
-    rev_full_simp_tac(srw_ss())[]>>srw_tac[][] >>
-    first_x_assum(qspecl_then[`env`,`s`]mp_tac)>>srw_tac[][] >>
-    every_case_tac >> full_simp_tac(srw_ss())[] >> srw_tac[][] >>
-    NO_TAC) >>
-  TRY (
-    rename1`do_if (HD vs) e1 e2 = SOME ee` >>
-    full_simp_tac(srw_ss())[patSemTheory.do_if_def] >>
-    every_case_tac >> full_simp_tac(srw_ss())[] >> srw_tac[][] >>
-    metis_tac lemmas) >>
-  TRY (
-    rename1`evaluate env s (e::es)` >>
-    ONCE_REWRITE_TAC[CONS_APPEND] >>
-    REWRITE_TAC[evaluate_append_Rval_iff,evaluate_append_Rerr] >>
-    metis_tac lemmas ) >>
-  REWRITE_TAC[evaluate_append_Rval_iff,evaluate_append_Rerr] >>
-  metis_tac lemmas
-QED
-
-Theorem ground_correct:
-   (∀e n. ground n e ⇒
-      (∀env1 env2 ^s res.
-          n ≤ LENGTH env1 ∧ n ≤ LENGTH env2 ∧
-          (TAKE n env2 = TAKE n env1) ∧
-          evaluate env1 s [e] = res ⇒
-          evaluate env2 s [e] = res)) ∧
-    (∀es n. ground_list n es ⇒
-      (∀env1 env2 ^s res.
-          n ≤ LENGTH env1 ∧ n ≤ LENGTH env2 ∧
-          (TAKE n env2 = TAKE n env1) ⇒
-          (evaluate env1 s es = res ⇒
-           evaluate env2 s es = res) ∧
-          (evaluate env1 s (REVERSE es) = res ⇒
-           evaluate env2 s (REVERSE es) = res)))
-Proof
-  ho_match_mp_tac(TypeBase.induction_of(``:patLang$exp``)) >>
-  srw_tac[][patSemTheory.evaluate_def] >>
-  res_tac >> rev_full_simp_tac(srw_ss())[] >> srw_tac[][] >>
-  TRY (
-    rename1`n1:num < n2` >>
-    full_simp_tac(srw_ss())[LIST_EQ_REWRITE] >>
-    rev_full_simp_tac(srw_ss())[rich_listTheory.EL_TAKE] >>
-    NO_TAC) >>
-  TRY (
-    rpt(AP_TERM_TAC >> srw_tac[][FUN_EQ_THM]) >>
-    AP_THM_TAC >> AP_TERM_TAC >> srw_tac[][FUN_EQ_THM]) >>
-  srw_tac[][patSemTheory.do_if_def] >>
-  TRY (
-    REWRITE_TAC[evaluate_append] >>
-    simp[] >> NO_TAC) >>
-  ONCE_REWRITE_TAC[CONS_APPEND] >>
-  REWRITE_TAC[evaluate_append] >>
-  simp[]
-QED
-
-Theorem sLet_correct:
-   ∀env ^s e1 e2 res.
-    evaluate env s [Let t e1 e2] = res ∧
-    SND res ≠ Rerr (Rabort Rtype_error) ⇒
-    evaluate env s [sLet t e1 e2] = res
-Proof
-  rw[] \\
-  Cases_on`∃tr. e2 = Var_local tr 0` >- (
-    fs[sLet_def,patSemTheory.evaluate_def] \\
-    CASE_TAC \\ fs[] \\ CASE_TAC \\ fs[] \\
-    imp_res_tac evaluate_sing \\ fs[] ) \\
-  `sLet t e1 e2 = if ground 0 e2 then if pure e1 then e2 else Seq t e1 e2 else Let t e1 e2`
-  by (
-    fs[sLet_def] \\ Cases_on`e2` \\ fs[] \\
-    CASE_TAC \\ fs[] ) \\ fs[] \\
-  rw[] >- (
-    imp_res_tac pure_correct >>
-    first_x_assum(qspecl_then[`s`,`env`]strip_assume_tac) >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def] >>
-    qspecl_then[`e2`,`0`]mp_tac(CONJUNCT1 ground_correct) >>
-    srw_tac[][]) >>
-  full_simp_tac(srw_ss())[patSemTheory.evaluate_def] >>
-  BasicProvers.CASE_TAC >> full_simp_tac(srw_ss())[] >>
-  BasicProvers.CASE_TAC >> full_simp_tac(srw_ss())[] >>
-  qspecl_then[`e2`,`0`]mp_tac(CONJUNCT1 ground_correct) >> srw_tac[][]
-QED
-
-Theorem sLet_intro:
-   P (evaluate env s [Let t e1 e2]) ∧
-   SND (evaluate env s [Let t e1 e2]) ≠ Rerr (Rabort Rtype_error)
-   ⇒ P (evaluate env s [sLet t e1 e2])
-Proof
-  metis_tac[sLet_correct]
-QED
-
-val Let_Els_correct = Q.prove(
-  `∀t n k e tag vs env ^s res us.
-    LENGTH us = n ∧ k ≤ LENGTH vs ∧
-    evaluate (TAKE k vs ++ us ++ (Conv tag vs::env)) s [e] = res ∧
-    SND res ≠ Rerr (Rabort Rtype_error) ⇒
-    evaluate (us ++ (Conv tag vs::env)) s [Let_Els t n k e] = res`,
-  ho_match_mp_tac Let_Els_ind >> srw_tac[][Let_Els_def] >>
-  match_mp_tac sLet_correct >>
-  srw_tac[][patSemTheory.evaluate_def] >>
-  simp[rich_listTheory.EL_APPEND2,rich_listTheory.EL_APPEND1] >>
-  simp[patSemTheory.do_app_def] >>
-  qmatch_assum_rename_tac`SUC k ≤ LENGTH vs` >>
-  first_x_assum(qspecl_then[`tag`,`vs`,`env`,`s`,`EL k vs::us`]mp_tac) >>
-  simp[] >>
-  `k < LENGTH vs` by simp[] >>
-  impl_tac >- (
-    full_simp_tac(srw_ss())[arithmeticTheory.ADD1] >>
-    full_simp_tac(srw_ss())[rich_listTheory.TAKE_EL_SNOC] >>
-    full_simp_tac(srw_ss())[SNOC_APPEND] >>
-    metis_tac[rich_listTheory.CONS_APPEND,APPEND_ASSOC] ) >>
-  srw_tac[][] >>
-  rpt (AP_TERM_TAC ORELSE AP_THM_TAC) >> simp[] >>
-  metis_tac[SNOC_APPEND,SNOC_EL_TAKE]);
-
-val Let_Els_correct = Q.prove(
-  `∀t n k e tag vs env ^s res us enve.
-    LENGTH us = n ∧ k ≤ LENGTH vs ∧
-    evaluate (TAKE k vs ++ us ++ (Conv tag vs::env)) s [e] = res ∧
-    (enve = us ++ (Conv tag vs::env)) ∧ SND res ≠ Rerr (Rabort Rtype_error)
-    ⇒
-    evaluate enve s [Let_Els t n k e] = res`,
-  metis_tac[Let_Els_correct]);
-
-val s = mk_var("s",
-  ``flatSem$evaluate`` |> type_of |> strip_fun |> #1 |> el 2
-  |> type_subst[alpha |-> ``:'ffi``])
-
-val compile_pat_correct = Q.prove(
-  `(∀t p v ^s env res env4.
-       pmatch s p v env = res ∧ ¬s.check_ctor ∧ res ≠ Match_type_error ⇒
-       evaluate
-         (compile_v v::env4)
-         (compile_state co cc s)
-         [compile_pat t p] =
-         (compile_state co cc s
-         ,Rval [Boolv (∃env'. res = Match env')])) ∧
-    (∀t n ps qs vs ^s env env' res env4.
-       pmatch_list s qs (TAKE n vs) env = Match env' ∧
-       pmatch_list s ps (DROP n vs) env = res ∧ ¬s.check_ctor ∧ res ≠ Match_type_error ∧
-       (n = LENGTH qs) ∧ n ≤ LENGTH vs ⇒
-       evaluate
-         (compile_vs vs ++ env4)
-         (compile_state co cc s)
-         [compile_pats t n ps] =
-         (compile_state co cc s
-         ,Rval [Boolv (∃env'. res = Match env')]))`,
-  ho_match_mp_tac compile_pat_ind >>
-  srw_tac[][flatSemTheory.pmatch_def,compile_pat_def] >>
-  srw_tac[][patSemTheory.evaluate_def]
-  >- srw_tac[][patSemTheory.Boolv_def]
-  >- srw_tac[][patSemTheory.Boolv_def]
-  >- (
-    (Cases_on`v`>>full_simp_tac(srw_ss())[flatSemTheory.pmatch_def]>>pop_assum mp_tac >> srw_tac[][]) >>
-    srw_tac[][compile_state_def,patSemTheory.do_app_def,EXISTS_PROD] >>
-    srw_tac[][patSemTheory.do_eq_def] >>
-    metis_tac[lit_same_type_sym])
-  >- (
-    Cases_on`v` \\ fs[flatSemTheory.pmatch_def]
-    \\ rename1`Conv cn l`
-    \\ Cases_on`cn` \\ fs[flatSemTheory.pmatch_def]
-    \\ fs[patSemTheory.Boolv_def] )
-  >- (
-    Cases_on`v`>>full_simp_tac(srw_ss())[flatSemTheory.pmatch_def]>>pop_assum mp_tac >> srw_tac[][LENGTH_NIL_SYM] >>
-    srw_tac[][patSemTheory.do_app_def,compile_state_def] >>
-    srw_tac[][patSemTheory.do_eq_def] >>
-    simp[flatSemTheory.pmatch_def] >>
-    full_simp_tac(srw_ss())[LENGTH_NIL]
-    \\ rename1`Conv cn l`
-    \\ Cases_on`cn` \\ fs[flatSemTheory.pmatch_def]
-    \\ Cases_on`x` \\ fs[flatSemTheory.same_ctor_def]
-    \\ rw[] \\ fs[])
-  >- (
-    match_mp_tac sIf_correct >>
-    srw_tac[][patSemTheory.evaluate_def] >>
-    full_simp_tac(srw_ss())[LENGTH_NIL_SYM,flatSemTheory.pmatch_def] >>
-    full_simp_tac(srw_ss())[patSemTheory.do_app_def,compile_state_def] >>
-    Cases_on`v`>>full_simp_tac(srw_ss())[flatSemTheory.pmatch_def]>>
-    simp[patSemTheory.do_if_def] >>
-    rename1`Conv cn l` \\ Cases_on`cn` \\ fs[flatSemTheory.pmatch_def] \\ rfs[]
-    \\ Cases_on`x` \\ fs[flatSemTheory.same_ctor_def]
-    \\ IF_CASES_TAC >> full_simp_tac(srw_ss())[] >> full_simp_tac(srw_ss())[] >>
-    TRY ( simp[evaluate_Con_nil,patSemTheory.Boolv_def] >> rw[] \\ fs[]
-          \\ rfs[] \\ NO_TAC) >>
-    match_mp_tac Let_Els_correct >>
-    simp[LENGTH_NIL,TAKE_LENGTH_ID_rwt])
-  >- (
-    match_mp_tac sLet_correct >> simp[] >>
-    srw_tac[][patSemTheory.evaluate_def] >>
-    srw_tac[][patSemTheory.do_app_def,compile_state_def] >>
-    Cases_on`v`>>full_simp_tac(srw_ss())[flatSemTheory.pmatch_def]>>
-    full_simp_tac(srw_ss())[store_lookup_def] >>
-    srw_tac[][] >> full_simp_tac(srw_ss())[] >> simp[EL_MAP] >>
-    Cases_on`EL n s.refs`>>
-    full_simp_tac(srw_ss())[compile_state_def])
-  >- (
-    simp[patSemTheory.Boolv_def] >> srw_tac[][] >>
-    Cases_on`DROP (LENGTH qs) vs`>>full_simp_tac(srw_ss())[flatSemTheory.pmatch_def]) >>
-  match_mp_tac sIf_correct >> simp[] >>
-  srw_tac[][patSemTheory.evaluate_def] >>
-  qpat_abbrev_tac`xx = evaluate _ _ [sLet _ _ _]` >>
-  qho_match_abbrev_tac`P xx` >> qunabbrev_tac`xx` >>
-  qmatch_abbrev_tac`P (evaluate B C [sLet tt D E])` >>
-  qsuff_tac`P (evaluate B C [Let tt D E])` >- (
-    simp[Abbr`P`] >>
-    ntac 2 BasicProvers.CASE_TAC >>
-    imp_res_tac sLet_correct >> full_simp_tac(srw_ss())[]) >>
-  unabbrev_all_tac >>
-  srw_tac[][patSemTheory.evaluate_def] >>
-  (Cases_on`LENGTH qs = LENGTH vs` >- (
-     full_simp_tac(srw_ss())[rich_listTheory.DROP_LENGTH_NIL_rwt,flatSemTheory.pmatch_def] )) >>
-  simp[rich_listTheory.EL_APPEND1,EL_MAP] >>
-  imp_res_tac flatPropsTheory.pmatch_list_pairwise >>
-  Cases_on`DROP (LENGTH qs) vs` >> full_simp_tac(srw_ss())[flatSemTheory.pmatch_def] >>
-  qmatch_assum_rename_tac`DROP (LENGTH qs) vs = v::ws` >>
-  Q.PAT_ABBREV_TAC`env5 = X ++ env4` >>
-  `LENGTH qs < LENGTH vs` by simp[] >>
-  full_simp_tac(srw_ss())[rich_listTheory.DROP_EL_CONS] >>
-  first_x_assum(qspecl_then[`v`,`s`,`env`,`env5`]mp_tac) >>
-  Cases_on`pmatch s p v env`>>full_simp_tac(srw_ss())[] >- (
-    strip_tac >>
-    simp[patSemTheory.do_if_def,patPropsTheory.Boolv_disjoint] >>
-    simp[patSemTheory.Boolv_def,patSemTheory.evaluate_def]) >>
-  strip_tac >>
-  simp[patSemTheory.do_if_def] >>
-  simp[Abbr`env5`] >>
-  first_x_assum(qspecl_then[`qs++[p]`,`vs`,`s`,`env`]mp_tac) >>
-  simp[] >>
-  simp[rich_listTheory.TAKE_EL_SNOC,GSYM SNOC_APPEND] >>
-  simp[flatPropsTheory.pmatch_list_snoc] >>
-  imp_res_tac flatPropsTheory.pmatch_any_match >>
-  qmatch_assum_rename_tac`pmatch_list s qs _ env = Match env2` >>
-  last_x_assum(qspec_then`env2`strip_assume_tac)>>simp[]>>
-  qmatch_assum_rename_tac`pmatch s p v env = Match env3`>>
-  Cases_on`pmatch_list s ps ws env`>>simp[]>>
-  Cases_on`pmatch_list s ps ws env3`>>full_simp_tac(srw_ss())[]>>
-  metis_tac[flatPropsTheory.pmatch_any_match_error
-           ,flatPropsTheory.pmatch_any_match
-           ,flatPropsTheory.pmatch_any_no_match
-           ,match_result_distinct])
-
-val compile_row_correct = Q.prove(
-  `(∀t Nbvs0 p bvs0 ^s v menv bvs1 n f.
-      (Nbvs0 = NONE::bvs0) ∧
-      (pmatch s p v [] = Match menv) ∧
-      ¬s.check_ctor ∧
-      (compile_row t Nbvs0 p = (bvs1,n,f))
-    ⇒ ∃menv4 bvs.
-       EVERY NoRun_v menv4 /\
-       (bvs1 = bvs ++ bvs0) ∧
-       (LENGTH bvs = SUC n) ∧
-       (LENGTH menv4 = SUC n) ∧
-       (FILTER (IS_SOME o FST) (ZIP(bvs,menv4)) =
-        MAP (λ(x,v). (SOME x, compile_v v)) menv) ∧
-       ∀env count genv e res.
-         evaluate (menv4++env)
-           ((<| clock := count; refs := MAP (map_sv compile_v) s.refs;
-                ffi := s.ffi; globals := genv;
-                compile := any_cc;
-                compile_oracle := any_co
-                |>):('c,'ffi) patSem$state)
-         [e] = res ∧
-         SND res ≠ Rerr (Rabort Rtype_error) ⇒
-         evaluate (compile_v v::env)
-           <| clock := count; refs := MAP (map_sv compile_v) s.refs;
-              ffi := s.ffi; globals := genv;
-              compile := any_cc;
-              compile_oracle := any_co
-              |> [f e] = res) ∧
-   (∀t bvsk0 nk k ps tag ^s qs vs menvk menv4k menv bvsk bvs0 bvs1 n1 f.
-     (pmatch_list s qs (TAKE k vs) [] = Match menvk) ∧
-     (pmatch_list s ps (DROP k vs) [] = Match menv) ∧
-      ¬s.check_ctor ∧
-     (compile_cols t bvsk0 nk k ps = (bvs1,n1,f)) ∧
-     (bvsk0 = bvsk ++ NONE::bvs0) ∧
-     (k = LENGTH qs) ∧ k ≤ LENGTH vs ∧ (LENGTH bvsk = nk) ∧
-     (LENGTH menv4k = LENGTH bvsk) ∧
-     (FILTER (IS_SOME o FST) (ZIP(bvsk,menv4k)) =
-      MAP (λ(x,v). (SOME x, compile_v v)) menvk)
-   ⇒ ∃menv4 bvs.
-       EVERY NoRun_v menv4 /\
-       (bvs1 = bvs ++ bvsk ++ NONE::bvs0) ∧
-       (LENGTH bvs = n1) ∧ (LENGTH menv4 = n1) ∧
-       (FILTER (IS_SOME o FST) (ZIP(bvs,menv4)) =
-        MAP (λ(x,v). (SOME x, compile_v v)) menv) ∧
-       ∀env count genv e res.
-         evaluate (menv4++menv4k++(Conv tag (MAP compile_v vs))::env)
-           ((<| clock := count; refs := MAP (map_sv compile_v) s.refs;
-                ffi := s.ffi; globals := genv;
-                compile := any_cc; compile_oracle := any_co |>): ('c,'ffi) patSem$state)
-         [e] = res ∧
-         SND res ≠ Rerr (Rabort Rtype_error) ⇒
-         evaluate (menv4k++(Conv tag (MAP compile_v vs))::env)
-           <| clock := count; refs := MAP (map_sv compile_v) s.refs;
-              ffi := s.ffi; globals := genv;
-              compile := any_cc; compile_oracle := any_co |> [f e] = res)`,
-  ho_match_mp_tac compile_row_ind >>
-  strip_tac >- (
-    srw_tac[][flatSemTheory.pmatch_def,compile_row_def] >> srw_tac[][] >>
-    qexists_tac`[compile_v v]` >> srw_tac[][] >>
-    fs [compile_v_NoRun_v]) >>
-  strip_tac >- (
-    srw_tac[][flatSemTheory.pmatch_def,compile_row_def] >> srw_tac[][] >>
-    qexists_tac`[compile_v v]` >> srw_tac[][] >>
-    fs [compile_v_NoRun_v]) >>
-  strip_tac >- (
-    srw_tac[][pmatch_flat_def,compile_row_def] >> srw_tac[][] >>
-    qexists_tac`[compile_v v]` >> srw_tac[][] >>
-    fs [compile_v_NoRun_v] >>
-    Cases_on`v`>>full_simp_tac(srw_ss())[flatSemTheory.pmatch_def] >>
-    rpt(pop_assum mp_tac) >> srw_tac[][] ) >>
-  strip_tac >- (
-    srw_tac[][pmatch_flat_def,compile_row_def] >> full_simp_tac(srw_ss())[] >>
-    Cases_on`v`>>full_simp_tac(srw_ss())[pmatch_flat_def] >>
-    qpat_x_assum`X = Match menv`mp_tac >> srw_tac[][] >>
-    rename1`pmatch _ (Pcon xx _) (Conv yy _) [] = _`
-    \\ Cases_on`xx` \\ Cases_on`yy` \\ rfs[pmatch_flat_def]
-    \\ pop_assum mp_tac \\ rw[] >>
-    qmatch_assum_rename_tac`pmatch_list s ps vs [] = Match menv` >>
-    full_simp_tac(srw_ss())[LENGTH_NIL,pmatch_flat_def,LENGTH_NIL_SYM] >>
-    Q.PAT_ABBREV_TAC`w = Conv X Y` >>
-    qmatch_assum_rename_tac`Abbrev(w = Conv tag (MAP compile_v vs))` >>
-    first_x_assum(qspecl_then[`tag`,`s`,`vs`]mp_tac) >> srw_tac[][] >> srw_tac[][] >>
-    simp[] >>
-    qexists_tac`menv4++[w]` >>
-    simp[GSYM rich_listTheory.ZIP_APPEND,rich_listTheory.FILTER_APPEND] >>
-    conj_tac >- fs [Abbr`w`, compile_v_NoRun_v, NoRun_v_def, ETA_AX, EVERY_MAP] >>
-    REWRITE_TAC[Once (GSYM APPEND_ASSOC),Once(GSYM rich_listTheory.CONS_APPEND)] >>
-    rpt strip_tac >> res_tac >> full_simp_tac(srw_ss())[] >>
-    rpt (AP_TERM_TAC ORELSE AP_THM_TAC) >> simp[]) >>
-  strip_tac >- (
-    srw_tac[][compile_row_def] >>
-    Cases_on`v`>>full_simp_tac(srw_ss())[pmatch_flat_def] >>
-    qpat_x_assum`X = Match menv`mp_tac >> BasicProvers.CASE_TAC >>
-    BasicProvers.CASE_TAC >>
-    srw_tac[][] >> full_simp_tac(srw_ss())[UNCURRY,LET_THM] >> srw_tac[][] >>
-    qmatch_assum_rename_tac`pmatch s p v [] = Match menv` >>
-    first_x_assum(qspecl_then[`s`,`v`]mp_tac) >> simp[] >>
-    Q.PAT_ABBREV_TAC`tt = compile_row _ X Y` >>
-    `∃bvs1 n f. tt = (bvs1,n,f)` by simp[GSYM EXISTS_PROD] >>
-    qunabbrev_tac`tt` >> simp[] >> srw_tac[][] >> simp[] >>
-    Q.PAT_ABBREV_TAC`w = patSem$Loc _` >>
-    qexists_tac`menv4++[w]` >>
-    simp[GSYM rich_listTheory.ZIP_APPEND,rich_listTheory.FILTER_APPEND] >>
-    conj_tac >- fs [Abbr`w`, compile_v_NoRun_v, NoRun_v_def, ETA_AX, EVERY_MAP] >>
-    REWRITE_TAC[Once (GSYM APPEND_ASSOC)] >>
-    rpt strip_tac >>
-    first_x_assum(fn th => first_assum(strip_assume_tac o MATCH_MP (ONCE_REWRITE_RULE[GSYM AND_IMP_INTRO]th))) >>
-    rev_full_simp_tac(srw_ss())[] >>
-    match_mp_tac sLet_correct >>
-    simp[patSemTheory.evaluate_def] >>
-    simp[patSemTheory.do_app_def] >> simp[Abbr`w`] >>
-    full_simp_tac(srw_ss())[store_lookup_def] >>
-    simp[EL_MAP] ) >>
-  strip_tac >- srw_tac[][] >>
-  strip_tac >- srw_tac[][] >>
-  strip_tac >- (
-    srw_tac[][compile_row_def] >>
-    imp_res_tac flatPropsTheory.pmatch_list_pairwise >>
-    imp_res_tac EVERY2_LENGTH >>
-    full_simp_tac(srw_ss())[LENGTH_NIL,pmatch_flat_def] ) >>
-  srw_tac[][compile_row_def] >>
-  `∃bvsk1 nk1 f1. compile_row (t § 1) (NONE::(bvsk++[NONE]++bvs0)) p = (bvsk1,nk1,f1)` by
-    simp[GSYM EXISTS_PROD] >> full_simp_tac(srw_ss())[LET_THM] >>
-  `∃bvs n fs. compile_cols (t § 2) bvsk1 (LENGTH bvsk + 1 + nk1) (LENGTH qs + 1) ps = (bvs,n,fs)` by
-    simp[GSYM EXISTS_PROD] >> full_simp_tac(srw_ss())[] >>
-  srw_tac[][] >>
-  Cases_on`DROP (LENGTH qs) vs`>>full_simp_tac(srw_ss())[pmatch_flat_def] >>
-  qmatch_assum_rename_tac`DROP (LENGTH qs) vs = v::ws` >>
-  Cases_on`pmatch s p v []`>>full_simp_tac(srw_ss())[] >>
-  first_x_assum(qspecl_then[`s`,`v`]mp_tac) >> simp[] >>
-  strip_tac >> srw_tac[][] >>
-  first_x_assum(qspecl_then[`tag`,`s`,`qs++[p]`,`vs`]mp_tac) >>
-  Cases_on`LENGTH vs = LENGTH qs`>>full_simp_tac(srw_ss())[rich_listTheory.DROP_LENGTH_NIL_rwt] >>
-  `LENGTH qs < LENGTH vs` by simp[] >>
-  full_simp_tac(srw_ss())[rich_listTheory.DROP_EL_CONS] >>
-  simp[rich_listTheory.TAKE_EL_SNOC,Once(GSYM SNOC_APPEND)] >>
-  simp[flatPropsTheory.pmatch_list_snoc] >>
-  imp_res_tac (CONJUNCT1 flatPropsTheory.pmatch_any_match) >>
-  pop_assum(qspec_then`menvk`strip_assume_tac) >> simp[] >>
-  BasicProvers.VAR_EQ_TAC >>
-  imp_res_tac (CONJUNCT2 flatPropsTheory.pmatch_any_match) >>
-  rpt(pop_assum(qspec_then`[]`mp_tac)) >>
-  ntac 2 strip_tac >> simp[] >>
-  disch_then(qspec_then`bvs0`mp_tac o CONV_RULE (RESORT_FORALL_CONV List.rev)) >>
-  simp[] >>
-  qmatch_assum_rename_tac`FILTER _ (ZIP(bvs2,menv4)) = MAP _ env2` >>
-  disch_then(qspec_then`menv4 ++ menv4k`mp_tac) >>
-  simp[rich_listTheory.FILTER_APPEND,GSYM(rich_listTheory.ZIP_APPEND)] >>
-  impl_tac >- (
-    qpat_x_assum`pmatch s p v menvk = X`mp_tac >>
-    simp[Once (CONJUNCT1 flatPropsTheory.pmatch_nil)] >>
-    REWRITE_TAC[GSYM MAP_APPEND] >> PROVE_TAC[] ) >>
-  srw_tac[][] >> srw_tac[][] >> simp[] >>
-  qmatch_assum_rename_tac`LENGTH bvs3 = LENGTH menv3` >>
-  qexists_tac`menv3 ++ menv4` >> simp[] >>
-  simp[rich_listTheory.FILTER_APPEND,GSYM(rich_listTheory.ZIP_APPEND)] >>
-  conj_tac >- (
-    qpat_x_assum`pmatch_list s ps ww env2 = X`mp_tac >>
-    simp[Once (CONJUNCT2 flatPropsTheory.pmatch_nil)] >>
-    REWRITE_TAC[GSYM MAP_APPEND] >> PROVE_TAC[] ) >>
-  srw_tac[][] >>
-  match_mp_tac sLet_correct >>
-  simp[patSemTheory.evaluate_def] >>
-  simp[patSemTheory.do_app_def] >>
-  simp[rich_listTheory.EL_APPEND2,rich_listTheory.EL_APPEND1] >>
-  simp[EL_MAP]);
-
-(* value relation *)
-
-val bind_def = Define`
-  (bind V 0 0 ⇔ T) ∧
-  (bind V (SUC n1) (SUC n2) ⇔ V n1 n2) ∧
-  (bind V _ _ ⇔ F)`
-
-Theorem bind_mono:
-   (∀x y. V1 x y ⇒ V2 x y) ⇒ bind V1 x y ⇒ bind V2 x y
-Proof
-  Cases_on`x`>>Cases_on`y`>>srw_tac[][bind_def]
-QED
-val _ = export_mono"bind_mono"
-
-val bindn_def = Define`bindn = FUNPOW bind`
-
-Theorem bind_thm:
-   ∀V x y. bind V x y =
-      if x = 0 then y = 0 else
-      if y = 0 then x = 0 else
-      V (x-1) (y-1)
-Proof
-  gen_tac >> Cases >> Cases >> srw_tac[][bind_def]
-QED
-
-Theorem bindn_mono:
-   (∀x y. R1 x y ⇒ R2 x y) ⇒
-    bindn n R1 x y ⇒ bindn n R2 x y
-Proof
-  srw_tac[][bindn_def] >>
-  match_mp_tac (MP_CANON FUNPOW_mono) >>
-  simp[] >> metis_tac[bind_mono]
-QED
-val _ = export_mono"bindn_mono"
-
-Theorem bindn_thm:
-   ∀n k1 k2.
-    bindn n R k1 k2 ⇔
-    if k1 < n ∧ k2 < n then k1 = k2
-    else n ≤ k1 ∧ n ≤ k2 ∧ R (k1-n) (k2-n)
-Proof
-  Induct>>simp[bindn_def,arithmeticTheory.FUNPOW_SUC] >>
-  Cases>>Cases>>simp[bind_def,GSYM bindn_def]
-QED
-
-Inductive exp_rel:
-  (exp_rel z1 z2 V e1 e2
-   ⇒ exp_rel z1 z2 V (Raise t e1) (Raise t e2)) ∧
-  (exp_rel z1 z2 V e11 e21 ∧ exp_rel (z1+1) (z2+1) (bind V) e12 e22
-   ⇒ exp_rel z1 z2 V (Handle t e11 e12) (Handle t e21 e22)) ∧
-  (exp_rel z1 z2 V (Lit t l) (Lit t l)) ∧
-  (LIST_REL (exp_rel z1 z2 V) es1 es2
-   ⇒ exp_rel z1 z2 V (Con t tag es1) (Con t tag es2)) ∧
-  ((k1 < z1 ∧ k2 < z2 ∧ V k1 k2) ∨ (z1 ≤ k1 ∧ z2 ≤ k2 ∧ (k1 = k2))
-   ⇒ exp_rel z1 z2 V (Var_local t k1) (Var_local t k2)) ∧
-  (exp_rel (z1+1) (z2+1) (bind V) e1 e2
-   ⇒ exp_rel z1 z2 V (Fun t e1) (Fun t e2)) ∧
-  (LIST_REL (exp_rel z1 z2 V) es1 es2
-   ⇒ exp_rel z1 z2 V (App t op es1) (App t op es2)) ∧
-  (exp_rel z1 z2 V e11 e21 ∧ exp_rel z1 z2 V e12 e22 ∧ exp_rel z1 z2 V e13 e23
-   ⇒ exp_rel z1 z2 V (If t e11 e12 e13) (If t e21 e22 e23)) ∧
-  (exp_rel z1 z2 V e11 e21 ∧ exp_rel (z1+1) (z2+1) (bind V) e12 e22
-   ⇒ exp_rel z1 z2 V (Let t e11 e12) (Let t e21 e22)) ∧
-  (exp_rel z1 z2 V e11 e21 ∧ exp_rel z1 z2 V e12 e22
-   ⇒ exp_rel z1 z2 V (Seq t e11 e12) (Seq t e21 e22)) ∧
-  (LIST_REL (exp_rel (z1+(SUC(LENGTH es1))) (z2+(SUC(LENGTH es2))) (bindn (SUC (LENGTH es1)) V)) es1 es2 ∧
-   exp_rel (z1+(LENGTH es1)) (z2+(LENGTH es2)) (bindn (LENGTH es1) V) e1 e2
-   ⇒ exp_rel z1 z2 V (Letrec t es1 e1) (Letrec t es2 e2))
-End
-
-Theorem exp_rel_refl:
-   (∀e z V. (∀k. k < z ⇒ V k k) ⇒ exp_rel z z V e e) ∧
-    (∀es z V. (∀k. k < z ⇒ V k k) ⇒ LIST_REL (exp_rel z z V) es es)
-Proof
-  ho_match_mp_tac(TypeBase.induction_of``:patLang$exp``) >> srw_tac[][] >>
-  TRY (first_x_assum match_mp_tac) >>
-  srw_tac[][Once exp_rel_cases] >>
-  TRY (first_x_assum match_mp_tac) >>
-  TRY (metis_tac[]) >>
-  TRY (Cases>>simp[bind_def]>>NO_TAC) >>
-  TRY (Cases_on`n < z` >>simp[] >> NO_TAC) >>
-  srw_tac[][bindn_thm] >>
-  Cases_on`k < SUC (LENGTH es)` >> simp[] >>
-  Cases_on`k < LENGTH es` >> simp[]
-QED
-
-Theorem exp_rel_mono:
-   (∀x y. V1 x y ⇒ V2 x y) ⇒
-    exp_rel z1 z2 V1 e1 e2 ⇒
-    exp_rel z1 z2 V2 e1 e2
-Proof
-  strip_tac >> strip_tac >> last_x_assum mp_tac >>
-  qid_spec_tac`V2` >> pop_assum mp_tac >>
-  map_every qid_spec_tac[`e2`,`e1`,`V1`,`z2`,`z1`] >>
-  ho_match_mp_tac exp_rel_ind >>
-  strip_tac >- ( srw_tac[][] >> srw_tac[][Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >>
-    srw_tac[][Once exp_rel_cases] >>
-    first_x_assum match_mp_tac >>
-    match_mp_tac bind_mono >> srw_tac[][] ) >>
-  strip_tac >- ( srw_tac[][] >> srw_tac[][Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >> srw_tac[][Once exp_rel_cases] >>
-    match_mp_tac (MP_CANON (GEN_ALL EVERY2_mono)) >>
-    HINT_EXISTS_TAC >> simp[] ) >>
-  strip_tac >- ( srw_tac[][] >> srw_tac[][Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >> srw_tac[][Once exp_rel_cases] >>
-    first_x_assum match_mp_tac >>
-    match_mp_tac bind_mono >> srw_tac[][] ) >>
-  strip_tac >- (
-    srw_tac[][] >> srw_tac[][Once exp_rel_cases] >>
-    match_mp_tac (MP_CANON (GEN_ALL EVERY2_mono)) >>
-    HINT_EXISTS_TAC >> simp[] ) >>
-  strip_tac >- ( srw_tac[][] >> srw_tac[][Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >> srw_tac[][Once exp_rel_cases] >>
-    first_x_assum match_mp_tac >>
-    match_mp_tac bind_mono >> srw_tac[][] ) >>
-  strip_tac >- ( srw_tac[][] >> srw_tac[][Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >> srw_tac[][Once exp_rel_cases] >> TRY (
-      match_mp_tac (MP_CANON (GEN_ALL EVERY2_mono)) >>
-      HINT_EXISTS_TAC >> simp[] >> srw_tac[][] >>
-      first_x_assum match_mp_tac >>
-      match_mp_tac bindn_mono >>
-      simp[] ) >>
-    first_x_assum match_mp_tac >>
-    match_mp_tac bindn_mono >>
-    simp[] )
-QED
-val _ = export_mono"exp_rel_mono";
-
-Theorem exp_rel_lit:
-   (exp_rel z1 z2 V (Lit t l) e2 ⇔ (e2 = Lit t l)) ∧
-    (exp_rel z1 z2 V e1 (Lit t l) ⇔ (e1 = Lit t l)) ∧
-    (exp_rel z1 z2 V (Bool t b) e2 ⇔ (e2 = Bool t b)) ∧
-    (exp_rel z1 z2 V e1 (Bool t b) ⇔ (e1 = Bool t b))
-Proof
-  srw_tac[][Once exp_rel_cases] >>
-  srw_tac[][Once exp_rel_cases,Bool_def]
-QED
-val _ = export_rewrites["exp_rel_lit"];
-
-Theorem bind_O:
-   ∀R1 R2. bind (R2 O R1) = bind R2 O bind R1
-Proof
-  srw_tac[][] >> simp[FUN_EQ_THM] >>
-  simp[relationTheory.O_DEF] >>
-  srw_tac[][bind_thm,relationTheory.O_DEF,EQ_IMP_THM] >> rev_full_simp_tac(srw_ss())[] >- (
-    qexists_tac`SUC y` >> simp[] ) >>
-  qexists_tac`y-1` >> simp[]
-QED
-val _ = export_rewrites["bind_O"];
-
-Theorem bindn_O:
-   ∀R1 R2 n. bindn n (R2 O R1) = bindn n R2 O bindn n R1
-Proof
-  srw_tac[][FUN_EQ_THM,bindn_thm,relationTheory.O_DEF] >>
-  srw_tac[][EQ_IMP_THM] >> simp[] >> fsrw_tac[ARITH_ss][] >>
-  rev_full_simp_tac(srw_ss()++ARITH_ss)[]>>fsrw_tac[ARITH_ss][]
-  >- (qexists_tac`y+n` >> simp[]) >>
-  (qexists_tac`y-n` >> simp[])
-QED
-val _ = export_rewrites["bindn_O"];
-
-val exp_rel_trans = Q.prove(
-  `∀z1 z2 V1 e1 e2. exp_rel z1 z2 V1 e1 e2 ⇒
-      ∀z3 V2 e3. exp_rel z2 z3 V2 e2 e3 ⇒ exp_rel z1 z3 (V2 O V1) e1 e3`,
-   ho_match_mp_tac (theorem"exp_rel_strongind") >>
-   strip_tac >- ( srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) ) >>
-   strip_tac >- ( srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) ) >>
-   strip_tac >- ( srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) ) >>
-   strip_tac >- (
-     srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) >>
-     rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-     full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS,MEM_EL] ) >>
-   strip_tac >- (
-     srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) >>
-     simp[relationTheory.O_DEF] >> metis_tac[]) >>
-   strip_tac >- ( srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) ) >>
-   strip_tac >- (
-     srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) >>
-     rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-     full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS,MEM_EL] ) >>
-   strip_tac >- ( srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) ) >>
-   strip_tac >- ( srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) ) >>
-   strip_tac >- ( srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) ) >>
-   strip_tac >- (
-     srw_tac[][] >> pop_assum mp_tac >> ntac 2 (srw_tac[][Once exp_rel_cases]) >>
-     rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-     full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS,MEM_EL] ) )
-Theorem exp_rel_trans:
-   ∀z1 z2 z3 V1 V2 V3 e1 e2 e3.
-      exp_rel z1 z2 V1 e1 e2 ∧
-      exp_rel z2 z3 V2 e2 e3 ∧
-      (V3 = V2 O V1) ⇒
-      exp_rel z1 z3 V3 e1 e3
-Proof
-  metis_tac[exp_rel_trans]
-QED
-
-val env_rel_def = Define`
-  env_rel R env1 env2 k1 k2 ⇔
-    k1 < LENGTH env1 ∧ k2 < LENGTH env2 ∧ R (EL k1 env1) (EL k2 env2)`
-
-Theorem env_rel_mono:
-   (∀x y. R1 x y ⇒ R2 x y) ⇒
-    env_rel R1 env1 env2 k1 k2 ⇒
-    env_rel R2 env1 env2 k1 k2
-Proof
-  srw_tac[][env_rel_def]
-QED
-val _ = export_mono"env_rel_mono";
-
-val env_rel_cons = Q.prove(
-  `R v1 v2 ∧
-    bind (env_rel R env1 env2) k1 k2
-    ⇒ env_rel R (v1::env1) (v2::env2) k1 k2`,
-  Cases_on`k1`>>Cases_on`k2`>>srw_tac[][env_rel_def,bind_def])
-
-Inductive v_rel:
-  (v_rel (Litv l) (Litv l)) ∧
-  (LIST_REL v_rel vs1 vs2
-   ⇒ v_rel (Conv tag vs1) (Conv tag vs2)) ∧
-  (exp_rel (SUC(LENGTH env1)) (SUC(LENGTH env2))
-    (bind (env_rel v_rel env1 env2)) exp1 exp2 /\
-    (EVERY NoRun_v env1 <=> EVERY NoRun_v env2)
-   ⇒ v_rel (Closure env1 exp1) (Closure env2 exp2)) ∧
-  (LIST_REL (exp_rel (SUC(LENGTH funs1)+LENGTH env1) (SUC(LENGTH funs2)+LENGTH env2)
-              (bindn (SUC (LENGTH funs1)) (env_rel v_rel env1 env2)))
-            funs1 funs2 /\
-   (EVERY NoRun_v env1 <=> EVERY NoRun_v env2)
-   ⇒ v_rel (Recclosure env1 funs1 n) (Recclosure env2 funs2 n)) ∧
-  (v_rel (Loc n) (Loc n)) ∧
-  (LIST_REL v_rel vs1 vs2
-   ⇒ v_rel (Vectorv vs1) (Vectorv vs2))
-End
-
-Theorem v_rel_lit:
-   (v_rel (Litv l) v2 ⇔ (v2 = Litv l)) ∧
-    (v_rel v1 (Litv l) ⇔ (v1 = Litv l)) ∧
-    (v_rel (Boolv b) v2 ⇔ (v2 = Boolv b)) ∧
-    (v_rel v1 (Boolv b) ⇔ (v1 = Boolv b))
-Proof
-  srw_tac[][Once v_rel_cases] >> srw_tac[][Once v_rel_cases,patSemTheory.Boolv_def]
-QED
-val _ = export_rewrites["v_rel_lit"]
-
-Theorem v_rel_loc:
-   (v_rel (Loc l) v2 ⇔ (v2 = Loc l)) ∧
-    (v_rel v1 (Loc l) ⇔ (v1 = Loc l))
-Proof
-  srw_tac[][Once v_rel_cases] >> srw_tac[][Once v_rel_cases]
-QED
-val _ = export_rewrites["v_rel_loc"]
-
-Theorem v_rel_refl:
-   ∀v. v_rel v v
-Proof
-  qsuff_tac`(∀v. v_rel v v) ∧ (∀vs. LIST_REL v_rel vs vs)`>-srw_tac[][]>>
-  ho_match_mp_tac(TypeBase.induction_of``:patSem$v``)>>
-  srw_tac[][] >> srw_tac[][Once v_rel_cases] >>
-  TRY (
-    match_mp_tac (CONJUNCT1 exp_rel_refl) >>
-    Cases>>simp[bind_def,env_rel_def]>>
-    full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM,MEM_ZIP,PULL_EXISTS] ) >>
-  match_mp_tac (CONJUNCT2 exp_rel_refl) >>
-  simp[bindn_thm] >> srw_tac[][env_rel_def] >>
-  qmatch_assum_rename_tac`k < LENGTH vs + SUC (LENGTH ls)` >>
-  Cases_on`k < SUC (LENGTH ls)`>>simp[] >>
-  full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM,MEM_ZIP,PULL_EXISTS] >>
-  simp[]
-QED
-val _ = export_rewrites["v_rel_refl"]
-
-Theorem v_rel_trans:
-   ∀v1 v2. v_rel v1 v2 ⇒ ∀v3. v_rel v2 v3 ⇒ v_rel v1 v3
-Proof
-  ho_match_mp_tac (theorem"v_rel_strongind") >> simp[] >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    simp[Once v_rel_cases,PULL_EXISTS] >>
-    rpt gen_tac >> strip_tac >>
-    simp[Once v_rel_cases,PULL_EXISTS] >>
-    match_mp_tac LIST_REL_trans >>
-    qexists_tac`vs2` >> simp[] >>
-    rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-    full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS,MEM_EL] ) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    simp[Once v_rel_cases,PULL_EXISTS] >> srw_tac[][] >>
-    simp[Once v_rel_cases,PULL_EXISTS] >>
-    qmatch_assum_abbrev_tac`exp_rel z1 z2 V1 exp1 exp2` >>
-    qmatch_assum_abbrev_tac`exp_rel z2 z3 V2 exp2 exp3` >>
-    match_mp_tac (MP_CANON (GEN_ALL exp_rel_mono)) >>
-    qexists_tac`V2 O V1` >>
-    conj_tac >- (
-      simp[relationTheory.O_DEF,Abbr`V1`,Abbr`V2`] >>
-      simp[bind_thm,env_rel_def] >>
-      srw_tac[][] >> fsrw_tac[ARITH_ss][] >> rev_full_simp_tac(srw_ss())[] ) >>
-    match_mp_tac exp_rel_trans >>
-    metis_tac[] ) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    simp[Once v_rel_cases,PULL_EXISTS] >> srw_tac[][] >>
-    simp[Once v_rel_cases,PULL_EXISTS] >>
-    rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-    full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS,MEM_EL] >> srw_tac[][] >>
-    res_tac >>
-    qmatch_assum_abbrev_tac`exp_rel z1 z2 V1 exp1 exp2` >>
-    qmatch_assum_abbrev_tac`exp_rel z2 z3 V2 exp2 exp3` >>
-    match_mp_tac (MP_CANON (GEN_ALL exp_rel_mono)) >>
-    qexists_tac`V2 O V1` >>
-    conj_tac >- (
-      simp[relationTheory.O_DEF,Abbr`V1`,Abbr`V2`] >>
-      simp[bindn_thm,env_rel_def] >>
-      simp[arithmeticTheory.ADD1] >>
-      srw_tac[][] >> fsrw_tac[ARITH_ss][] >>
-      rev_full_simp_tac(srw_ss()++ARITH_ss)[] >>
-      fsrw_tac[ARITH_ss][] ) >>
-    metis_tac[exp_rel_trans]) >>
-  rpt gen_tac >> strip_tac >>
-  simp[Once v_rel_cases,PULL_EXISTS] >>
-  rpt gen_tac >> strip_tac >>
-  simp[Once v_rel_cases,PULL_EXISTS] >>
-  match_mp_tac LIST_REL_trans >>
-  qexists_tac`vs2` >> simp[] >>
-  rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-  full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS,MEM_EL]
-QED
-
-Theorem bind_inv:
-   ∀V. bind (inv V) = inv (bind V)
-Proof
-  srw_tac[][FUN_EQ_THM,bind_thm,relationTheory.inv_DEF] >>
-  srw_tac[][]
-QED
-val _ = export_rewrites["bind_inv"]
-
-Theorem bindn_inv:
-   ∀V n. bindn n (inv V) = inv (bindn n V)
-Proof
-  srw_tac[][FUN_EQ_THM,bindn_thm,relationTheory.inv_DEF] >>
-  srw_tac[][] >> simp[] >> full_simp_tac(srw_ss())[] >> simp[]
-QED
-val _ = export_rewrites["bindn_inv"]
-
-Theorem exp_rel_sym:
-   ∀z1 z2 V e1 e2. exp_rel z1 z2 V e1 e2 ⇒ exp_rel z2 z1 (inv V) e2 e1
-Proof
-  ho_match_mp_tac exp_rel_ind >> srw_tac[][] >>
-  simp[Once exp_rel_cases] >>
-  rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-  full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS,relationTheory.inv_DEF]
-QED
-
-Theorem v_rel_sym:
-   ∀v1 v2. v_rel v1 v2 ⇒ v_rel v2 v1
-Proof
-  ho_match_mp_tac v_rel_ind >> srw_tac[][] >>
-  simp[Once v_rel_cases] >>
-  full_simp_tac(srw_ss())[LIST_REL_EL_EQN] >> srw_tac[][] >> rev_full_simp_tac(srw_ss())[] >>
-  TRY(first_x_assum(fn th => first_x_assum(strip_assume_tac o MATCH_MP th))) >>
-  first_x_assum (strip_assume_tac o MATCH_MP exp_rel_sym) >>
-  match_mp_tac (MP_CANON (GEN_ALL exp_rel_mono)) >>
-  fsrw_tac[ARITH_ss][] >>
-  HINT_EXISTS_TAC >>
-  simp[relationTheory.inv_DEF,bind_thm,bindn_thm] >>
-  srw_tac[][] >> fsrw_tac[ARITH_ss][env_rel_def]
-QED
-
-val state_rel_def = Define`
-  state_rel (s1: ('c,'ffi) patSem$state) (s2: ('c,'ffi) patSem$state) ⇔
-    s1.clock = s2.clock ∧
-    LIST_REL (sv_rel v_rel) s1.refs s2.refs ∧
-    s1.ffi = s2.ffi ∧
-    LIST_REL (OPTREL v_rel) s1.globals s2.globals`;
-
-val state_rel_clock = Q.prove(
-  `state_rel s1 s2 ⇒ s1.clock = s2.clock`,
-  srw_tac[][state_rel_def])
-
-val state_rel_dec_clock = Q.prove(
-  `state_rel s s2 ⇒ state_rel (dec_clock s) (dec_clock s2)`,
-  srw_tac[][state_rel_def,patSemTheory.dec_clock_def])
-
-Theorem state_rel_refl[simp]:
-   state_rel s s
-Proof
-  srw_tac[][state_rel_def] >> match_mp_tac EVERY2_refl >> srw_tac[][]
-QED
-
-val result_rel_v_v_rel_trans =
-  result_rel_trans
-  |> Q.GENL[`R1`,`R2`]
-  |> Q.ISPECL[`v_rel`,`v_rel`]
-  |> UNDISCH_ALL
-  |> prove_hyps_by(metis_tac[v_rel_trans])
-
-val LIST_REL_v_rel_trans =
-  LIST_REL_trans
-  |> Q.GEN`R`
-  |> Q.ISPEC`v_rel`
-  |> SPEC_ALL
-  |> SIMP_RULE (srw_ss())[GSYM AND_IMP_INTRO]
-  |> UNDISCH
-  |> prove_hyps_by(metis_tac[v_rel_trans])
-  |> SIMP_RULE std_ss [AND_IMP_INTRO]
-  |> Q.GENL[`l1`,`l2`,`l3`]
-
-val LIST_REL_OPTREL_v_rel_trans =
-  LIST_REL_trans
-  |> Q.GEN`R`
-  |> Q.ISPEC`OPTREL v_rel`
-  |> SPEC_ALL
-  |> SIMP_RULE (srw_ss())[GSYM AND_IMP_INTRO]
-  |> UNDISCH
-  |> prove_hyps_by(metis_tac[OPTREL_trans,v_rel_trans])
-  |> SIMP_RULE std_ss [AND_IMP_INTRO]
-  |> Q.GENL[`l1`,`l2`,`l3`]
-
-val LIST_REL_sv_rel_trans =
-  LIST_REL_trans
-  |> Q.GEN`R`
-  |> Q.ISPEC`sv_rel v_rel`
-  |> SPEC_ALL
-  |> SIMP_RULE (srw_ss())[GSYM AND_IMP_INTRO]
-  |> UNDISCH
-  |> prove_hyps_by(metis_tac[sv_rel_trans,v_rel_trans])
-  |> SIMP_RULE std_ss [AND_IMP_INTRO]
-  |> Q.GENL[`l1`,`l2`,`l3`]
-
-val result_rel_LIST_v_v_rel_trans =
-  result_rel_trans
-  |> Q.GENL[`R1`,`R2`]
-  |> Q.ISPECL[`LIST_REL v_rel`,`v_rel`]
-  |> UNDISCH_ALL
-  |> prove_hyps_by(metis_tac[LIST_REL_v_rel_trans,v_rel_trans])
-
-val exc_rel_v_rel_trans =
-  exc_rel_trans
-  |> Q.GEN`R`
-  |> Q.ISPEC`v_rel`
-  |> UNDISCH
-  |> prove_hyps_by(metis_tac[v_rel_trans])
-
-val state_rel_trans = Q.prove(
-  `state_rel s1 s2 ∧ state_rel s2 s3 ⇒ state_rel s1 s3`,
-  srw_tac[][state_rel_def] >>
-  metis_tac[LIST_REL_sv_rel_trans,LIST_REL_OPTREL_v_rel_trans]);
-
-(* semantic functions respect relation *)
-
-val do_eq_def = patSemTheory.do_eq_def
-
-Theorem do_eq_v_rel:
-   ∀v1 v2. v_rel v1 v2 ⇒ ∀v3 v4. v_rel v3 v4 ⇒ do_eq v1 v3 = do_eq v2 v4
-Proof
-  ho_match_mp_tac v_rel_ind >>
-  simp[do_eq_def] >> srw_tac[][] >>
-  Cases_on`v3`>>Cases_on`v4`>>full_simp_tac(srw_ss())[do_eq_def] >>
-  pop_assum mp_tac >> simp[Once v_rel_cases] >> srw_tac[][] >>
-  imp_res_tac EVERY2_LENGTH >> full_simp_tac(srw_ss())[] >> srw_tac[][] >>
-  ntac 2 (pop_assum kall_tac) >>
-  qmatch_assum_rename_tac`LIST_REL v_rel l1 l2` >>
-  ntac 3 (pop_assum mp_tac) >>
-  map_every qid_spec_tac[`l2`,`l1`,`vs2`,`vs1`] >>
-  Induct >> simp[PULL_EXISTS] >>
-  Cases_on`l1`>>Cases_on`l2`>>simp[do_eq_def] >>
-  srw_tac[][] >>
-  BasicProvers.CASE_TAC >> srw_tac[][] >>
-  BasicProvers.CASE_TAC >> srw_tac[][] >>
-  res_tac >> full_simp_tac(srw_ss())[]
-QED
-
-Theorem do_eq_list_v_rel:
-   ∀v1 v2 v3 v4. LIST_REL v_rel v1 v2 ∧ LIST_REL v_rel v3 v4 ⇒ do_eq_list v1 v3 = do_eq_list v2 v4
-Proof
-  Induct \\ simp[do_eq_def] \\ Cases_on`v3` \\ simp[do_eq_def,PULL_EXISTS] \\ rw[]
-  \\ imp_res_tac do_eq_v_rel \\ fs[]
-  \\ CASE_TAC \\ fs[] \\ CASE_TAC \\ fs[]
-QED
-
-Theorem do_opapp_v_rel:
-   ∀vs vs'.
-    LIST_REL v_rel vs vs' ⇒
-    OPTION_REL
-      (λ(env1,e1) (env2,e2).
-        exp_rel (LENGTH env1) (LENGTH env2) (env_rel v_rel env1 env2) e1 e2)
-      (do_opapp vs)
-      (do_opapp vs')
-Proof
-  srw_tac[][patSemTheory.do_opapp_def] >>
-  BasicProvers.CASE_TAC >> full_simp_tac(srw_ss())[quotient_optionTheory.OPTION_REL_def] >> srw_tac[][] >>
-  Cases_on`t`>>full_simp_tac(srw_ss())[quotient_optionTheory.OPTION_REL_def] >> srw_tac[][] >>
-  Cases_on`t'`>>full_simp_tac(srw_ss())[quotient_optionTheory.OPTION_REL_def] >> srw_tac[][] >>
-  Cases_on`h`>>full_simp_tac(srw_ss())[quotient_optionTheory.OPTION_REL_def] >>
-  last_x_assum mp_tac >>
-  simp[Once v_rel_cases] >> srw_tac[][] >>
-  srw_tac[][quotient_optionTheory.OPTION_REL_def] >>
-  TRY (imp_res_tac LIST_REL_LENGTH >> full_simp_tac(srw_ss())[] >> NO_TAC) >>
-  rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-  full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS] >>
-  match_mp_tac (MP_CANON (GEN_ALL exp_rel_mono)) >>
-  simp[patSemTheory.build_rec_env_def] >> res_tac >>
-  fsrw_tac[ARITH_ss][arithmeticTheory.ADD1] >>
-  qmatch_assum_abbrev_tac`exp_rel z1 z2 V e1 e2` >>
-  qexists_tac`V` >>
-  simp[Abbr`V`,bindn_thm,bind_thm,env_rel_def] >>
-  TRY (
-    Cases >> Cases >> simp[] >>
-    unabbrev_all_tac >> simp[] >> NO_TAC) >>
-  Cases >> Cases >> srw_tac[][env_rel_def] >> fsrw_tac[ARITH_ss][arithmeticTheory.ADD1] >>
-  simp[rich_listTheory.EL_APPEND1,rich_listTheory.EL_APPEND2] >>
-  simp[Once v_rel_cases] >>
-  rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-  full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS,arithmeticTheory.ADD1,Abbr`z1`,Abbr`z2`] >>
-  simp[]
-QED
-
-val v_to_list_SOME = Q.prove(
-  `∀v ls.
-    v_to_list v = SOME ls ⇒
-         (v = Conv nil_tag []) ∨
-         (∃v1 v2 t.
-           v = Conv cons_tag [v1;v2] ∧
-           v_to_list v2 = SOME t ∧
-           ls = v1::t)`,
-  ho_match_mp_tac patSemTheory.v_to_list_ind >>
-  simp[patSemTheory.v_to_list_def] >> srw_tac[][] >>
-  BasicProvers.EVERY_CASE_TAC >> full_simp_tac(srw_ss())[])
-
-val v_to_list_v_rel = Q.prove(
-  `∀l1 l2 l3.
-    v_rel l1 l2 ∧ v_to_list l1 = SOME l3 ⇒
-    ∃l4. v_to_list l2 = SOME l4 ∧
-         LIST_REL v_rel l3 l4`,
-  ho_match_mp_tac patSemTheory.v_to_list_ind >>
-  simp[patSemTheory.v_to_list_def] >> srw_tac[][] >- (
-    full_simp_tac(srw_ss())[Once v_rel_cases]>>
-    simp[patSemTheory.v_to_list_def] ) >>
-  last_x_assum mp_tac >>
-  simp[Once v_rel_cases] >> srw_tac[][] >>
-  simp[patSemTheory.v_to_list_def] >>
-  last_x_assum mp_tac >>
-  BasicProvers.CASE_TAC >> srw_tac[][] >>
-  res_tac >> simp[])
-
-val v_to_list_v_rel_none = Q.prove(
-  `∀l1 l2.
-    v_rel l1 l2 ∧ v_to_list l1 = NONE ⇒
-    v_to_list l2 = NONE`,
-  ho_match_mp_tac patSemTheory.v_to_list_ind >>
-  simp[patSemTheory.v_to_list_def] >> srw_tac[][] >>
-  qpat_x_assum`v_rel _ _`mp_tac >>
-  simp[Once v_rel_cases,patSemTheory.v_to_list_def] >>
-  strip_tac \\ fs[patSemTheory.v_to_list_def] >>
-  rw[] >> every_case_tac >> fs[] >>
-  res_tac >> fs[]);
-
-val v_to_char_list_v_rel = Q.prove(
-  `∀l1 l2 l3.
-    v_rel l1 l2 ∧ v_to_char_list l1 = SOME l3 ⇒
-    v_to_char_list l2 = SOME l3`,
-  ho_match_mp_tac patSemTheory.v_to_char_list_ind >>
-  simp[patSemTheory.v_to_char_list_def] >> srw_tac[][] >- (
-    full_simp_tac(srw_ss())[Once v_rel_cases]>>
-    simp[patSemTheory.v_to_char_list_def] ) >>
-  last_x_assum mp_tac >>
-  simp[Once v_rel_cases] >> srw_tac[][] >>
-  simp[patSemTheory.v_to_char_list_def] >>
-  last_x_assum mp_tac >>
-  BasicProvers.CASE_TAC >> srw_tac[][] >>
-  res_tac >> simp[])
-
-val v_to_char_list_v_rel_none = Q.prove(
-  `∀l1 l2.
-    v_rel l1 l2 ∧ v_to_char_list l1 = NONE ⇒
-    v_to_char_list l2 = NONE`,
-  ho_match_mp_tac patSemTheory.v_to_char_list_ind >>
-  simp[patSemTheory.v_to_char_list_def] >> srw_tac[][] >>
-  qpat_x_assum`v_rel _ _`mp_tac >>
-  simp[Once v_rel_cases,patSemTheory.v_to_char_list_def] >>
-  strip_tac \\ fs[patSemTheory.v_to_char_list_def] >>
-  rw[] >> every_case_tac >> fs[] >>
-  res_tac >> fs[] >> fs[Once v_rel_cases] >>
-  fs[patSemTheory.v_to_char_list_def]);
-
-val vs_to_string_v_rel = Q.prove(
-  `∀l1 l2.
-    LIST_REL v_rel l1 l2 ⇒
-    vs_to_string l2 = vs_to_string l1`,
-  ho_match_mp_tac patSemTheory.vs_to_string_ind
-  \\ rw[patSemTheory.vs_to_string_def,flatSemTheory.vs_to_string_def]
-  \\ fs[v_rel_cases]
-  \\ rw[patSemTheory.vs_to_string_def,flatSemTheory.vs_to_string_def]);
-
-val do_app_def = patSemTheory.do_app_def
-
-local
-  val ty =
-    ``patSem$evaluate`` |> type_of |> strip_fun |> #1 |> el 2
-    |> type_subst[alpha|->gamma,beta|->``:'ffi``]
-in
-  val s1 = mk_var("s1",ty)
-  val s = mk_var("s",ty)
-end
-
-Theorem list_to_v_v_rel:
-   !xs ys. LIST_REL v_rel xs ys ==> v_rel (list_to_v xs) (list_to_v ys)
-Proof
-  Induct \\ rw [] \\ fs [patSemTheory.list_to_v_def, v_rel_rules]
-QED
-
-Theorem list_to_v_APPEND:
-   !x1 y1 x2 y2.
-     v_rel (list_to_v x1) (list_to_v x2) /\
-     v_rel (list_to_v y1) (list_to_v y2) ==>
-       v_rel (list_to_v (x1 ++ y1)) (list_to_v (x2 ++ y2))
-Proof
-  Induct \\ Induct_on `x2`
-  \\ TRY (rw [v_rel_cases, patSemTheory.list_to_v_def] \\ NO_TAC)
-  \\ rw []
-  \\ fs [patSemTheory.list_to_v_def]
-  \\ ntac 2 (pop_assum mp_tac)
-  \\ simp [Once v_rel_cases] \\ rw []
-  \\ simp [Once v_rel_cases]
-QED
-
-Theorem do_app_v_rel:
-   ∀^s op s' vs vs'.
-      LIST_REL v_rel vs vs' ⇒
-      state_rel s s' ⇒
-      OPTION_REL
-        (λ(s1,res1) (s2,res2).
-          state_rel s1 s2 ∧
-          result_rel v_rel v_rel res1 res2)
-        (do_app s op vs)
-        (do_app s' op vs')
-Proof
-  srw_tac[][] >>
-  srw_tac[][optionTheory.OPTREL_def] >>
-  Cases_on`do_app s op vs`>>srw_tac[][]>-(
-    Cases_on `op = (Op ListAppend)`
-    >-
-     (fs [] \\ rveq
-     \\ pop_assum mp_tac
-     \\ fs [patSemTheory.do_app_def]
-     \\ rpt (PURE_FULL_CASE_TAC \\ fs []) \\ rw []
-     \\ imp_res_tac v_to_list_v_rel_none
-     \\ imp_res_tac v_to_list_v_rel \\ rfs [])
-    \\ qpat_x_assum `do_app _ _ _ = _` (strip_assume_tac o SIMP_RULE std_ss [patSemTheory.do_app_cases_none]) >>
-    rw[] >> fs[v_rel_cases] >>
-    rw[patSemTheory.do_app_def] >>
-    fs[store_alloc_def, store_lookup_def, store_assign_def, state_rel_def, OPTREL_def, do_eq_def] >>
-    imp_res_tac LIST_REL_LENGTH >> fs[] >>
-    fs [patSemTheory.v_to_list_def, patSemTheory.v_to_char_list_def] \\ fs[] >>
-    TRY (
-      fs[LIST_REL_EL_EQN,OPTREL_def]
-      \\ res_tac \\ fs[sv_rel_cases] \\ fs[]
-      \\ NO_TAC ) >>
-    TRY (
-      rename1`v_to_list (Conv tag vs1) = NONE`
-      \\ Cases_on`vs1` \\ fs[patSemTheory.v_to_list_def]
-      \\ rename1`v_to_list (Conv tag (_::vs1))`
-      \\ Cases_on`vs1` \\ fs[patSemTheory.v_to_list_def]
-      \\ rename1`v_to_list (Conv tag (_::_::vs1))`
-      \\ Cases_on`vs1` \\ fs[patSemTheory.v_to_list_def]
-      \\ rveq \\ fs[patSemTheory.v_to_list_def]
-      \\ IF_CASES_TAC \\ fs[]
-      \\ qpat_x_assum`_ = NONE`mp_tac
-      \\ CASE_TAC \\ fs[]
-      \\ imp_res_tac v_to_list_v_rel_none \\ fs[] >> NO_TAC) >>
-    TRY (
-      rename1`v_to_list (Conv tag vs1) = SOME _` >>
-      `v_rel (Conv tag vs1) (Conv tag vs2)`
-      by ( simp[Once v_rel_cases] ) >>
-      imp_res_tac v_to_list_v_rel >> fs[] >>
-      imp_res_tac vs_to_string_v_rel >> fs[] >> NO_TAC) >>
-    TRY (
-      rename1`v_to_list (Conv tag vs1) = SOME _` >>
-      `v_rel (Conv tag vs1) (Conv tag vs2)`
-      by ( simp[Once v_rel_cases] ) >>
-      imp_res_tac v_to_list_v_rel >> fs[] >>
-      imp_res_tac vs_to_string_v_rel >> fs[] >> NO_TAC) >>
-    TRY (
-      rename1`v_to_char_list (Conv tag vs1) = NONE`
-      \\ Cases_on`vs1` \\ fs[patSemTheory.v_to_char_list_def]
-      \\ rename1`v_to_char_list (Conv tag (c::vs1)) = NONE`
-      \\ Cases_on`c` \\ fs[Once v_rel_cases,patSemTheory.v_to_char_list_def]
-      \\ rename1`v_to_char_list (Conv tag (Litv l::vs1))`
-      \\ Cases_on`l` \\ fs[patSemTheory.v_to_char_list_def]
-      \\ Cases_on`vs1` \\ rfs[patSemTheory.v_to_char_list_def]
-      \\ rename1`v_to_char_list (Conv tag (_::_::vs1))`
-      \\ Cases_on`vs1` \\ fs[patSemTheory.v_to_char_list_def]
-      \\ rveq \\ fs[patSemTheory.v_to_char_list_def]
-      \\ IF_CASES_TAC \\ fs[]
-      \\ qpat_x_assum`_ = NONE`mp_tac
-      \\ CASE_TAC \\ fs[]
-      \\ imp_res_tac v_to_char_list_v_rel_none
-      \\ fs[] >> NO_TAC) >>
-    rw[] \\ fs[] \\ rfs[]
-    \\ imp_res_tac do_eq_list_v_rel \\ fs[]
-    \\ TRY CASE_TAC \\ fs[]
-    \\ fs[LIST_REL_EL_EQN,OPTREL_def]
-    \\ res_tac \\ fs[store_v_same_type_def,sv_rel_cases] \\ fs[]
-    \\ rveq \\ fs []
-    \\ fs[LIST_REL_EL_EQN,OPTREL_def]
-    \\ metis_tac[NOT_SOME_NONE]) >>
-  Cases_on `op = (Op ListAppend)`
-  >-
-   (fs [] \\ rveq
-    \\ pop_assum mp_tac
-    \\ fs [patSemTheory.do_app_def]
-    \\ rpt (PURE_FULL_CASE_TAC \\ fs []) \\ rw []
-    \\ imp_res_tac v_to_list_v_rel_none
-    \\ imp_res_tac v_to_list_v_rel \\ rfs [] \\ rw []
-    \\ metis_tac [list_to_v_APPEND, list_to_v_v_rel])
-  \\ qpat_x_assum `do_app _ _ _ = _` (strip_assume_tac o SIMP_RULE std_ss [patSemTheory.do_app_cases]) >>
-  rw[patSemTheory.do_app_def] >>
-  rfs[] >>
-  fs[store_alloc_def,store_lookup_def,store_assign_def] >> rw[] >>
-  fs[state_rel_def] >>
-  TRY (
-    fs[LIST_REL_EL_EQN,OPTREL_def]
-    \\ res_tac \\ fs[sv_rel_cases] \\ fs[] \\ rw[]
-    \\ NO_TAC ) >>
-  TRY (
-    rename1`patSem$v_to_list v1 = SOME _` >>
-    imp_res_tac v_to_list_v_rel >> fs[] >>
-    imp_res_tac vs_to_string_v_rel >> fs[] >>
-    fs[LIST_REL_EL_EQN] >>
-    simp[Once v_rel_cases,LIST_REL_EL_EQN] >> NO_TAC) >>
-  TRY (
-    rename1`v_to_char_list v1 = SOME _` >>
-    imp_res_tac v_to_char_list_v_rel >> fs[] >> NO_TAC ) >>
-  TRY (
-    qpat_x_assum`v_rel _ _`mp_tac
-    \\ simp[Once v_rel_cases] \\ strip_tac \\ fs[]
-    \\ fs[LIST_REL_EL_EQN] \\ NO_TAC ) >>
-  TRY (
-    rename1`patSem$do_eq _ _`
-    \\ imp_res_tac do_eq_v_rel \\ fs[]
-    \\ TOP_CASE_TAC \\ fs[] \\ rw[] \\ NO_TAC ) >>
-  fs[LIST_REL_EL_EQN,OPTREL_def,EL_LUPDATE,LENGTH_REPLICATE,EL_REPLICATE] >>
-  res_tac >> fs[sv_rel_cases] >> rfs[] >> fs[LIST_REL_EL_EQN,EL_LUPDATE,store_v_same_type_def] >>
-  rw[EL_LUPDATE] \\ rw[EL_LUPDATE,EL_APPEND_EQN,EL_REPLICATE] >> rw[]
-  \\ metis_tac[]
-QED
-
-(* some NoRun things for exp_rel, v_rel, state_rel etc *)
-
-Theorem exp_rel_NoRun:
-   !a b R x y.
-     exp_rel a b R x y ==> NoRun x ==> NoRun y
-Proof
-  ho_match_mp_tac exp_rel_ind \\ rw [NoRun_def, EVERY_EL, LIST_REL_EL_EQN]
-QED
-
-Theorem LIST_REL_exp_rel_NoRun:
-   !es1 es2 a b R.
-     LIST_REL (exp_rel a b R) es1 es2 /\ EVERY NoRun es1
-     ==>
-     EVERY NoRun es2
-Proof
-  Induct \\ rw [] \\ fs [EVERY_DEF] \\ metis_tac [exp_rel_NoRun]
-QED
-
-Theorem env_rel_NoRun_v:
-   !env1 env2 R k1 k2.
-     env_rel R env1 env2 (LENGTH env1) (LENGTH env2) /\
-     EVERY NoRun_v env1
-     ==>
-     EVERY NoRun_v env2
-Proof
-   Induct \\ rw [] \\ fs [env_rel_def]
-QED
-
-Theorem v_rel_NoRun_v:
-   !x y. v_rel x y ==> (NoRun_v x ==> NoRun_v y)
-Proof
-  ho_match_mp_tac v_rel_ind \\ rw [v_rel_cases]
-  \\ TRY (fs [NoRun_v_def, LIST_REL_EL_EQN, EVERY_EL] \\ NO_TAC)
-  \\ metis_tac [NoRun_v_def, ETA_AX, exp_rel_NoRun, LIST_REL_exp_rel_NoRun]
-QED
-
-val sv_rel_NoRun_store_v = Q.prove (
-  `!R x y.
-   sv_rel R x y ==>
-   (!x y. R x y ==> NoRun_v x ==> NoRun_v y) ==>
-   NoRun_store_v x ==> NoRun_store_v y`,
-  ho_match_mp_tac sv_rel_ind \\ rw [] \\ fs []
-  \\ fs [NoRun_store_v_def, LIST_REL_EL_EQN, EVERY_EL] \\ rw []
-  \\ metis_tac []);
-
-Theorem sv_rel_v_rel_NoRun:
-   sv_rel v_rel x y ==> NoRun_store_v x ==> NoRun_store_v y
-Proof
-  metis_tac [sv_rel_NoRun_store_v, v_rel_NoRun_v]
-QED
-
-Theorem sv_rel_sym:
-   !R x y. (!x y. R x y ==> R y x) ==> sv_rel R x y ==> sv_rel R y x
-Proof
-  ho_match_mp_tac sv_rel_ind
-  \\ rw [sv_rel_cases,LIST_REL_EL_EQN]
-QED
-
-Theorem state_rel_NoRun:
-   state_rel s1 s2 ==> (NoRun_state s1 <=> NoRun_state s2)
-Proof
-  rw [state_rel_def, NoRun_state_def]
-  \\ eq_tac \\ rw [] \\ fs []
-  \\ TRY
-   (fs [EVERY_EL, LIST_REL_EL_EQN] \\ rw []
-    \\ rpt (first_x_assum (qspec_then `n` mp_tac))
-    \\ fs [OPTREL_def] \\ rw []
-    \\ imp_res_tac v_rel_sym
-    \\ imp_res_tac v_rel_NoRun_v \\ fs []
-    \\ NO_TAC)
-  \\ pop_assum kall_tac
-  \\ qhdtm_x_assum `LIST_REL` kall_tac
-  \\ rpt (qpat_x_assum `_ = _` kall_tac)
-  \\ fs [LIST_REL_EL_EQN, EVERY_EL] \\ rw []
-  \\ rpt (first_x_assum (qspec_then `n` mp_tac)) \\ rw [] \\ fs []
-  \\ metis_tac [sv_rel_v_rel_NoRun, sv_rel_sym, v_rel_sym]
-QED
-
-Theorem evaluate_exp_rel:
-   (∀env1 ^s1 es1 s'1 r1.
-     evaluate env1 s1 es1 = (s'1,r1) /\
-     EVERY NoRun es1 /\ EVERY NoRun_v env1 /\ NoRun_state s1
-     ==>
-     ∀env2 s2 es2.
-       LIST_REL (exp_rel (LENGTH env1) (LENGTH env2) (env_rel v_rel env1 env2)) es1 es2 /\
-       EVERY NoRun_v env2 /\
-       state_rel s1 s2 ⇒
-       ∃s'2 r2.
-         evaluate env2 s2 es2 = (s'2,r2) ∧
-         state_rel s'1 s'2 ∧
-         result_rel (LIST_REL v_rel) v_rel r1 r2)
-Proof
-  ho_match_mp_tac patSemTheory.evaluate_ind >> fs [NoRun_def] >>
-  strip_tac >- ( srw_tac[][patSemTheory.evaluate_def] >> srw_tac[][]) >>
-  strip_tac >- (
-    rw [patSemTheory.evaluate_def,PULL_EXISTS]
-    \\ rfs [] \\ fs []
-    \\ every_case_tac \\ fs [] \\ rw [] \\ fs []
-    \\ imp_res_tac evaluate_sing  \\ rw [] \\ fs []
-    \\ qmatch_asmsub_rename_tac `evaluate env1 s3 (e2::es)`
-    \\ `NoRun_state s3` by (drule (GEN_ALL evaluate_NoRun) \\ fs []) \\ fs []
-    \\ TRY
-     (first_x_assum drule \\ fs []
-      \\ rpt (disch_then drule) \\ rw [] \\ fs []
-      \\ res_tac \\ fs [] \\ rw [] \\ fs [])
-    \\ asm_exists_tac \\ fs []
-    \\ CCONTR_TAC \\ fs []
-    \\ res_tac \\ fs [] ) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    srw_tac[][Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def,PULL_EXISTS] >>
-    every_case_tac >> full_simp_tac(srw_ss())[] >> srw_tac[][] >> rev_full_simp_tac(srw_ss())[] >>
-    res_tac >> full_simp_tac(srw_ss())[] >> srw_tac[][] >> full_simp_tac(srw_ss())[] >> srw_tac[][] >>
-    imp_res_tac evaluate_sing >>
-    metis_tac[HD,LIST_REL_def]) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    srw_tac[][Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def,PULL_EXISTS] >>
-    every_case_tac >> full_simp_tac(srw_ss())[PULL_EXISTS] >> rpt var_eq_tac >> simp[] >> rev_full_simp_tac(srw_ss())[] >>
-    res_tac >> full_simp_tac(srw_ss())[] >> rpt var_eq_tac >> full_simp_tac(srw_ss())[] >>
-    qmatch_assum_rename_tac`v_rel v1 v2` >>
-    qmatch_assum_rename_tac`exp_rel _ _ _ e12 e22` >>
-    qmatch_assum_abbrev_tac`state_rel s3 s4` >> rev_full_simp_tac(srw_ss())[] >>
-    sg `NoRun_v v1 /\ NoRun_state s3` >- (imp_res_tac evaluate_NoRun \\ fs []) >> fs [] >>
-    first_x_assum(qspecl_then[`v2::env2`,`s4`,`e22`]mp_tac) >>
-    simp[arithmeticTheory.ADD1] >>
-    impl_tac >- ( metis_tac[exp_rel_mono,env_rel_cons, v_rel_NoRun_v]) >>
-    srw_tac[][] ) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    srw_tac[][Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def,PULL_EXISTS,pair_case_eq] >> fs[] >>
-    fs [EVERY_REVERSE, ETA_AX] >>
-    imp_res_tac EVERY2_REVERSE >>
-    first_x_assum drule \\ disch_then drule \\ strip_tac \\ fs[] \\
-    every_case_tac \\ fs[] \\ rveq \\ fs[v_rel_cases] >>
-    res_tac \\ fs [] ) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    simp[Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def,PULL_EXISTS] >>
-    srw_tac[][] >> full_simp_tac(srw_ss())[env_rel_def] >>
-    fsrw_tac[ARITH_ss][]) >>
-  strip_tac >- (
-    srw_tac[][Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def] >>
-    srw_tac[][v_rel_cases,ADD1] ) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    srw_tac[][Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def,PULL_EXISTS] >>
-    fs [EVERY_REVERSE, ETA_AX] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    first_x_assum(fn th => first_assum(mp_tac o MATCH_MP (REWRITE_RULE[GSYM AND_IMP_INTRO] th) o MATCH_MP EVERY2_REVERSE)) >>
-    disch_then(fn th => (first_assum(strip_assume_tac o MATCH_MP th))) >> full_simp_tac(srw_ss())[] >>
-    rveq >>
-    qmatch_assum_rename_tac`evaluate env1 s1 _ = (_,r)` >>
-    res_tac >> fs [] >> rw [] >> fs [] >>
-    reverse(Cases_on`r`)>>full_simp_tac(srw_ss())[] >- srw_tac[][] >>
-    imp_res_tac LIST_REL_exp_rel_NoRun >>
-    reverse IF_CASES_TAC >> full_simp_tac(srw_ss())[] >> srw_tac[][] >> fs [] >> rfs [] >>
-    imp_res_tac EVERY2_REVERSE
-    >- (
-      imp_res_tac do_app_v_rel >>
-      last_x_assum(qspec_then`op`mp_tac) >>
-      srw_tac[][OPTREL_def] >> full_simp_tac(srw_ss())[] >> srw_tac[][] >>
-      every_case_tac >> full_simp_tac(srw_ss())[] >> srw_tac[][] ) >>
-    imp_res_tac do_opapp_v_rel >>
-    pop_assum kall_tac >> pop_assum mp_tac >>
-    srw_tac[][OPTREL_def] >> full_simp_tac(srw_ss())[] >> srw_tac[][] >>
-    first_assum(split_uncurry_arg_tac o rator o concl) >> full_simp_tac(srw_ss())[] >>
-    first_assum(split_uncurry_arg_tac o concl) >> full_simp_tac(srw_ss())[] >>
-    imp_res_tac state_rel_clock >> full_simp_tac(srw_ss())[] >>
-    IF_CASES_TAC >> full_simp_tac(srw_ss())[] >> rpt var_eq_tac >> full_simp_tac(srw_ss())[] >>
-    last_x_assum mp_tac >>
-    impl_tac >- (
-      imp_res_tac do_opapp_NoRun >> fs [EVERY_REVERSE] >> rfs [] >>
-      sg `EVERY NoRun_v a` >- (
-        rw [EVERY_EL] >> fs [LIST_REL_EL_EQN] >>
-        last_x_assum (qspec_then `n` mp_tac) >>
-        fs [] >> rw [] >>
-        irule v_rel_NoRun_v >> fs [] >>
-        qexists_tac `EL n a` >> fs [] >>
-        qpat_x_assum `_ = (_, Rval a)` assume_tac >>
-        drule (GEN_ALL evaluate_NoRun) >>
-        fs [EVERY_REVERSE] >>
-        pop_assum mp_tac >>
-        drule (GEN_ALL evaluate_NoRun) >>
-        fs [EVERY_REVERSE] >>
-        imp_res_tac state_rel_NoRun >> fs [] >>
-        rw [EVERY_EL] ) >>
-      fs [] >>
-      drule (GEN_ALL evaluate_NoRun) >>
-      fs [EVERY_REVERSE] >>
-      pop_assum mp_tac >>
-      drule (GEN_ALL evaluate_NoRun) >>
-      fs [EVERY_REVERSE] >>
-      imp_res_tac state_rel_NoRun >> fs [] >>
-      rw [] >>
-      metis_tac [NoRun_state_dec_clock] ) >>
-    strip_tac >>
-    pop_assum match_mp_tac >>
-    imp_res_tac state_rel_dec_clock >>
-    srw_tac[][] >>
-    qpat_x_assum `_ = (_, Rval a)` assume_tac >>
-    drule (GEN_ALL evaluate_NoRun) >>
-    fs [EVERY_REVERSE] >>
-    pop_assum mp_tac >>
-    drule (GEN_ALL evaluate_NoRun) >>
-    fs [EVERY_REVERSE] >>
-    rw [] >>
-    sg `NoRun_state s2` >- metis_tac [state_rel_NoRun] >> fs [] >>
-    metis_tac [do_opapp_NoRun, EVERY_REVERSE] ) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    srw_tac[][Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def,PULL_EXISTS] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    first_x_assum(fn th => first_assum(mp_tac o MATCH_MP (REWRITE_RULE[GSYM AND_IMP_INTRO] th))) >>
-    disch_then(fn th => (first_assum(strip_assume_tac o MATCH_MP th))) >> full_simp_tac(srw_ss())[] >>
-    res_tac >> fs [] >> rw [] >> fs [] >>
-    qmatch_assum_rename_tac`evaluate env1 s1 _ = (_,r)` >>
-    reverse(Cases_on`r`)>>full_simp_tac(srw_ss())[]>> srw_tac[][] >>
-    imp_res_tac evaluate_sing >> full_simp_tac(srw_ss())[] >>
-    full_simp_tac(srw_ss())[patSemTheory.do_if_def] >>
-    qpat_x_assum `evaluate env1 _ _ = _` assume_tac >>
-    drule (GEN_ALL evaluate_NoRun) >> fs [] >>
-    strip_tac >> fs [] >> rveq >> fs [] >>
-    IF_CASES_TAC >>full_simp_tac(srw_ss())[] >>
-    IF_CASES_TAC >>full_simp_tac(srw_ss())[] >>
-    every_case_tac >> full_simp_tac(srw_ss())[] >> srw_tac[][]) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    srw_tac[][Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def,PULL_EXISTS] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    first_x_assum(fn th => first_assum(mp_tac o MATCH_MP (REWRITE_RULE[GSYM AND_IMP_INTRO] th))) >>
-    disch_then(fn th => (first_assum(strip_assume_tac o MATCH_MP th))) >> full_simp_tac(srw_ss())[] >>
-    res_tac >> fs [] >> rw [] >>
-    qmatch_assum_rename_tac`evaluate env1 s1 _ = (_,r)` >>
-    reverse(Cases_on`r`)>>full_simp_tac(srw_ss())[]>> srw_tac[][] >>
-    imp_res_tac evaluate_sing >> full_simp_tac(srw_ss())[] >>
-    qpat_x_assum `evaluate env1 _ _ = _` assume_tac >>
-    drule (GEN_ALL evaluate_NoRun) >> fs [] >>
-    strip_tac >> fs [] >> rveq >> fs [] >>
-    first_x_assum match_mp_tac >> fs [] >>
-    simp[ADD1] >> metis_tac[exp_rel_mono,env_rel_cons, v_rel_NoRun_v]) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    srw_tac[][Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def,PULL_EXISTS] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    first_x_assum(fn th => first_assum(mp_tac o MATCH_MP (REWRITE_RULE[GSYM AND_IMP_INTRO] th))) >>
-    disch_then(fn th => (first_assum(strip_assume_tac o MATCH_MP th))) >> full_simp_tac(srw_ss())[] >>
-    res_tac >> fs [] >> rw [] >> fs [] >>
-    qmatch_assum_rename_tac`evaluate env1 s1 _ = (_,r)` >>
-    reverse(Cases_on`r`)>>full_simp_tac(srw_ss())[]>> srw_tac[][] >>
-    res_tac >> fs [] >> rw [] >> fs [] >>
-    qpat_x_assum `evaluate env1 _ _ = _` assume_tac >>
-    drule (GEN_ALL evaluate_NoRun) >> fs []) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    srw_tac[][Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[patSemTheory.evaluate_def,PULL_EXISTS] >>
-    last_x_assum mp_tac >>
-    impl_tac >- (irule build_rec_env_NoRun >> fs [ETA_AX] ) >>
-    strip_tac >>
-    pop_assum match_mp_tac >> simp[] >>
-    reverse conj_tac >- (
-      irule build_rec_env_NoRun >> fs [ETA_AX] >>
-      imp_res_tac LIST_REL_exp_rel_NoRun ) >>
-    match_mp_tac (MP_CANON (GEN_ALL exp_rel_mono)) >>
-    simp[env_rel_def,patSemTheory.build_rec_env_def] >> fs[] >>
-    HINT_EXISTS_TAC >> simp[bindn_thm,GSYM bindn_def] >>
-    imp_res_tac EVERY2_LENGTH >>
-    srw_tac[][] >> simp[rich_listTheory.EL_APPEND2,rich_listTheory.EL_APPEND1] >>
-    fsrw_tac[ARITH_ss][env_rel_def] >>
-    simp[Once v_rel_cases])
-QED
-
-val bvs_V_def = Define`
-  bvs_V bvs1 bvs2 V ⇔
-  ∀x k1 k2.
-      find_index (SOME x) bvs1 0 = SOME k1 ∧
-      find_index (SOME x) bvs2 0 = SOME k2
-      ⇒ V k1 k2`
-
-val bind_bvs_V_NONE = Q.prove(
-  `∀bvs1 bvs2 V.
-    bvs_V bvs1 bvs2 V ⇒
-    bvs_V (NONE::bvs1) (NONE::bvs2) (bind V)`,
-  srw_tac[][bvs_V_def,bind_thm] >>
-  imp_res_tac find_index_is_MEM >>
-  imp_res_tac find_index_MEM >>
-  ntac 2 (first_x_assum(qspec_then`0`mp_tac)) >>
-  simp[] >>
-  Cases_on`k1=0`>>simp[]>>
-  Cases_on`k2=0`>>simp[]>>
-  rpt strip_tac >>
-  first_x_assum match_mp_tac >>
-  full_simp_tac(srw_ss())[find_index_def] >>
-  full_simp_tac(srw_ss())[Once find_index_shift_0] >>
-  metis_tac[])
-
-val bind_bvs_V_SOME = Q.prove(
-  `∀bvs1 bvs2 V.
-    bvs_V bvs1 bvs2 V ⇒
-    bvs_V (SOME x::bvs1) (SOME x::bvs2) (bind V)`,
-  srw_tac[][bvs_V_def,bind_thm] >>
-  imp_res_tac find_index_is_MEM >>
-  imp_res_tac find_index_MEM >>
-  ntac 2 (first_x_assum(qspec_then`0`mp_tac)) >>
-  simp[] >>
-  Cases_on`k1=0`>>simp[]>>
-  Cases_on`k2=0`>>simp[]>>
-  srw_tac[][] >> TRY (
-    spose_not_then strip_assume_tac >>
-    full_simp_tac(srw_ss())[find_index_def] >> NO_TAC) >>
-  first_x_assum match_mp_tac >>
-  full_simp_tac(srw_ss())[find_index_def] >> full_simp_tac(srw_ss())[] >>
-  last_x_assum mp_tac >> srw_tac[][] >> full_simp_tac(srw_ss())[] >>
-  full_simp_tac(srw_ss())[Once find_index_shift_0] >>
-  metis_tac[])
-
-Theorem bind_bvs_V:
-   ∀x bvs1 bvs2 V.
-    bvs_V bvs1 bvs2 V ⇒
-    bvs_V (x::bvs1) (x::bvs2) (bind V)
-Proof
-  Cases >> metis_tac[bind_bvs_V_NONE,bind_bvs_V_SOME]
-QED
-
-Theorem bindn_bvs_V:
-   ∀ls n bvs1 bvs2 V.
-     bvs_V bvs1 bvs2 V ∧ n = LENGTH ls ⇒
-     bvs_V (ls++bvs1) (ls++bvs2) (bindn n V)
-Proof
-  Induct >> simp[bindn_def,arithmeticTheory.FUNPOW_SUC] >>
-  metis_tac[bind_bvs_V,bindn_def]
-QED
-
-val exp_rel_Con =
-  SIMP_RULE(srw_ss())[](Q.SPECL[`z1`,`z2`,`V`,`Con _ X Y`]exp_rel_cases)
-
-Theorem exp_rel_isBool:
-   exp_rel z1 z2 V e e' ⇒ (isBool b e ⇔ isBool b e')
-Proof
-  rw[Once exp_rel_cases] \\ fs[] \\
-  CASE_TAC \\ fs[] \\ fs[]
-QED
-
-Theorem exp_rel_sIf:
-   exp_rel z1 z2 V (If t e1 e2 e3) (If t f1 f2 f3) ⇒
-    exp_rel z1 z2 V (sIf t e1 e2 e3) (sIf t f1 f2 f3)
-Proof
-  simp[Once exp_rel_cases] \\ strip_tac \\
-  simp_tac std_ss [sIf_def] \\
-  simp_tac std_ss [Q.SPECL[`e2`,`f2`](Q.GENL[`e`,`e'`]exp_rel_isBool) |> UNDISCH] \\
-  simp_tac std_ss [Q.SPECL[`e3`,`f3`](Q.GENL[`e`,`e'`]exp_rel_isBool) |> UNDISCH] \\
-  IF_CASES_TAC \\ simp[] \\
-  Cases_on`∃tr t. e1 = Con tr t []` >- (
-    pop_assum strip_assume_tac \\
-    last_x_assum mp_tac \\
-    simp[Once exp_rel_cases] \\
-    rw[] ) \\
-  qmatch_abbrev_tac`exp_rel z1 z2 V ea eb` >>
-  `ea = If t e1 e2 e3` by (
-    Cases_on`e1`>>fs[Abbr`ea`]>>
-    BasicProvers.CASE_TAC>>fs[] \\
-    BasicProvers.CASE_TAC>>fs[]) >>
-  `eb = If t f1 f2 f3` by (
-    Cases_on`f1`>>fs[Abbr`eb`]>>
-    BasicProvers.CASE_TAC>>srw_tac[][] >>
-    TRY(BasicProvers.CASE_TAC>>srw_tac[][]) >>
-    pop_assum mp_tac >> simp[Once exp_rel_cases]) >>
-  simp[Once exp_rel_cases]
-QED
-
-Theorem exp_rel_pure:
-   ∀z1 z2 V e1 e2. exp_rel z1 z2 V e1 e2 ⇒
-    (pure e1 ⇔ pure e2)
-Proof
-  ho_match_mp_tac (theorem"exp_rel_strongind") >>
-  simp[pure_def] >>
-  srw_tac[][EVERY_MEM,EVERY2_EVERY,EQ_IMP_THM] >>
-  rev_full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS] >>
-  rev_full_simp_tac(srw_ss())[MEM_EL,PULL_EXISTS] >>
-  full_simp_tac(srw_ss())[] >> srw_tac[][] >> metis_tac[]
-QED
-
-Theorem exp_rel_imp_ground:
-   ∀z1 z2 V e1 e2. exp_rel z1 z2 V e1 e2 ⇒
-      ∀n. (∀k1 k2. k1 ≤ n ⇒ (V k1 k2 ⇔ (k1 = k2))) ∧ ground n e1 ⇒ ground n e2
-Proof
-  ho_match_mp_tac exp_rel_ind >>
-  simp[] >> srw_tac[][] >>
-  TRY (
-    first_x_assum match_mp_tac >>
-    simp[bind_thm] >>
-    srw_tac[][] >> simp[] >> NO_TAC) >>
-  TRY (DECIDE_TAC) >>
-  rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-  full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS] >>
-  rev_full_simp_tac(srw_ss())[MEM_EL,PULL_EXISTS] >>
-  full_simp_tac(srw_ss())[arithmeticTheory.LESS_OR_EQ] >>
-  res_tac >> srw_tac[][]
-QED
-
-Theorem bindn_0:
-   ∀V. bindn 0 V = V
-Proof
-  srw_tac[][bindn_def]
-QED
-val _ = export_rewrites["bindn_0"]
-
-Theorem bind_bindn:
-   (bind (bindn n V) = bindn (SUC n) V) ∧
-    (bindn n (bind V) = bindn (SUC n) V)
-Proof
-  conj_tac >- simp[bindn_def,arithmeticTheory.FUNPOW_SUC] >>
-  simp[bindn_def,arithmeticTheory.FUNPOW]
-QED
-val _ = export_rewrites["bind_bindn"]
-
-Theorem exp_rel_unbind:
-   ∀z1 z2 V e1 e2. exp_rel z1 z2 V e1 e2 ⇒
-      ∀k n m U.
-        V = bindn n U ∧ n ≤ z1 ∧ n ≤ z2 ∧
-        ground k e1 ∧ ground k e2 ∧
-        k ≤ n-m ∧ m ≤ n
-        ⇒
-        exp_rel (z1-m) (z2-m) (bindn (n-m) U) e1 e2
-Proof
-  ho_match_mp_tac exp_rel_ind >>
-  simp[] >> srw_tac[][] >>
-  simp[Once exp_rel_cases] >> full_simp_tac(srw_ss())[] >>
-  srw_tac[][] >>
-  TRY (
-      simp[arithmeticTheory.ADD1] >>
-      first_x_assum match_mp_tac >>
-      simp[arithmeticTheory.ADD1] >>
-      metis_tac[]) >>
-  TRY (
-    first_x_assum(qspecl_then[`k+1`,`SUC n`,`m`,`U`]mp_tac) >>
-    simp[arithmeticTheory.ADD1] >>
-    NO_TAC) >>
-  TRY (
-    rev_full_simp_tac(srw_ss())[EVERY2_EVERY,EVERY_MEM] >>
-    full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS] >>
-    rev_full_simp_tac(srw_ss())[MEM_EL,PULL_EXISTS] >>
-    metis_tac[]) >>
-  qpat_x_assum`bindn n _ k1 k2`mp_tac >>
-  simp[bindn_thm] >> srw_tac[][]
-QED
-
-Theorem exp_rel_sLet:
-   exp_rel z1 z2 V (Let t e1 e2) (Let t f1 f2) ⇒
-    exp_rel z1 z2 V (sLet t e1 e2) (sLet t f1 f2)
-Proof
-  simp[Once exp_rel_cases] \\ strip_tac \\
-  Cases_on`∃t. e2 = Var_local t 0` >- (
-    pop_assum strip_assume_tac \\
-    qhdtm_x_assum`exp_rel`mp_tac \\
-    simp[Once exp_rel_cases] \\ strip_tac \\
-    simp[sLet_def] \\
-    CASE_TAC \\ simp[] \\
-    fs[bind_thm] ) \\
-  `∀t. f2 ≠ Var_local t 0` by (
-    spose_not_then strip_assume_tac \\ fs[] \\
-    qhdtm_x_assum`exp_rel`mp_tac \\
-    simp[Once exp_rel_cases] \\
-    spose_not_then strip_assume_tac \\ fs[] \\
-    fs[bind_thm] ) \\
-  `sLet t e1 e2 = if ground 0 e2 then if pure e1 then e2 else Seq t e1 e2 else Let t e1 e2`
-   by (simp[sLet_def] \\ Cases_on`e2` \\ fs[] \\ CASE_TAC \\ fs[] ) \\
-  `sLet t f1 f2 = if ground 0 f2 then if pure f1 then f2 else Seq t f1 f2 else Let t f1 f2`
-   by (simp[sLet_def] \\ Cases_on`f2` \\ fs[] \\ CASE_TAC \\ fs[] ) \\
-  Cases_on`ground 0 e2` >- (
-    `ground 0 f2` by (
-      match_mp_tac(MP_CANON exp_rel_imp_ground) \\
-      asm_exists_tac \\ simp[] \\
-      simp[bind_thm] ) \\
-    fs[] \\
-    `exp_rel z1 z2 V e2 f2` by (
-      qspecl_then[`z1+1`,`z2+1`,`bind V`,`e2`,`f2`]mp_tac exp_rel_unbind >> simp[] >>
-      disch_then(qspecl_then[`0`,`1`,`1`,`V`]mp_tac) >>
-      simp[bindn_def] ) \\
-    imp_res_tac exp_rel_pure \\
-    IF_CASES_TAC \\ fs[] \\
-    simp[Once exp_rel_cases] ) \\
-  `¬ground 0 f2` by (
-    strip_tac \\
-    qpat_x_assum`¬_`mp_tac \\
-    simp[] \\
-    match_mp_tac(MP_CANON exp_rel_imp_ground) \\
-    imp_res_tac exp_rel_sym \\
-    asm_exists_tac \\ simp[] \\
-    simp[bind_thm,relationTheory.inv_DEF] ) \\
-  fs[] \\
-  simp[Once exp_rel_cases]
-QED
-
-Theorem ground_sIf:
-   ground n (If t e1 e2 e3) ⇒
-    ground n (sIf t e1 e2 e3)
-Proof
-  srw_tac[][sIf_def] >>
-  Cases_on`e1`>> full_simp_tac(srw_ss())[] >>
-  BasicProvers.CASE_TAC >> full_simp_tac(srw_ss())[] >> srw_tac[][] >>
-  BasicProvers.CASE_TAC >> full_simp_tac(srw_ss())[] >> srw_tac[][]
-QED
-
-Theorem ground_inc:
-   (∀e n. ground n e ⇒ ∀m. n ≤ m ⇒ ground m e) ∧
-    (∀es n. ground_list n es ⇒ ∀m. n ≤ m ⇒ ground_list m es)
-Proof
-  ho_match_mp_tac(TypeBase.induction_of(``:patLang$exp``)) >>
-  simp[] >> srw_tac[][] >>
-  first_x_assum (match_mp_tac o MP_CANON) >>
-  metis_tac[arithmeticTheory.LE_ADD_RCANCEL]
-QED
-
-Theorem ground_sLet:
-   ground n (Let t e1 e2) ⇒
-    ground n (sLet t e1 e2)
-Proof
-  simp[sLet_def] \\ strip_tac \\
-  Cases_on`∃t. e2 = Var_local t 0` >- fs[] \\
-  qsuff_tac`ground n (if ground 0 e2 then if pure e1 then e2 else Seq t e1 e2 else Let t e1 e2)`
-  >- ( Cases_on`e2` \\ fs[] \\ CASE_TAC \\ fs[] ) \\ rw[] \\
-  match_mp_tac(MP_CANON(CONJUNCT1 ground_inc))>>
-  qexists_tac`0`>>simp[]
-QED
-
-Theorem ground_Let_Els:
-   ∀k m n t e.
-    ground (n+k) e ∧ m < n ⇒
-    ground n (Let_Els t m k e)
-Proof
-  Induct >> simp[Let_Els_def] >>
-  srw_tac[][] >>
-  match_mp_tac ground_sLet >>
-  simp[] >>
-  first_x_assum match_mp_tac >>
-  fsrw_tac[ARITH_ss][arithmeticTheory.ADD1]
-QED
-
-Theorem compile_pat_ground:
-   (∀t p. ground 1 (compile_pat t p)) ∧
-    (∀t n ps. ground (n + LENGTH ps) (compile_pats t n ps))
-Proof
-  ho_match_mp_tac compile_pat_ind >>
-  simp[compile_pat_def] >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    match_mp_tac ground_sIf >>
-    simp[] >>
-    match_mp_tac ground_Let_Els >>
-    simp[] >>
-    match_mp_tac (MP_CANON(CONJUNCT1 ground_inc)) >>
-    HINT_EXISTS_TAC >> simp[]) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    match_mp_tac ground_sLet >> simp[] >>
-    match_mp_tac (MP_CANON(CONJUNCT1 ground_inc)) >>
-    qexists_tac`1`>>simp[] ) >>
-  rpt gen_tac >> strip_tac >>
-  match_mp_tac ground_sIf >> simp[] >>
-  fsrw_tac[ARITH_ss][arithmeticTheory.ADD1] >>
-  match_mp_tac ground_sLet >> simp[] >>
-  match_mp_tac (MP_CANON(CONJUNCT1 ground_inc)) >>
-  HINT_EXISTS_TAC >> simp[]
-QED
-
-Theorem ground_exp_rel_refl:
-   (∀e n. ground n e ⇒
-       ∀z1 z2 V. n ≤ z1 ∧ n ≤ z2 ⇒ exp_rel z1 z2 (bindn n V) e e) ∧
-    (∀es n. ground_list n es ⇒
-       ∀z1 z2 V. n ≤ z1 ∧ n ≤ z2 ⇒ EVERY2 (exp_rel z1 z2 (bindn n V)) es es)
-Proof
-  ho_match_mp_tac(TypeBase.induction_of(``:patLang$exp``)) >>
-  simp[] >> srw_tac[][] >>
-  simp[Once exp_rel_cases] >> TRY (
-    first_x_assum (match_mp_tac o MP_CANON) >>
-    simp[arithmeticTheory.ADD1] >>
-    NO_TAC) >>
-  simp[bindn_thm]
-QED
-
-Theorem compile_row_acc:
-   (∀t Nbvs p bvs1 N. Nbvs = N::bvs1 ⇒
-       ∀bvs2 r1 n1 f1 r2 n2 f2.
-         compile_row t (N::bvs1) p = (r1,n1,f1) ∧
-         compile_row t (N::bvs2) p = (r2,n2,f2) ⇒
-         n1 = n2 ∧ f1 = f2 ∧
-         ∃ls. r1 = ls ++ bvs1 ∧
-              r2 = ls ++ bvs2 ∧
-              LENGTH ls = SUC n1) ∧
-    (∀t bvsk0 n k ps bvsk N bvs1.
-        bvsk0 = bvsk ++ (N::bvs1) ∧ LENGTH bvsk = n ⇒
-      ∀bvs2 r1 n1 f1 r2 n2 f2.
-        compile_cols t (bvsk++(N::bvs1)) n k ps = (r1,n1,f1) ∧
-        compile_cols t (bvsk++(N::bvs2)) n k ps = (r2,n2,f2) ⇒
-        n1 = n2 ∧ f1 = f2 ∧
-        ∃ls. r1 = ls ++ bvsk ++ (N::bvs1) ∧
-             r2 = ls ++ bvsk ++ (N::bvs2) ∧
-             LENGTH ls = n1)
-Proof
-  ho_match_mp_tac compile_row_ind >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >> full_simp_tac(srw_ss())[] >>
-    rpt BasicProvers.VAR_EQ_TAC >>
-    srw_tac[][compile_row_def] >> simp[] ) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >> full_simp_tac(srw_ss())[] >>
-    rpt BasicProvers.VAR_EQ_TAC >>
-    srw_tac[][compile_row_def] >> simp[] ) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >> full_simp_tac(srw_ss())[] >>
-    rpt BasicProvers.VAR_EQ_TAC >>
-    srw_tac[][compile_row_def] >> simp[] ) >>
-  strip_tac >- (
-    rpt gen_tac >> simp[LENGTH_NIL] >>
-    strip_tac >> rpt gen_tac >> strip_tac >>
-    rpt BasicProvers.VAR_EQ_TAC >> full_simp_tac(srw_ss())[] >>
-    simp_tac std_ss [compile_row_def] >>
-    rpt gen_tac >> strip_tac >>
-    first_x_assum(qspec_then`bvs2`mp_tac) >>
-    simp[] >> strip_tac >>
-    qexists_tac`ls++[N]` >>
-    simp[]) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    rpt gen_tac >> strip_tac >>
-    rpt BasicProvers.VAR_EQ_TAC >> full_simp_tac(srw_ss())[] >>
-    simp_tac std_ss [compile_row_def] >>
-    simp[] >>
-    `∃r1 n1 f1. compile_row (t§1) (NONE::N::bvs1) p = (r1,n1,f1)` by simp[GSYM EXISTS_PROD] >>
-    full_simp_tac(srw_ss())[] >> rpt gen_tac >>
-    `∃r2 n2 f2. compile_row (t§1) (NONE::N::bvs2) p = (r2,n2,f2)` by simp[GSYM EXISTS_PROD] >>
-    full_simp_tac(srw_ss())[] >> strip_tac >>
-    rpt BasicProvers.VAR_EQ_TAC >>
-    first_x_assum(qspec_then`N::bvs2`mp_tac) >>
-    simp[] >> srw_tac[][] >> simp[] ) >>
-  strip_tac >- srw_tac[][] >>
-  strip_tac >- (
-    rpt gen_tac >> simp[] >> strip_tac >>
-    rpt BasicProvers.VAR_EQ_TAC >>
-    simp[compile_row_def] ) >>
-  strip_tac >- simp[compile_row_def] >>
-  rpt gen_tac >> strip_tac >>
-  rpt gen_tac >> strip_tac >>
-  rpt BasicProvers.VAR_EQ_TAC >>
-  rpt gen_tac >>
-  simp_tac std_ss [compile_row_def] >>
-  `∃r01 n01 f01. compile_row (t§1) (NONE::(bvsk ++ (N::bvs1))) p = (r01,n01,f01)` by simp[GSYM EXISTS_PROD] >>
-  `∃r02 n02 f02. compile_row (t§1) (NONE::(bvsk ++ (N::bvs2))) p = (r02,n02,f02)` by simp[GSYM EXISTS_PROD] >>
-  ntac 2 (pop_assum mp_tac) >>
-  simp_tac (srw_ss()) [LET_THM] >>
-  `∃r11 n11 f11. compile_cols (t§2) r01 (LENGTH bvsk + 1 + n01) (k+1) ps = (r11,n11,f11)` by simp[GSYM EXISTS_PROD] >>
-  `∃r12 n12 f12. compile_cols (t§2) r02 (LENGTH bvsk + 1 + n02) (k+1) ps = (r12,n12,f12)` by simp[GSYM EXISTS_PROD] >>
-  ntac 2 (pop_assum mp_tac) >>
-  simp_tac (srw_ss()) [LET_THM] >>
-  ntac 5 strip_tac >>
-  rpt BasicProvers.VAR_EQ_TAC >>
-  qpat_x_assum`∀X. Y`mp_tac >>
-  ntac 2 (pop_assum mp_tac) >>
-  simp_tac (std_ss++listSimps.LIST_ss) [] >>
-  ntac 2 strip_tac >>
-  disch_then(qspec_then`bvsk ++ N::bvs2`mp_tac) >>
-  ntac 2 (pop_assum mp_tac) >>
-  simp_tac (std_ss++listSimps.LIST_ss) [] >>
-  ntac 3 strip_tac >>
-  rpt BasicProvers.VAR_EQ_TAC >>
-  qpat_x_assum`∀X. Y`mp_tac >>
-  ntac 3 (pop_assum mp_tac) >>
-  simp_tac (std_ss++listSimps.LIST_ss) [] >>
-  ntac 3 strip_tac >>
-  disch_then(qspec_then`ls ++ bvsk`mp_tac) >>
-  pop_assum mp_tac >>
-  simp_tac (std_ss++listSimps.LIST_ss++ARITH_ss) [arithmeticTheory.ADD1] >>
-  strip_tac >>
-  disch_then(qspec_then`bvs2`mp_tac) >>
-  ntac 2 (last_x_assum mp_tac) >>
-  simp_tac (std_ss++listSimps.LIST_ss++ARITH_ss) [arithmeticTheory.ADD1] >>
-  ntac 3 strip_tac >>
-  rpt BasicProvers.VAR_EQ_TAC >>
-  simp[]
-QED
-
-Theorem compile_row_shift:
-   (∀t bvs p bvs1 n1 f z1 z2 V e1 e2.
-       compile_row t bvs p = (bvs1,n1,f) ∧ 0 < z1 ∧ 0 < z2 ∧ V 0 0 ∧ bvs ≠ [] ∧
-       exp_rel (z1 + n1) (z2 + n1) (bindn n1 V) e1 e2
-       ⇒
-       exp_rel z1 z2 V (f e1) (f e2)) ∧
-    (∀t bvs n k ps bvs1 n1 f z1 z2 V e1 e2.
-       compile_cols t bvs n k ps = (bvs1,n1,f) ∧ bvs ≠ [] ∧ ps ≠ [] ∧
-       n < z1 ∧ n < z2 ∧ V n n ∧
-       exp_rel (z1 + n1) (z2 + n1) (bindn (n1) V) e1 e2
-       ⇒
-       exp_rel z1 z2 V (f e1) (f e2))
-Proof
-  ho_match_mp_tac compile_row_ind >>
-  simp[compile_row_def] >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    rename1`compile_cols t bvs 0 0 ps` \\
-    `∃bvs1 n1 f. compile_cols t bvs 0 0 ps = (bvs1,n1,f)` by simp[GSYM EXISTS_PROD] >>
-    Cases_on`ps`>>full_simp_tac(srw_ss())[compile_row_def] >> srw_tac[][] ) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    `∃bvs1 n f. compile_row (t§1) (NONE::bvs) p = (bvs1,n,f)` by simp[GSYM EXISTS_PROD] >>
-    full_simp_tac(srw_ss())[] >>
-    rpt gen_tac >> strip_tac >>
-    match_mp_tac exp_rel_sLet >>
-    simp[Once exp_rel_cases] >>
-    simp[Once exp_rel_cases] >>
-    simp[Once exp_rel_cases] >>
-    first_x_assum match_mp_tac >>
-    fsrw_tac[ARITH_ss][arithmeticTheory.ADD1] >>
-    simp[bind_thm] ) >>
-  rpt gen_tac >> strip_tac >>
-  rpt gen_tac >> strip_tac >>
-  `∃bvs0 n0 f0. compile_row (t§1) (NONE::bvs) p = (bvs0,n0,f0)` by simp[GSYM EXISTS_PROD] >>
-  full_simp_tac(srw_ss())[] >>
-  `∃bvs2 n2 f2. compile_cols (t§2) bvs0 (n0+n+1) (k+1) ps = (bvs2,n2,f2)` by simp[GSYM EXISTS_PROD] >>
-  fsrw_tac[ARITH_ss][] >>
-  rpt BasicProvers.VAR_EQ_TAC >>
-  simp[] >>
-  match_mp_tac exp_rel_sLet >>
-  simp[Once exp_rel_cases] >>
-  simp[Once exp_rel_cases] >>
-  simp[Once exp_rel_cases] >>
-  first_x_assum(match_mp_tac o MP_CANON) >>
-  simp[bind_thm] >>
-  Cases_on`ps=[]`>>full_simp_tac(srw_ss())[compile_row_def] >- (
-    srw_tac[][] >> fsrw_tac[ARITH_ss][arithmeticTheory.ADD1] ) >>
-  first_x_assum(match_mp_tac o MP_CANON) >>
-  simp[] >>
-  qspecl_then[`t§1`,`NONE::bvs`,`p`]mp_tac(CONJUNCT1 compile_row_acc) >>
-  simp[] >> disch_then(qspec_then`bvs`mp_tac) >> simp[] >>
-  strip_tac >> Cases_on`bvs0`>>full_simp_tac(srw_ss())[] >>
-  conj_tac >- simp[bindn_thm,arithmeticTheory.ADD1] >>
-  full_simp_tac(srw_ss())[bindn_def,GSYM arithmeticTheory.FUNPOW_ADD,arithmeticTheory.ADD1] >>
-  fsrw_tac[ARITH_ss][]
-QED
-
-Theorem compile_exp_shift:
-   (∀bvs1 e z1 z2 bvs2 V.
-       (set (FILTER IS_SOME bvs1) = set (FILTER IS_SOME bvs2)) ∧
-       (z1 = LENGTH bvs1) ∧ (z2 = LENGTH bvs2) ∧ (bvs_V bvs1 bvs2 V)
-       ⇒
-       exp_rel z1 z2 V (compile_exp bvs1 e) (compile_exp bvs2 e)) ∧
-    (∀bvs1 es z1 z2 bvs2 V.
-       (set (FILTER IS_SOME bvs1) = set (FILTER IS_SOME bvs2)) ∧
-       (z1 = LENGTH bvs1) ∧ (z2 = LENGTH bvs2) ∧ (bvs_V bvs1 bvs2 V)
-       ⇒
-       LIST_REL (exp_rel z1 z2 V) (compile_exps bvs1 es) (compile_exps bvs2 es)) ∧
-    (∀bvs1 funs z1 z2 bvs2 V.
-       (set (FILTER IS_SOME bvs1) = set (FILTER IS_SOME bvs2)) ∧
-       (z1 = SUC(LENGTH bvs1)) ∧
-       (z2 = SUC(LENGTH bvs2)) ∧
-       (bvs_V bvs1 bvs2 V)
-       ⇒
-       LIST_REL (exp_rel z1 z2 (bind V))
-         (compile_funs bvs1 funs) (compile_funs bvs2 funs)) ∧
-    (∀t Nbvs1 pes bvs1 z1 z2 bvs2 V.
-       (Nbvs1 = NONE::bvs1) ∧
-       (set (FILTER IS_SOME bvs1) = set (FILTER IS_SOME bvs2)) ∧
-       (z1 = SUC(LENGTH bvs1)) ∧ (z2 = SUC(LENGTH bvs2)) ∧ (bvs_V bvs1 bvs2 V)
-       ⇒
-       exp_rel z1 z2 (bind V) (compile_pes t (NONE::bvs1) pes) (compile_pes t (NONE::bvs2) pes))
-Proof
-  ho_match_mp_tac compile_exp_ind >>
-  strip_tac >- ( srw_tac[][] >> simp[Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >> simp[Once exp_rel_cases] >>
-    first_x_assum (qspecl_then[`bvs2`]mp_tac) >>
-    simp[arithmeticTheory.ADD1] >>
-    metis_tac[bind_bvs_V] ) >>
-  strip_tac >- ( srw_tac[][] >> simp[Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >>
-    match_mp_tac exp_rel_sIf >>
-    simp[Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >> simp[Once exp_rel_cases] >> metis_tac[] ) >>
-  strip_tac >- (
-    srw_tac[][] >> simp[Once exp_rel_cases] >> metis_tac[] ) >>
-  strip_tac >- (
-    srw_tac[][] >>
-    BasicProvers.CASE_TAC >- (
-      full_simp_tac(srw_ss())[GSYM find_index_NOT_MEM] >>
-      `¬MEM (SOME x) bvs2` by (
-        full_simp_tac(srw_ss())[Once pred_setTheory.EXTENSION,MEM_FILTER] >>
-        spose_not_then strip_assume_tac >>
-        res_tac >> full_simp_tac(srw_ss())[] ) >>
-      imp_res_tac find_index_NOT_MEM >>
-      ntac 2 (first_x_assum(qspec_then`0`mp_tac)) >>
-      simp[] >>
-      simp[Once exp_rel_cases] ) >>
-    imp_res_tac find_index_is_MEM >>
-    full_simp_tac(srw_ss())[Once pred_setTheory.EXTENSION,MEM_FILTER] >>
-    res_tac >> full_simp_tac(srw_ss())[] >>
-    imp_res_tac find_index_MEM >>
-    ntac 2 (first_x_assum(qspec_then`0`mp_tac)) >>
-    srw_tac[][] >> simp[] >>
-    simp[Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[bvs_V_def] >>
-    metis_tac[] ) >>
-  strip_tac >- (
-    srw_tac[][] >>
-    simp[Once exp_rel_cases] >>
-    first_x_assum (qspecl_then[`(SOME x)::bvs2`]mp_tac) >>
-    simp[arithmeticTheory.ADD1] >>
-    disch_then match_mp_tac >>
-    full_simp_tac(srw_ss())[bvs_V_def] >>
-    simp[find_index_def] >>
-    srw_tac[][] >> srw_tac[][bind_def] >>
-    imp_res_tac find_index_LESS_LENGTH >>
-    Cases_on`k1`>>Cases_on`k2`>>full_simp_tac(srw_ss())[]>>
-    simp[bind_def] >>
-    full_simp_tac(srw_ss())[Once find_index_shift_0] >>
-    fsrw_tac[ARITH_ss][arithmeticTheory.ADD1] >>
-    metis_tac[] ) >>
-  strip_tac >- ( srw_tac[][] >> simp[Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >>
-    match_mp_tac exp_rel_sLet >>
-    simp[Once exp_rel_cases] >>
-    first_x_assum (qspecl_then[`bvs2`]mp_tac) >>
-    simp[arithmeticTheory.ADD1] >>
-    metis_tac[bind_bvs_V] ) >>
-  strip_tac >- (
-    srw_tac[][] >>
-    match_mp_tac exp_rel_sLet >>
-    simp[Once exp_rel_cases] >>
-    first_x_assum (qspecl_then[`SOME x::bvs2`]mp_tac) >>
-    simp[arithmeticTheory.ADD1] >>
-    disch_then match_mp_tac >>
-    match_mp_tac bind_bvs_V >> srw_tac[][] ) >>
-  strip_tac >- ( srw_tac[][] >> simp[Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >>
-    simp[Once exp_rel_cases] >>
-    full_simp_tac(srw_ss())[compile_funs_map] >>
-    reverse conj_tac >- (
-      qmatch_abbrev_tac`exp_rel z1 z2 V1 (compile_exp bvs10 e) (compile_exp bvs20 e)` >>
-      last_x_assum (qspecl_then[`bvs20`,`V1`]mp_tac) >>
-      unabbrev_all_tac >> simp[] >>
-      disch_then match_mp_tac >>
-      conj_tac >- (
-        full_simp_tac(srw_ss())[pred_setTheory.EXTENSION,MEM_FILTER,MEM_MAP,EXISTS_PROD,PULL_EXISTS] >>
-        metis_tac[] ) >>
-      match_mp_tac bindn_bvs_V >>
-      simp[] ) >>
-    qmatch_assum_abbrev_tac`Abbrev(bvs20 = MAP f funs ++ bvs2)` >>
-    qmatch_assum_abbrev_tac`Abbrev(bvs10 = MAP f funs ++ bvs1)` >>
-    first_x_assum(qspecl_then[`bvs20`,`bindn (LENGTH funs) V`]mp_tac) >>
-    unabbrev_all_tac >> simp[arithmeticTheory.ADD1] >>
-    disch_then match_mp_tac >>
-    conj_tac >- (
-      full_simp_tac(srw_ss())[pred_setTheory.EXTENSION,MEM_FILTER,MEM_MAP,EXISTS_PROD,PULL_EXISTS] >>
-      metis_tac[] ) >>
-    match_mp_tac bindn_bvs_V >>
-    simp[] ) >>
-  strip_tac >- ( srw_tac[][] >> simp[Once exp_rel_cases] ) >>
-  strip_tac >- ( srw_tac[][] >> simp[Once exp_rel_cases] ) >>
-  strip_tac >- ( srw_tac[][] >> simp[Once exp_rel_cases] ) >>
-  strip_tac >- (
-    srw_tac[][] >>
-    last_x_assum(qspecl_then[`SOME x::bvs2`,`bind V`]mp_tac) >>
-    simp[] >> disch_then match_mp_tac >>
-    match_mp_tac bind_bvs_V >> srw_tac[][] ) >>
-  strip_tac >- (
-    srw_tac[][] >>
-    qspecl_then[`t`,`NONE::bvs1`,`p`]mp_tac(CONJUNCT1 compile_row_acc) >> simp[] >>
-    disch_then(qspec_then`bvs2`mp_tac) >>
-    `∃r1 n1 f1. compile_row t (NONE::bvs1) p = (r1,n1,f1)` by simp[GSYM EXISTS_PROD] >>
-    `∃r2 n2 f2. compile_row t (NONE::bvs2) p = (r2,n2,f2)` by simp[GSYM EXISTS_PROD] >>
-    simp[] >> strip_tac >> full_simp_tac(srw_ss())[] >>
-    first_x_assum(qspecl_then[`ls++bvs2`,`bindn (LENGTH ls) V`]mp_tac) >>
-    simp[rich_listTheory.FILTER_APPEND,bindn_bvs_V] >>
-    rpt BasicProvers.VAR_EQ_TAC >> strip_tac >>
-    qspecl_then[`t`,`NONE::bvs1`,`p`]mp_tac(CONJUNCT1 compile_row_shift) >>
-    simp[arithmeticTheory.ADD1] >>
-    disch_then match_mp_tac >> simp[bind_thm] >>
-    fsrw_tac[ARITH_ss][arithmeticTheory.ADD1]) >>
-  strip_tac >- (
-    srw_tac[][] >>
-    match_mp_tac exp_rel_sIf >>
-    simp[Once exp_rel_cases] >>
-    conj_tac >- (
-      qspecl_then[`compile_pat (t§2) p`,`1`]mp_tac(CONJUNCT1 ground_exp_rel_refl) >>
-      simp[compile_pat_ground,bindn_def] ) >>
-    `∃r1 n1 f1. compile_row (t§3) (NONE::bvs1) p = (r1,n1,f1)` by simp[GSYM EXISTS_PROD] >>
-    `∃r2 n2 f2. compile_row (t§3) (NONE::bvs2) p = (r2,n2,f2)` by simp[GSYM EXISTS_PROD] >>
-    qspecl_then[`t§3`,`NONE::bvs1`,`p`]mp_tac(CONJUNCT1 compile_row_acc) >> simp[] >>
-    disch_then(qspec_then`bvs2`mp_tac) >>
-    simp[] >> strip_tac >> full_simp_tac(srw_ss())[] >>
-    last_x_assum(qspecl_then[`ls++bvs2`,`bindn (LENGTH ls) V`]mp_tac) >>
-    simp[rich_listTheory.FILTER_APPEND,bindn_bvs_V] >>
-    rpt BasicProvers.VAR_EQ_TAC >> strip_tac >>
-    qspecl_then[`t§3`,`NONE::bvs1`,`p`]mp_tac(CONJUNCT1 compile_row_shift) >>
-    simp[arithmeticTheory.ADD1] >>
-    disch_then match_mp_tac >> simp[bind_thm] >>
-    fsrw_tac[ARITH_ss][arithmeticTheory.ADD1]) >>
-   srw_tac[][]
-QED
-
-val lookup_find_index_SOME = Q.prove(
-  `∀env. ALOOKUP env n = SOME v ⇒
-      ∀m. ∃i. (find_index (SOME n) (MAP (SOME o FST) env) m = SOME (m+i)) ∧
-          (v = EL i (MAP SND env))`,
-  Induct >> simp[] >> Cases >> srw_tac[][find_index_def] >-
-    (qexists_tac`0`>>simp[]) >> full_simp_tac(srw_ss())[] >>
-  first_x_assum(qspec_then`m+1`mp_tac)>>srw_tac[][]>>srw_tac[][]>>
-  qexists_tac`SUC i`>>simp[]);
-
-val s = mk_var("s",
-  ``flatSem$evaluate`` |> type_of |> strip_fun |> #1 |> el 2
-  |> type_subst[alpha |-> ``:'ffi``])
-
-val pair_lemma = Q.prove(
-  `(∀x y. p = (x,y) ⇒ Q x y) ⇔ (λ(x,y). Q x y) p`,
-  srw_tac[][EQ_IMP_THM,UNCURRY]>>full_simp_tac(srw_ss())[])
-
-val evaluate_flat_def = flatSemTheory.evaluate_def;
-val evaluate_flat_cons = flatPropsTheory.evaluate_cons;
-val evaluate_flat_sing = flatPropsTheory.evaluate_sing;
-val evaluate_cons = patPropsTheory.evaluate_cons;
-val evaluate_sing = patPropsTheory.evaluate_sing;
-
-val compile_env_aux = Q.prove (
-  `EVERY NoRun_v (MAP (compile_v o SND) env)`,
-  rw [EVERY_MAP] \\ fs [compile_v_NoRun_v]);
-
-Theorem compile_exp_evaluate:
-   (∀env ^s exps ress. flatSem$evaluate env s exps = ress ⇒
-    ¬s.check_ctor ∧ s.exh_pat ∧
-    (SND ress ≠ Rerr (Rabort Rtype_error)) ⇒
-    ∃ress4.
-      evaluate
-        (MAP (compile_v o SND) env.v)
-        (compile_state (co: num -> 'c # dec list) cc s)
-        (compile_exps (MAP (SOME o FST) env.v) exps) = ress4 ∧
-      state_rel (compile_state co cc (FST ress)) (FST ress4) ∧
-      result_rel (LIST_REL v_rel) v_rel (map_result compile_vs compile_v (SND ress)) (SND ress4)) ∧
-   (∀env ^s v pes err_v res t. evaluate_match env s v pes err_v = res ⇒
-    ¬s.check_ctor ∧ s.exh_pat ∧
-    (SND res ≠ Rerr (Rabort Rtype_error)) ⇒
-    ∃res4.
-      patSem$evaluate
-        (compile_v v::(MAP (compile_v o SND) env.v))
-        (compile_state co cc s)
-        [compile_pes t (NONE::(MAP (SOME o FST) env.v)) pes] = res4 ∧
-      state_rel (compile_state co cc (FST res)) (FST res4) ∧
-      result_rel (LIST_REL v_rel) v_rel (map_result (MAP compile_v) compile_v (SND res)) (SND res4))
-Proof
-  ho_match_mp_tac flatSemTheory.evaluate_ind >>
-  (* nil *)
-  strip_tac >- ( srw_tac[][evaluate_flat_def] >> simp[patSemTheory.evaluate_def] ) >>
-  (* cons *)
-  strip_tac >- (
-    rpt gen_tac >> simp[PULL_EXISTS] >>
-    ntac 2 strip_tac >>
-    Q.ISPECL_THEN[`e1`,`e2::es`,`s`]assume_tac(Q.GENL[`e`,`es`,`s`]evaluate_flat_cons) >> full_simp_tac(srw_ss())[] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    qmatch_assum_rename_tac`r ≠ Rerr (Rabort Rtype_error) ⇒ _` >>
-    reverse(Cases_on`r`)>>full_simp_tac(srw_ss())[]>-(
-      strip_tac >> full_simp_tac(srw_ss())[] >>
-      simp[Once evaluate_cons] >>
-      split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-      simp[Once evaluate_cons] ) >>
-    imp_res_tac evaluate_state_unchanged >> fs [] >>
-    qmatch_assum_rename_tac`r ≠ Rerr (Rabort Rtype_error) ⇒ _` >>
-    Cases_on`r = Rerr (Rabort Rtype_error)`>>full_simp_tac(srw_ss())[] >>
-    qpat_x_assum`flatSem$evaluate _ _ (_::_::_) = _`kall_tac >>
-    simp[Once evaluate_cons] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    var_eq_tac >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    simp[Once evaluate_cons] >>
-    qhdtm_x_assum`result_rel`mp_tac >>
-    specl_args_of_then``patSem$evaluate``evaluate_exp_rel mp_tac >>
-    simp [compile_exp_NoRun, compile_state_NoRun, compile_env_aux] >>
-    simp[pair_lemma] >> (fn (g as (_,w)) => split_uncurry_arg_tac (rand(rator w)) g) >>
-    full_simp_tac(srw_ss())[PULL_EXISTS] >>
-    simp_tac(srw_ss()++QUANT_INST_ss[pair_default_qp])[] >>
-    qmatch_assum_abbrev_tac`evaluate env5 s5 (e5::e6) = res5` >>
-    qmatch_assum_abbrev_tac`state_rel s5 s6` >>
-    disch_then(qspecl_then[`env5`,`s6`,`e5`,`e6`]mp_tac) >>
-    simp[] >>
-    impl_tac >- simp[Abbr`env5`,exp_rel_refl,env_rel_def, compile_env_aux] >>
-    ntac 2 strip_tac >>
-    unabbrev_all_tac >>
-    every_case_tac >> full_simp_tac(srw_ss())[] >> rpt var_eq_tac >> full_simp_tac(srw_ss())[] >>
-    metis_tac[EVERY2_APPEND_suff,LIST_REL_v_rel_trans,state_rel_trans,exc_rel_v_rel_trans]) >>
-  (* Lit *)
-  strip_tac >- (
-    srw_tac[][patSemTheory.evaluate_def,evaluate_flat_def] >> full_simp_tac(srw_ss())[] ) >>
-  (* Raise *)
-  strip_tac >- (
-    srw_tac[][patSemTheory.evaluate_def,evaluate_flat_def] >>
-    every_case_tac >> full_simp_tac(srw_ss())[] >>
-    imp_res_tac evaluate_flat_sing >>
-    imp_res_tac evaluate_sing >> full_simp_tac(srw_ss())[]) >>
-  (* Handle *)
-  strip_tac >- (
-    rpt gen_tac >>
-    simp[patSemTheory.evaluate_def,evaluate_flat_def,PULL_EXISTS] >>
-    ntac 2 strip_tac >> full_simp_tac(srw_ss())[] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    imp_res_tac evaluate_state_unchanged >> fs [] >>
-    qmatch_assum_rename_tac`r ≠ Rerr (Rabort Rtype_error) ⇒ _` >>
-    Cases_on`r`>>full_simp_tac(srw_ss())[] >>
-    qmatch_assum_rename_tac`er ≠ Rabort Rtype_error ⇒ _` >>
-    Cases_on`er`>>full_simp_tac(srw_ss())[] >> rpt var_eq_tac >>
-    first_x_assum(qspec_then`exps § 2`strip_assume_tac) \\
-    qhdtm_x_assum`result_rel`mp_tac >>
-    specl_args_of_then``patSem$evaluate``evaluate_exp_rel mp_tac >>
-    simp [compile_state_NoRun, compile_exp_NoRun, compile_env_aux, compile_v_NoRun_v] >>
-    simp[pair_lemma] >> (fn (g as (_,w)) => split_uncurry_arg_tac (rand(rator w)) g) >>
-    full_simp_tac(srw_ss())[PULL_EXISTS] >>
-    qmatch_assum_abbrev_tac`evaluate (v5::env5) s5 [e5] = res5` >>
-    qmatch_assum_rename_tac`v_rel v5 v6` >>
-    qmatch_assum_rename_tac`state_rel s5 s6` >>
-    disch_then(qspecl_then[`v6::env5`,`s6`,`e5`]mp_tac) >>
-    impl_tac >- (
-      simp[Abbr`env5`, compile_env_aux] >>
-      reverse conj_tac >- metis_tac [compile_v_NoRun_v, v_rel_NoRun_v] >>
-      match_mp_tac (CONJUNCT1 exp_rel_refl) >>
-      Cases >> simp[env_rel_def] ) >>
-    strip_tac >>
-    unabbrev_all_tac >> full_simp_tac(srw_ss())[] >>
-    metis_tac[result_rel_LIST_v_v_rel_trans,state_rel_trans,compile_vs_map]) >>
-  (* Con *)
-  strip_tac >- (
-    rpt gen_tac >>
-    simp[patSemTheory.evaluate_def,evaluate_flat_def] >>
-    every_case_tac >> full_simp_tac(srw_ss())[compile_exps_reverse] >>
-    srw_tac[][MAP_REVERSE,EVERY2_REVERSE,v_rel_cases]) >>
-  (* Con *)
-  strip_tac >- (
-    rpt gen_tac >>
-    simp[patSemTheory.evaluate_def,evaluate_flat_def] >>
-    ntac 2 strip_tac \\ fs[] \\ rfs[]
-    \\ fs[compile_exps_reverse]
-    \\ CASE_TAC \\ fs[]
-    \\ Cases_on`cn`
-    \\ CASE_TAC \\ fs[patSemTheory.evaluate_def]
-    \\ CASE_TAC \\ fs[] \\ rw[]
-    \\ rw[v_rel_cases,EVERY2_REVERSE,MAP_REVERSE]) >>
-  (* Var_local *)
-  strip_tac >- (
-    rpt gen_tac >>
-    simp[evaluate_flat_def] >>
-    ntac 2 strip_tac >> var_eq_tac >> full_simp_tac(srw_ss())[] >> pop_assum mp_tac >>
-    BasicProvers.CASE_TAC >>
-    imp_res_tac lookup_find_index_SOME >>
-    first_x_assum(qspec_then`0`mp_tac) >>
-    strip_tac >>
-    simp[patSemTheory.evaluate_def] >>
-    imp_res_tac find_index_LESS_LENGTH >>
-    full_simp_tac(srw_ss())[] >> simp[EL_MAP] ) >>
-  (* Fun *)
-  strip_tac >- ( srw_tac[][patSemTheory.evaluate_def,evaluate_flat_def] >> full_simp_tac(srw_ss())[] ) >>
-  (* App *)
-  strip_tac >- (
-    rpt gen_tac >>
-    simp[patSemTheory.evaluate_def,evaluate_flat_def,PULL_EXISTS] >>
-    ntac 2 strip_tac >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    qmatch_assum_rename_tac`r ≠ Rerr (Rabort Rtype_error) ⇒ _` >>
-    Cases_on`r = Rerr (Rabort Rtype_error)`>>full_simp_tac(srw_ss())[] >>
-    reverse(Cases_on`r`)>>full_simp_tac(srw_ss())[] >- (
-      full_simp_tac(srw_ss())[compile_exps_reverse] >>
-      split_pair_case_tac >> full_simp_tac(srw_ss())[] ) >>
-    qmatch_assum_rename_tac`_ = (s',Rval vs)` >>
-    `¬(dec_clock s').check_ctor ∧ (dec_clock s').exh_pat`
-    by (
-      imp_res_tac evaluate_state_unchanged >>
-      fs [flatSemTheory.dec_clock_def]) >>
-    Cases_on`op = Opapp` >> full_simp_tac(srw_ss())[] >- (
-      Cases_on`do_opapp (REVERSE vs)`>>simp[] >>
-      split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-      imp_res_tac do_opapp >>
-      full_simp_tac(srw_ss())[compile_exps_reverse] >>
-      split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-      rpt var_eq_tac >> full_simp_tac(srw_ss())[] >>
-      first_assum(strip_assume_tac o MATCH_MP do_opapp_v_rel o MATCH_MP EVERY2_REVERSE) >>
-      rev_full_simp_tac(srw_ss())[compile_vs_map,OPTREL_SOME,rich_listTheory.MAP_REVERSE] >>
-      first_assum(split_uncurry_arg_tac o concl) >> full_simp_tac(srw_ss())[] >>
-      IF_CASES_TAC >> full_simp_tac(srw_ss())[] >- ( full_simp_tac(srw_ss())[state_rel_def,compile_state_def] ) >>
-      qhdtm_x_assum`result_rel`mp_tac >>
-      specl_args_of_then``patSem$evaluate``evaluate_exp_rel mp_tac >>
-      simp [compile_exp_NoRun, compile_env_aux, compile_v_NoRun_v, compile_state_NoRun] >>
-      sg `EVERY NoRun_v v'` >- (
-        fs [LIST_REL_EL_EQN, EVERY_EL] >>
-        rw [] >>
-        first_x_assum (qspec_then `n` mp_tac) >> fs [] >>
-        strip_tac >>
-        imp_res_tac v_rel_NoRun_v >> fs [compile_v_NoRun_v, EL_MAP] ) >>
-      sg `EVERY NoRun_v env2` >- metis_tac [EVERY_REVERSE, do_opapp_NoRun] >>
-      simp[pair_lemma] >> (fn (g as (_,w)) => split_uncurry_arg_tac (rand(rator w)) g) >>
-      full_simp_tac(srw_ss())[PULL_EXISTS] >> strip_tac >>
-      first_x_assum (fn th => first_x_assum(mp_tac o MATCH_MP (REWRITE_RULE[GSYM AND_IMP_INTRO] th))) >>
-      full_simp_tac(srw_ss())[compile_state_dec_clock] >>
-      imp_res_tac state_rel_dec_clock >>
-      disch_then(fn th => first_x_assum(mp_tac o MATCH_MP th)) >>
-      strip_tac >> full_simp_tac(srw_ss())[] >>
-      IF_CASES_TAC >- full_simp_tac(srw_ss())[state_rel_def,compile_state_def] >> full_simp_tac(srw_ss())[] >>
-      metis_tac[state_rel_trans,result_rel_LIST_v_v_rel_trans]) >>
-    TOP_CASE_TAC \\ rfs[] \\ fs[] \\
-    TOP_CASE_TAC \\ fs[] \\
-    TOP_CASE_TAC \\ fs[] \\
-    fs[compile_exps_reverse] \\
-    Q.ISPECL_THEN[`cc`,`co`]drule do_app >> strip_tac \\
-    imp_res_tac EVERY2_REVERSE \\
-    drule do_app_v_rel \\
-    disch_then drule \\
-    disch_then(qspec_then`Op op`mp_tac)  >>
-    fs[MAP_REVERSE,OPTREL_SOME] >>
-    strip_tac \\ fs[] \\
-    pairarg_tac \\ fs[]) >>
-  (* If *)
-  strip_tac >-  (
-    rpt gen_tac \\ ntac 2 strip_tac \\ fs[]
-    \\ simp[evaluate_flat_def]
-    \\ CASE_TAC \\ fs[]
-    \\ ntac 2 strip_tac
-    \\ DEEP_INTRO_TAC sIf_intro
-    \\ simp[patSemTheory.evaluate_def]
-    \\ CASE_TAC \\ fs[]
-    \\ rveq
-    \\ reverse CASE_TAC \\ fs[] \\ rfs[]
-    >- ( rw[] \\ strip_tac \\ fs[] )
-    \\ CASE_TAC \\ fs[]
-    \\ CASE_TAC
-    >- (
-      fs[patSemTheory.do_if_def,flatSemTheory.do_if_def]
-      \\ imp_res_tac evaluate_flat_sing
-      \\ imp_res_tac evaluate_sing
-      \\ fs[bool_case_eq]
-      \\ rveq \\ fs[flatSemTheory.Boolv_def,v_rel_cases,patSemTheory.Boolv_def]) >>
-    `¬q.check_ctor ∧ q.exh_pat`
-    by (imp_res_tac evaluate_state_unchanged >> fs []) >>
-    fs []
-    \\ qhdtm_x_assum`state_rel`mp_tac
-    \\ specl_args_of_then ``patSem$evaluate``evaluate_exp_rel mp_tac
-    \\ simp[compile_state_NoRun,compile_exp_NoRun,compile_env_aux]
-    \\ simp[pair_lemma] >> pairarg_tac \\ fs[]
-    \\ imp_res_tac evaluate_flat_sing
-    \\ imp_res_tac patPropsTheory.evaluate_sing
-    \\ rveq
-    \\ fs[PULL_EXISTS]
-    \\ disch_then (first_assum o mp_then Any mp_tac )
-    \\ qmatch_goalsub_abbrev_tac`evaluate env1 _ [ex1]`
-    \\ disch_then(qspecl_then[`env1`,`ex1`]mp_tac)
-    \\ simp[Abbr`env1`,Abbr`ex1`,compile_env_aux]
-    \\ impl_tac
-    >- (
-      fs[patSemTheory.do_if_def,flatSemTheory.do_if_def,bool_case_eq]
-      \\ rw[]
-      \\ fs[flatSemTheory.Boolv_def,patSemTheory.Boolv_def,v_rel_cases,
-            backend_commonTheory.true_tag_def,backend_commonTheory.false_tag_def]
-      \\ match_mp_tac (CONJUNCT1 exp_rel_refl)
-      \\ rw[env_rel_def] )
-    \\ ntac 2 strip_tac \\ fs[]
-    \\ conj_tac >- metis_tac[state_rel_trans, result_rel_LIST_v_v_rel_trans]
-    \\ strip_tac \\ fs[]) >>
-  (* Mat *)
-  strip_tac >- (
-    simp[PULL_EXISTS,evaluate_flat_def] >>
-    rpt gen_tac >> ntac 2 strip_tac >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    DEEP_INTRO_TAC sLet_intro >>
-    simp[patSemTheory.evaluate_def] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    qmatch_assum_rename_tac`r ≠ Rerr (Rabort Rtype_error) ⇒ _` >>
-    reverse(Cases_on`r`)>>full_simp_tac(srw_ss())[] >- ( strip_tac >> full_simp_tac(srw_ss())[] ) >>
-    rename1`compile_pes (tr § 2) _ pes` \\
-    `¬s'.check_ctor ∧ s'.exh_pat`
-    by (imp_res_tac evaluate_state_unchanged >> fs []) >>
-    fs [] >>
-    first_x_assum(qspec_then`tr§2`strip_assume_tac) \\
-    qhdtm_x_assum`result_rel`mp_tac >>
-    specl_args_of_then``patSem$evaluate``evaluate_exp_rel mp_tac >>
-    simp [compile_exp_NoRun, compile_state_NoRun, compile_env_aux, compile_v_NoRun_v] >>
-    simp[pair_lemma] >> (fn (g as (_,w)) => split_uncurry_arg_tac (rand(rator w)) g) >>
-    full_simp_tac(srw_ss())[PULL_EXISTS] >>
-    qmatch_assum_abbrev_tac`evaluate (v5::env5) s5 [e5] = res5` >>
-    imp_res_tac evaluate_flat_sing >>
-    imp_res_tac patPropsTheory.evaluate_sing >>
-    rpt var_eq_tac >> full_simp_tac(srw_ss())[] >> var_eq_tac >>
-    qmatch_assum_rename_tac`v_rel v5 v6` >>
-    qmatch_assum_rename_tac`state_rel s5 s6` >>
-    disch_then(qspecl_then[`v6::env5`,`s6`,`e5`]mp_tac) >>
-    impl_tac >- (
-      simp[Abbr`env5`, compile_env_aux] >>
-      reverse conj_tac >- metis_tac [v_rel_NoRun_v, compile_v_NoRun_v] >>
-      match_mp_tac (CONJUNCT1 exp_rel_refl) >>
-      Cases >> simp[env_rel_def] ) >>
-    strip_tac >>
-    unabbrev_all_tac >> full_simp_tac(srw_ss())[] >>
-    strip_tac >>
-    full_simp_tac(srw_ss())[EXT compile_vs_map] >>
-    conj_tac >- metis_tac[result_rel_LIST_v_v_rel_trans,state_rel_trans] >>
-    spose_not_then strip_assume_tac >> full_simp_tac(srw_ss())[] >> rev_full_simp_tac(srw_ss())[]) >>
-  (* Let *)
-  strip_tac >- (
-    simp[PULL_EXISTS,evaluate_flat_def] >>
-    rpt gen_tac >> ntac 2 strip_tac >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    qmatch_assum_rename_tac`r ≠ Rerr (Rabort Rtype_error) ⇒ _` >>
-    `¬s'.check_ctor ∧ s'.exh_pat`
-    by (imp_res_tac evaluate_state_unchanged >> fs []) >>
-    fs [] >>
-    Cases_on`n`>>full_simp_tac(srw_ss())[libTheory.opt_bind_def] >- (
-      simp[patSemTheory.evaluate_def] >>
-      split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-      reverse(Cases_on`r`)>>full_simp_tac(srw_ss())[]>>
-      qhdtm_x_assum`result_rel`mp_tac >>
-      specl_args_of_then``patSem$evaluate``evaluate_exp_rel mp_tac >>
-      simp [compile_exp_NoRun, compile_v_NoRun_v, compile_env_aux, compile_state_NoRun] >>
-      simp[pair_lemma] >> (fn (g as (_,w)) => split_uncurry_arg_tac (rand(rator w)) g) >>
-      full_simp_tac(srw_ss())[PULL_EXISTS] >>
-      simp_tac(srw_ss()++QUANT_INST_ss[pair_default_qp])[] >>
-      metis_tac[result_rel_LIST_v_v_rel_trans,state_rel_trans,
-                FST,SND,exp_rel_refl,env_rel_def,LENGTH_MAP,v_rel_refl,
-                compile_v_NoRun_v,compile_env_aux]) >>
-    DEEP_INTRO_TAC sLet_intro >>
-    simp[patSemTheory.evaluate_def] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    reverse(Cases_on`r`)>>full_simp_tac(srw_ss())[]>- ( strip_tac >> full_simp_tac(srw_ss())[] ) >>
-    qhdtm_x_assum`result_rel`mp_tac >>
-    specl_args_of_then``patSem$evaluate``evaluate_exp_rel mp_tac >>
-    simp [compile_exp_NoRun, compile_v_NoRun_v, compile_env_aux, compile_state_NoRun] >>
-    simp[pair_lemma] >> (fn (g as (_,w)) => split_uncurry_arg_tac (rand(rator w)) g) >>
-    full_simp_tac(srw_ss())[PULL_EXISTS] >>
-    qmatch_assum_abbrev_tac`evaluate (v5::env5) s5 [e5] = res5` >>
-    rpt var_eq_tac >>
-    imp_res_tac patPropsTheory.evaluate_sing >>
-    imp_res_tac evaluate_flat_sing >>
-    rpt var_eq_tac >> full_simp_tac(srw_ss())[] >>
-    qmatch_assum_rename_tac`v_rel v5 v6` >>
-    qmatch_assum_rename_tac`state_rel s5 s6` >>
-    disch_then(qspecl_then[`v6::env5`,`s6`,`e5`]mp_tac) >>
-    impl_tac >- (
-      simp[Abbr`env5`, compile_env_aux] >>
-      reverse conj_tac >- metis_tac [v_rel_NoRun_v, compile_v_NoRun_v] >>
-      match_mp_tac (CONJUNCT1 exp_rel_refl) >>
-      Cases >> simp[env_rel_def] ) >>
-    strip_tac >>
-    unabbrev_all_tac >> full_simp_tac(srw_ss())[] >>
-    strip_tac >>
-    full_simp_tac(srw_ss())[EXT compile_vs_map] >>
-    conj_tac >- metis_tac[result_rel_LIST_v_v_rel_trans,state_rel_trans] >>
-    spose_not_then strip_assume_tac >> full_simp_tac(srw_ss())[] >> rev_full_simp_tac(srw_ss())[]) >>
-  (* Letrec *)
-  strip_tac >- (
-    rpt gen_tac >>
-    simp[patSemTheory.evaluate_def,PULL_EXISTS,evaluate_flat_def] >>
-    strip_tac >>
-    IF_CASES_TAC >> full_simp_tac(srw_ss())[] >> strip_tac >> full_simp_tac(srw_ss())[] >>
-    qpat_abbrev_tac`xx = evaluate _ _ _` >>
-    qho_match_abbrev_tac`P xx ∧ Q xx` >> full_simp_tac(srw_ss())[] >>
-    qmatch_assum_abbrev_tac`P (evaluate a b c)` >>
-    qmatch_assum_abbrev_tac`Abbrev(xx = evaluate a' b c')` >>
-    `a = a'` by (
-      unabbrev_all_tac >>
-      full_simp_tac(srw_ss())[patSemTheory.build_rec_env_def,flatPropsTheory.build_rec_env_merge,compile_funs_map] >>
-      srw_tac[][LIST_EQ_REWRITE,EL_MAP,UNCURRY,compile_funs_map] >>
-      imp_res_tac find_index_ALL_DISTINCT_EL >>
-      first_x_assum(qspec_then`x`mp_tac) >>
-      impl_tac >- simp[] >>
-      disch_then(qspec_then`0`mp_tac) >>
-      asm_simp_tac(std_ss)[EL_MAP] >>
-      simp[libTheory.the_def]) >>
-    `c = c'` by (
-      unabbrev_all_tac >>
-      simp[flatPropsTheory.build_rec_env_merge] >>
-      rpt (AP_THM_TAC ORELSE AP_TERM_TAC) >>
-      simp[MAP_MAP_o,combinTheory.o_DEF] >>
-      rpt (AP_THM_TAC ORELSE AP_TERM_TAC) >>
-      simp[FUN_EQ_THM,FORALL_PROD] ) >>
-    metis_tac[]) >>
-  (* match nil *)
-  strip_tac >- ( rw[evaluate_flat_def] >> fs[] ) >>
-  (* match cons *)
-  strip_tac >- (
-    simp[] >>
-    rpt gen_tac >> strip_tac >>
-    simp[evaluate_flat_def] >>
-    IF_CASES_TAC >> full_simp_tac(srw_ss())[] >>
-    reverse(BasicProvers.CASE_TAC) >> full_simp_tac(srw_ss())[] >- (
-      ntac 2 strip_tac >>
-      Cases_on`pes`>>simp[]>>full_simp_tac(srw_ss())[]
-      >|[ALL_TAC,
-        DEEP_INTRO_TAC sIf_intro >>
-        simp[patSemTheory.evaluate_def] >>
-        split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-        Q.ISPECL_THEN[`co`,`cc`]mp_tac
-          (Q.GENL[`co`,`cc`](CONJUNCT1 compile_pat_correct)) >>
-        disch_then(qspecl_then[`t § 2`,`p`,`v`,`s`,`[]`]mp_tac) >> simp[] >>
-        strip_tac >> full_simp_tac(srw_ss())[] >> rpt var_eq_tac >> pop_assum kall_tac >>
-        simp[patSemTheory.do_if_def] >>
-        qspec_tac(`t§3`,`t`) \\ gen_tac]
-      >>> USE_SG_THEN (fn th => metis_tac[th]) 2 1 >>
-      split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-      qmatch_assum_rename_tac `_ = (bvs,_,f)` >>
-      full_simp_tac(srw_ss())[Once(CONJUNCT1 flatPropsTheory.pmatch_nil)] >>
-      Cases_on`pmatch s p v []`>>full_simp_tac(srw_ss())[]>>
-      rveq >> qmatch_asmsub_rename_tac`menv ++ env.v` >>
-      qmatch_assum_abbrev_tac`compile_row t (NONE::bvs0) p = X` >>
-      (compile_row_correct
-       |> CONJUNCT1
-       |> SIMP_RULE (srw_ss())[]
-       |> Q.SPECL[`t`,`p`,`bvs0`,`s`,`v`]
-       |> Q.GENL[`any_cc`,`any_co`]
-       |> mp_tac) >>
-      simp[Abbr`X`] >>
-      disch_then(qspecl_then[`cc`,`pure_co compile o co`]strip_assume_tac) >>
-      var_eq_tac >>
-      qpat_abbrev_tac`xx = evaluate _ _ _` >>
-      qmatch_assum_abbrev_tac`Abbrev(xx = evaluate (v4::env4) s4 [f (compile_exp bvss exp)])` >>
-      qunabbrev_tac`xx` >>
-      qhdtm_x_assum`state_rel`mp_tac >>
-      qpat_abbrev_tac`xx = evaluate _ _ _` >>
-      qmatch_assum_abbrev_tac`Abbrev(xx = evaluate env3 s4 [exp3])` >>
-      qunabbrev_tac`xx` >> strip_tac >>
-      qspecl_then[`env3`,`s4`,`[exp3]`]mp_tac evaluate_exp_rel >>
-      sg `NoRun_state s4` >- fs [Abbr`s4`, compile_state_NoRun] >> fs [] >>
-      sg `NoRun exp3 /\ EVERY NoRun_v env3` >- (
-        fs [Abbr`exp3`, Abbr`env3`, Abbr`env4`, compile_exp_NoRun, compile_env_aux]) >>
-      simp[pair_lemma] >> (fn (g as (_,w)) => split_uncurry_arg_tac (rand(rator w)) g) >>
-      full_simp_tac(srw_ss())[PULL_EXISTS] >>
-      disch_then(qspecl_then[`menv4++env4`,`s4`,`compile_exp bvss exp`]mp_tac) >>
-      (impl_tac >- (
-         simp[Abbr`env3`,Abbr`env4`,Abbr`exp3`] >>
-         simp [compile_env_aux] >>
-         match_mp_tac(CONJUNCT1 compile_exp_shift) >>
-         simp[Abbr`bvss`,Abbr`bvs0`] >> conj_tac >- (
-           qpat_x_assum`X = MAP Y menv`mp_tac >>
-           disch_then(mp_tac o Q.AP_TERM`set`) >>
-           simp[pred_setTheory.EXTENSION,MEM_FILTER,MEM_ZIP,PULL_EXISTS,MEM_MAP,EXISTS_PROD] >>
-           simp[MEM_EL,PULL_EXISTS,FORALL_PROD] >>metis_tac[] ) >>
-         simp[bvs_V_def,env_rel_def] >>
-         rpt gen_tac >> strip_tac >>
-         imp_res_tac find_index_LESS_LENGTH >> full_simp_tac(srw_ss())[] >> rev_full_simp_tac(srw_ss())[] >> simp[] >>
-         full_simp_tac(srw_ss())[find_index_APPEND] >>
-         qpat_x_assum`X = SOME k2`mp_tac >>
-         BasicProvers.CASE_TAC >- (
-           qpat_x_assum`X = SOME k1`mp_tac >>
-           BasicProvers.CASE_TAC >- (
-             simp[Once find_index_shift_0] >> strip_tac >>
-             simp[Once find_index_shift_0] >> strip_tac >>
-             srw_tac[][] >>
-             simp[rich_listTheory.EL_APPEND2] ) >>
-           full_simp_tac(srw_ss())[GSYM find_index_NOT_MEM] >>
-           imp_res_tac find_index_is_MEM >>
-           qpat_x_assum`X = MAP Y Z`(mp_tac o Q.AP_TERM`set`) >>
-           full_simp_tac(srw_ss())[pred_setTheory.EXTENSION,MEM_FILTER,MEM_MAP,UNCURRY] >>
-           simp[EQ_IMP_THM,FORALL_AND_THM] >> strip_tac >>
-           full_simp_tac(srw_ss())[PULL_EXISTS] >>
-           first_x_assum(qspec_then`y`mp_tac) >>
-           rev_full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS] >>
-           rev_full_simp_tac(srw_ss())[MEM_EL,PULL_EXISTS] >>
-           metis_tac[] ) >>
-         qpat_x_assum`X = SOME k1`mp_tac >>
-         BasicProvers.CASE_TAC >- (
-           full_simp_tac(srw_ss())[GSYM find_index_NOT_MEM] >>
-           imp_res_tac find_index_is_MEM >>
-           qpat_x_assum`X = MAP Y Z`(mp_tac o Q.AP_TERM`set`) >>
-           full_simp_tac(srw_ss())[pred_setTheory.EXTENSION,MEM_FILTER,MEM_MAP,UNCURRY] >>
-           simp[EQ_IMP_THM,FORALL_AND_THM] >> strip_tac >>
-           full_simp_tac(srw_ss())[PULL_EXISTS] >>
-           rev_full_simp_tac(srw_ss())[MEM_ZIP,PULL_EXISTS] >>
-           rev_full_simp_tac(srw_ss())[MEM_EL,PULL_EXISTS] >>
-           qmatch_assum_rename_tac`z < SUC _` >>
-           last_x_assum(qspec_then`z`mp_tac) >>
-           qpat_x_assum`SOME x = Y`(assume_tac o SYM) >>
-           simp[] >> srw_tac[][] >>
-           metis_tac[] ) >>
-         srw_tac[][] >>
-         imp_res_tac find_index_LESS_LENGTH >>
-         full_simp_tac(srw_ss())[] >> simp[rich_listTheory.EL_APPEND1,EL_MAP] >>
-         qmatch_assum_rename_tac`k2 < LENGTH l2` >>
-         Q.ISPEC_THEN`l2`mp_tac(CONV_RULE SWAP_FORALL_CONV (INST_TYPE[beta|->``:patSem$v``]find_index_in_FILTER_ZIP_EQ)) >>
-         disch_then(qspec_then`IS_SOME`mp_tac) >>
-         disch_then(mp_tac o CONV_RULE(RESORT_FORALL_CONV(op@ o (partition(equal"v1" o fst o dest_var))))) >>
-         disch_then(qspec_then`menv4`mp_tac) >>
-         simp[] >>
-         disch_then(qspecl_then[`SOME x`,`0`,`0`]mp_tac) >>
-         simp[MAP_MAP_o,combinTheory.o_DEF,UNCURRY] >>
-         full_simp_tac(srw_ss())[combinTheory.o_DEF,UNCURRY] >>
-         simp[EL_ZIP,EL_MAP,UNCURRY])) >>
-      strip_tac >>
-      `r2 ≠ Rerr (Rabort Rtype_error)` by (
-        spose_not_then strip_assume_tac >> full_simp_tac(srw_ss())[] ) >>
-      full_simp_tac(srw_ss())[Abbr`s4`,compile_state_def,EXT compile_vs_map] >>
-      metis_tac[state_rel_trans,result_rel_LIST_v_v_rel_trans]) >>
-    ntac 2 strip_tac >> full_simp_tac(srw_ss())[] >>
-    Cases_on`pes`>>full_simp_tac(srw_ss())[evaluate_flat_def] >>
-    DEEP_INTRO_TAC sIf_intro >>
-    simp[patSemTheory.evaluate_def] >>
-    split_pair_case_tac >> full_simp_tac(srw_ss())[] >>
-    Q.ISPECL_THEN[`co`,`cc`]mp_tac
-      (Q.GENL[`co`,`cc`](CONJUNCT1 compile_pat_correct)) >>
-    disch_then(qspecl_then[`t§2`,`p`,`v`,`s`,`[]`]mp_tac) >> simp[] >>
-    strip_tac >> full_simp_tac(srw_ss())[] >> rpt var_eq_tac >> pop_assum kall_tac >>
-    simp[patSemTheory.do_if_def] >>
-    first_x_assum(qspec_then`t§4`strip_assume_tac) \\
-    spose_not_then strip_assume_tac >> full_simp_tac(srw_ss())[])
-QED
-
-Theorem compile_evaluate_decs:
-   flatSem$evaluate_decs ^s prog = res ∧ ¬s.check_ctor ∧ s.exh_pat ∧
-   SND res ≠ SOME (Rabort Rtype_error) ⇒
-   ∃res4.
-   patSem$evaluate [] (compile_state co cc ^s) (compile prog) = res4 ∧
-   state_rel (compile_state co cc (FST res)) (FST res4) ∧
-   OPTREL (exc_rel v_rel)
-     (OPTION_MAP (map_error_result compile_v) (SND res))
-    (case (SND res4) of Rval _ => NONE | Rerr e => SOME e)
-Proof
-  map_every qid_spec_tac[`res`,`s`]
-  \\ Induct_on`prog`
-  >- (
-    rw[flatSemTheory.evaluate_decs_def, compile_def]
-    \\ fs[OPTREL_def, patSemTheory.evaluate_def] )
-  \\ simp[flatSemTheory.evaluate_decs_def]
-  \\ reverse Cases \\ simp[flatSemTheory.evaluate_dec_def]
-  >- (
-    rpt gen_tac \\ strip_tac \\ rfs[]
-    \\ simp[compile_def]
-    \\ qmatch_goalsub_abbrev_tac`evaluate_decs env1`
-    \\ `env1 = env` by simp[Abbr`env1`,flatSemTheory.environment_component_equality]
-    \\ fs[Abbr`env1`]
-    \\ CASE_TAC
-    \\ CASE_TAC
-    \\ fs[]
-    \\ metis_tac[FST,SND] )
-  >- (
-    rpt gen_tac \\ strip_tac \\ rfs[]
-    \\ simp[compile_def]
-    \\ qmatch_goalsub_abbrev_tac`evaluate_decs env1`
-    \\ `env1 = env` by simp[Abbr`env1`,flatSemTheory.environment_component_equality]
-    \\ fs[Abbr`env1`]
-    \\ CASE_TAC
-    \\ CASE_TAC
-    \\ fs[]
-    \\ metis_tac[FST,SND] )
-  \\ rpt gen_tac \\ strip_tac \\ rfs[]
-  \\ fs[compile_def]
-  \\ CASE_TAC
-  \\ split_pair_case_tac \\ fs[]
-  \\ simp[Once evaluate_cons]
-  \\ split_pair_case_tac \\ fs[]
-  \\ Q.ISPEC_THEN`cc`drule(Q.GEN`cc`(CONJUNCT1 compile_exp_evaluate))
-  \\ simp[]
-  \\ impl_tac >- ( strip_tac \\ fs[] \\ rw[] \\ fs[] )
-  \\ split_pair_case_tac \\ fs[]
-  \\ strip_tac
-  \\ reverse CASE_TAC \\ fs[]
-  >- (
-    ntac 2 (pop_assum mp_tac)
-    \\ CASE_TAC \\ fs[]
-    >- (
-      CASE_TAC \\ fs[]
-      \\ TOP_CASE_TAC \\ fs[]
-      \\ TOP_CASE_TAC \\ fs[]
-      \\ TOP_CASE_TAC \\ fs[]
-      \\ TOP_CASE_TAC \\ fs[] )
-    \\ strip_tac \\ rveq
-    \\ simp[Once evaluate_cons]
-    \\ simp[OPTREL_def] )
-  \\ ntac 2 (pop_assum mp_tac)
-  \\ CASE_TAC \\ fs[]
-  \\ CASE_TAC \\ fs[]
-  \\ strip_tac \\ rveq
-  \\ simp[Once evaluate_cons]
-  \\ rename [`evaluate _ flat_s0 _ = (flat_s1,_)`]
-  \\ strip_tac
-  \\ qmatch_asmsub_rename_tac`evaluate_decs flat_s1 prog`
-  \\ first_x_assum(qspecl_then[`flat_s1`]mp_tac)
-  \\ `¬flat_s1.check_ctor ∧ flat_s1.exh_pat`
-         by metis_tac [evaluate_state_unchanged] \\ fs[]
-  \\ strip_tac
-  \\ qmatch_asmsub_abbrev_tac`SND p`
-  \\ Cases_on`p` \\ fs[markerTheory.Abbrev_def]
-  \\ pop_assum(assume_tac o SYM) \\ fs[]
-  \\ qmatch_asmsub_abbrev_tac`SND p`
-  \\ Cases_on`p` \\ fs[markerTheory.Abbrev_def]
-  \\ pop_assum(assume_tac o SYM) \\ fs[]
-  \\ fs [v_rel_cases] \\ rveq \\ fs []
-  \\ qpat_x_assum `_ = (_,v4)` assume_tac
-  \\ rename [`evaluate [] pat_s1 (compile prog) = (pat_s2,v4)`]
-  \\ qmatch_goalsub_abbrev_tac `FST ppp`
-  \\ `FST ppp = pat_s2` by (Cases_on `v4` \\ fs [Abbr`ppp`]) \\ fs []
-  \\ qmatch_goalsub_abbrev_tac `OPTREL _ _ qqq`
-  \\ `qqq = case v4 of Rerr eee => SOME eee | _ => NONE` by
-        (unabbrev_all_tac \\ Cases_on `v4` \\ fs [])
-  \\ fs [] \\ ntac 4 (pop_assum kall_tac)
-  \\ pop_assum mp_tac
-  \\ drule evaluate_exp_rel \\ fs []
-  \\ simp[compile_NoRun, compile_state_NoRun]
-  \\ disch_then(qspecl_then[`[]`,`pat_s1`,`compile prog`]mp_tac)
-  \\ fs [] \\ ntac 2 strip_tac \\ fs []
-  \\ fs[CONJUNCT2 exp_rel_refl]
-  \\ conj_tac THEN1 metis_tac[state_rel_trans]
-  \\ qhdtm_x_assum`OPTREL`mp_tac
-  \\ CASE_TAC \\ fs[OPTREL_def]
-  \\ rw[] \\ fs []
-  \\ metis_tac[state_rel_trans, exc_rel_v_rel_trans]
-QED
-
-Theorem compile_semantics:
-   semantics T F (ffi:'ffi ffi$ffi_state) es ≠ Fail ⇒
-   semantics
-     []
-     (compile_state co cc (initial_state ffi k0 T F))
-     (compile es) =
-   semantics T F ffi es
-Proof
-  simp[flatSemTheory.semantics_def] >>
-  IF_CASES_TAC >> fs[] >>
-  DEEP_INTRO_TAC some_intro >> simp[] >>
-  conj_tac >- (
-    srw_tac[][] >>
-    simp[patSemTheory.semantics_def] >>
-    IF_CASES_TAC >> full_simp_tac(srw_ss())[] >- (
-      qhdtm_x_assum`flatSem$evaluate_decs`kall_tac >>
-      last_x_assum(qspec_then`k'`mp_tac)>>simp[] >>
-      (fn g as (_,w) => Cases_on[ANTIQUOTE(rand((lhs w)))] g) \\
-      fs[] \\ spose_not_then strip_assume_tac \\
-      drule(compile_evaluate_decs) >>
-      impl_tac >- (fs[] \\ EVAL_TAC) \\ strip_tac \\
-      rveq >>
-      rfs[flatSemTheory.initial_state_def, compile_state_with_clock, OPTREL_SOME] \\
-      qpat_x_assum`Rabort _ = _`(assume_tac o SYM) \\
-      fs[map_error_result_Rtype_error] ) \\
-    DEEP_INTRO_TAC some_intro >> simp[] >>
-    conj_tac >- (
-      srw_tac[][] >>
-      qmatch_assum_abbrev_tac`flatSem$evaluate_decs ss es = _` >>
-      qmatch_assum_abbrev_tac`patSem$evaluate bnv bs be = _` >>
-      qispl_then[`es`,`ss`]mp_tac flatPropsTheory.evaluate_decs_add_to_clock_io_events_mono >>
-      Q.ISPECL_THEN [`bnv`,`bs`,`be`](mp_tac o Q.GEN`extra`) patPropsTheory.evaluate_add_to_clock_io_events_mono >>
-      simp[Abbr`bs`,Abbr`ss`] >>
-      disch_then(qspec_then`k`strip_assume_tac) >>
-      disch_then(qspec_then`k'`strip_assume_tac) >>
-      first_assum(mp_then (Pos last) mp_tac (GEN_ALL(flatPropsTheory.evaluate_decs_add_to_clock))) >>
-      disch_then(qspec_then `k'` mp_tac) >>
-      impl_tac >- (every_case_tac >> fs[]) >>
-      strip_tac \\
-      first_assum (mp_then Any mp_tac (GEN_ALL patPropsTheory.evaluate_add_to_clock)) >>
-      simp[]
-      \\ disch_then(qspec_then `k` mp_tac) >>
-      impl_tac >- (every_case_tac >> fs[]) >>
-      strip_tac >>
-      drule (compile_evaluate_decs) >>
-      impl_tac >- (
-        unabbrev_all_tac \\ EVAL_TAC
-        \\ every_case_tac \\ fs[] )
-      \\ strip_tac >> unabbrev_all_tac
-      \\ fs[flatSemTheory.initial_state_def, compile_state_def]
-      \\ rveq \\ fs[] \\ rfs[]
-      \\ fs[OPTREL_def,CaseEq"semanticPrimitives$result"] \\ rveq \\ fs[]
-      \\ fs[state_rel_def,result_rel_def]
-      \\ every_case_tac \\ fs[]) >>
-    drule (compile_evaluate_decs) >> simp[] >>
-    impl_tac >- ( EVAL_TAC \\ strip_tac\\ fs[]) \\
-    strip_tac >>
-    srw_tac[QUANT_INST_ss[pair_default_qp]][] >>
-    full_simp_tac(srw_ss())[state_rel_def,compile_state_def,flatSemTheory.initial_state_def] >>
-    qexists_tac`k`>>simp[] >>
-    CASE_TAC >> full_simp_tac(srw_ss())[] >>
-    CASE_TAC >> full_simp_tac(srw_ss())[] >>
-    fs[OPTREL_def]
-    \\ Cases_on`z` \\ rveq \\ fs[]
-    \\ rveq \\ fs[]
-    \\ CASE_TAC \\ fs[]) >>
-  strip_tac >>
-  simp[patSemTheory.semantics_def] >>
-  IF_CASES_TAC >> full_simp_tac(srw_ss())[] >- (
-    last_x_assum(qspec_then`k`strip_assume_tac) >>
-    qmatch_assum_abbrev_tac`SND p ≠ _` >>
-    Cases_on`p`>>full_simp_tac(srw_ss())[markerTheory.Abbrev_def] >>
-    pop_assum(mp_tac o SYM)
-    \\ strip_tac
-    \\ drule compile_evaluate_decs
-    \\ impl_tac >- (fs[] \\ EVAL_TAC)
-    \\ strip_tac
-    \\ fs[flatSemTheory.initial_state_def,compile_state_with_clock,OPTREL_SOME]
-    \\ first_x_assum (qspec_then `k` assume_tac)
-    \\ rfs [] \\ Cases_on `r` \\ fs []
-    \\ Cases_on `x` \\ fs []
-    \\ Cases_on `a` \\ fs []
-    \\ fs [OPTREL_def])
-  \\ DEEP_INTRO_TAC some_intro >> simp[]
-  \\ conj_tac >- (
-    spose_not_then strip_assume_tac >> rfs [] >>
-    last_x_assum(qspec_then`k`mp_tac) >>
-    (fn g as (_,w) => Cases_on[ANTIQUOTE(rand((lhs(rand(#1(dest_imp w))))))] g) \\
-    strip_tac >>
-    drule compile_evaluate_decs >>
-    impl_tac >- (fs[] \\ EVAL_TAC) \\
-    fs[compile_state_with_clock,flatSemTheory.initial_state_def] >>
-    spose_not_then strip_assume_tac >>
-    full_simp_tac(srw_ss())[state_rel_def,compile_state_def] >>
-    last_x_assum(qspec_then`k`mp_tac)>>simp[] >>
-    Cases_on`r'` >>
-    fs[OPTREL_def]
-    \\ rveq
-    \\ CASE_TAC \\ fs[]
-    \\ CASE_TAC \\ fs[]
-    \\ every_case_tac \\ fs[]) >>
-  strip_tac >>
-  rpt (AP_TERM_TAC ORELSE AP_THM_TAC) >>
-  simp[FUN_EQ_THM] >> gen_tac >>
-  rpt (AP_TERM_TAC ORELSE AP_THM_TAC) >>
-  specl_args_of_then``flatSem$evaluate_decs``(Q.GENL[`s`,`prog`,`res`]compile_evaluate_decs) mp_tac >>
-  simp[state_rel_def,compile_state_def,flatSemTheory.initial_state_def]
-QED
-
-val set_globals_let_els = Q.prove(`
-  ∀t n m e.
-  set_globals (Let_Els t n m e) = set_globals e`,
-  ho_match_mp_tac Let_Els_ind>>rw[Let_Els_def,sLet_def,op_gbag_def]>>
-  CASE_TAC \\ fs[op_gbag_def] \\
-  CASE_TAC \\ fs[op_gbag_def] \\
-  last_x_assum sym_sub_tac>>fs[])
-
-Theorem set_globals_sIf_sub:
-   set_globals (sIf t e1 e2 e3) ≤ set_globals (If t e1 e2 e3)
-Proof
-  rw[sIf_def,SUB_BAG_UNION] \\
-  CASE_TAC \\ fs[] \\
-  CASE_TAC \\ fs[] \\
-  CASE_TAC \\ fs[]
-QED
-
-Theorem set_globals_sIf_empty_suff:
-   set_globals (If t e1 e2 e3) = {||} ⇒ set_globals (sIf t e1 e2 e3) = {||}
-Proof
-  metis_tac[set_globals_sIf_sub,SUB_BAG_EMPTY]
-QED
-
-Theorem set_globals_sLet_sub:
-   set_globals (sLet t e1 e2) ≤ set_globals (Let t e1 e2)
-Proof
-  rw[sLet_def] \\
-  CASE_TAC \\ fs[] \\
-  CASE_TAC \\ fs[]
-QED
-
-Theorem set_globals_sLet_empty_suff:
-   set_globals (Let t e1 e2) = {||} ⇒ set_globals (sLet t e1 e2) = {||}
-Proof
-  metis_tac[set_globals_sLet_sub,SUB_BAG_EMPTY]
-QED
-
-val compile_pat_empty = Q.prove(`
-  (∀t p. set_globals (compile_pat t p) = {||}) ∧
-  (∀t n ps. set_globals (compile_pats t n ps) = {||})`,
-  ho_match_mp_tac compile_pat_ind>>
-  rw[compile_pat_def,op_gbag_def,set_globals_let_els]>>
-  TRY(match_mp_tac set_globals_sIf_empty_suff) \\
-  TRY(match_mp_tac set_globals_sLet_empty_suff) \\
-  rw[op_gbag_def,set_globals_let_els]>>
-  TRY(match_mp_tac set_globals_sLet_empty_suff) \\
-  rw[op_gbag_def,set_globals_let_els]);
-
-val compile_row_set_globals = Q.prove(`
-  (∀t bvs p a b f exp.
-  compile_row t bvs p = (a,b,f) ⇒ set_globals (f exp) = set_globals exp) ∧
-  (∀t bvs n k ps a b f exp. compile_cols t bvs n k ps = (a,b,f) ⇒ set_globals (f exp) = set_globals exp)`,
-  ho_match_mp_tac compile_row_ind>>rw[compile_row_def]>>fs[]>>
-  rpt (pairarg_tac \\ fs[]) \\ rw[] >>
-  last_x_assum(qspec_then`exp`strip_assume_tac) \\
-  TRY(first_x_assum(qspec_then`fs exp`strip_assume_tac)) \\
-  rw[sLet_def] \\ CASE_TAC \\ fs[op_gbag_def] \\
-  CASE_TAC \\ fs[op_gbag_def] \\
-  qpat_x_assum `{||}=f` sym_sub_tac>>rw[op_gbag_def]>>
-  qpat_x_assum `{||}=f` sym_sub_tac>>rw[op_gbag_def]);
-
-val sIf_set_globals_lemma =
-  MATCH_MP (REWRITE_RULE [GSYM AND_IMP_INTRO] SUB_BAG_TRANS)
-           set_globals_sIf_sub;
-
-val sLet_set_globals_lemma =
-  MATCH_MP (REWRITE_RULE [GSYM AND_IMP_INTRO] SUB_BAG_TRANS)
-           set_globals_sLet_sub;
-
-Theorem set_globals_eq:
-   (!bvs exp. set_globals (compile_exp bvs exp) ≤ set_globals exp) /\
-   (!bvs exps.
-     elist_globals (compile_exps bvs exps) ≤ elist_globals exps) /\
-   (!bvs funs.
-     elist_globals (compile_funs bvs funs) ≤
-     elist_globals (MAP (SND o SND) funs)) /\
-   (!tra bvs pes.
-     set_globals (compile_pes tra bvs pes) ≤ elist_globals (MAP SND pes))
-Proof
-  ho_match_mp_tac compile_exp_ind
-  \\ rw [compile_exp_def]
-  \\ fs [SUB_BAG_UNION]
-  >- (match_mp_tac sIf_set_globals_lemma \\ fs [SUB_BAG_UNION])
-  >- (FULL_CASE_TAC \\ fs [])
-  >-
-   (Cases_on `op` \\
-    fs [flatPropsTheory.op_gbag_def, op_gbag_def, SUB_BAG_UNION])
-  >- (match_mp_tac sLet_set_globals_lemma \\ fs [SUB_BAG_UNION])
-  >- (match_mp_tac sLet_set_globals_lemma \\ fs [SUB_BAG_UNION])
-  >-
-   (split_pair_case_tac \\ fs []
-    \\ imp_res_tac compile_row_set_globals \\ fs [])
-  \\ match_mp_tac sIf_set_globals_lemma
-  \\ fs [SUB_BAG_UNION]
-  \\ split_pair_case_tac \\ fs []
-  \\ fs [compile_pat_empty]
-  \\ imp_res_tac compile_row_set_globals \\ fs [SUB_BAG_UNION]
-QED
-
-val esgc_free_let_els = Q.prove(`
-  ∀t n m e.
-  esgc_free e ⇒
-  esgc_free (Let_Els t n m e)`,
-  ho_match_mp_tac Let_Els_ind>>rw[Let_Els_def,sLet_def,op_gbag_def]>>
-  CASE_TAC \\ fs[op_gbag_def] \\
-  CASE_TAC \\ fs[op_gbag_def] \\
-  last_x_assum sym_sub_tac>>fs[])
-
-Theorem esgc_free_sIf_sub:
-   esgc_free (If t e1 e2 e3) ⇒ esgc_free (sIf t e1 e2 e3)
-Proof
-  rw[sIf_def,SUB_BAG_UNION] \\
-  every_case_tac \\ fs[]
-QED
-
-Theorem esgc_free_sLet_sub:
-   esgc_free (Let t e1 e2) ⇒ esgc_free (sLet t e1 e2)
-Proof
-  rw[sLet_def] \\
-  CASE_TAC \\ fs[] \\
-  CASE_TAC \\ fs[]
-QED
-
-val compile_pat_esgc_free = Q.prove(`
-  (∀t p. esgc_free (compile_pat t p)) ∧
-  (∀t n ps. esgc_free (compile_pats t n ps))`,
-  ho_match_mp_tac compile_pat_ind>>
-  rw[compile_pat_def,op_gbag_def,esgc_free_let_els]>>
-  TRY(match_mp_tac esgc_free_sIf_sub) \\
-  rw[compile_pat_def,op_gbag_def,esgc_free_let_els]>>
-  TRY(match_mp_tac esgc_free_sLet_sub) \\
-  rw[compile_pat_def,op_gbag_def,esgc_free_let_els]);
-
-val compile_row_esgc_free = Q.prove(`
-  (∀t bvs p a b f exp.
-  compile_row t bvs p = (a,b,f) ∧ esgc_free exp ⇒
-  esgc_free (f exp)) ∧
-  (∀t bvs n k ps a b f exp.
-  compile_cols t bvs n k ps = (a,b,f) ∧ esgc_free exp ⇒
-  esgc_free (f exp))`,
-  ho_match_mp_tac compile_row_ind>>rw[compile_row_def]>>fs[]>>
-  rpt (pairarg_tac \\ fs[]) \\ rw[] >>
-  last_x_assum(qspec_then`exp`strip_assume_tac) \\
-  TRY(first_x_assum(qspec_then`fs exp`strip_assume_tac)) \\
-  rw[sLet_def] \\ CASE_TAC \\ fs[op_gbag_def] \\
-  CASE_TAC \\ fs[op_gbag_def]);
-
-Theorem compile_exp_esgc_free:
-   (!bvs exp.
-      esgc_free exp
-      ==>
-      esgc_free (compile_exp bvs exp)) /\
-   (!bvs exps.
-      EVERY esgc_free exps
-      ==>
-      EVERY esgc_free (compile_exps bvs exps)) /\
-   (!bvs funs.
-      EVERY esgc_free (MAP (SND o SND) funs)
-      ==>
-      EVERY esgc_free (compile_funs bvs funs)) /\
-   (!tra bvs pes.
-      EVERY esgc_free (MAP SND pes)
-      ==>
-      esgc_free (compile_pes tra bvs pes))
-Proof
-  ho_match_mp_tac compile_exp_ind
-  \\ rw [compile_exp_def]
-  \\ fs [esgc_free_sLet_sub, esgc_free_sIf_sub]
-  >- (FULL_CASE_TAC \\ fs [])
-  >-
-   (qspecl_then [`SOME x::bvs`,`exp`]
-                assume_tac
-                (el 1 (CONJUNCTS set_globals_eq))
-    \\ rfs [])
-  >-
-   (qspecl_then [`MAP (SOME o FST) funs ++ bvs`,`funs`]
-                assume_tac
-                (el 3 (CONJUNCTS set_globals_eq))
-    \\ rfs [])
-  \\ split_pair_case_tac \\ fs []
-  >- metis_tac [compile_row_esgc_free]
-  \\ match_mp_tac esgc_free_sIf_sub \\ fs []
-  \\ metis_tac [compile_row_esgc_free, compile_pat_esgc_free]
-QED
-
-Theorem compile_esgc_free:
-   ∀p. EVERY (esgc_free o dest_Dlet) (FILTER is_Dlet p) ⇒
-    EVERY esgc_free (flat_to_pat$compile p)
-Proof
-  recInduct flat_to_patTheory.compile_ind
-  \\ rw[flat_to_patTheory.compile_def]
-  \\ irule (CONJUNCT1 compile_exp_esgc_free)
-  \\ rw[]
-QED
-
-Theorem compile_distinct_setglobals:
-   ∀e. BAG_ALL_DISTINCT (set_globals e) ⇒
-       BAG_ALL_DISTINCT (set_globals (compile_exp [] e))
-Proof
-  rw[]>>
-  match_mp_tac BAG_ALL_DISTINCT_SUB_BAG >>
-  HINT_EXISTS_TAC>>fs[set_globals_eq]
-QED
-
-Theorem elist_globals_compile:
-   ∀ls.
-      elist_globals (flat_to_pat$compile ls) ≤ elist_globals (MAP dest_Dlet (FILTER is_Dlet ls))
-Proof
-  recInduct flat_to_patTheory.compile_ind
-  \\ rw[flat_to_patTheory.compile_def]
-  \\ irule (List.nth(CONJUNCTS SUB_BAG_UNION, 6))
-  \\ rw[]
-  \\ rw[set_globals_eq]
-QED
-
-val _ = export_theory()
diff --git a/compiler/backend/proofs/flat_uncheck_ctorsProofScript.sml b/compiler/backend/proofs/flat_uncheck_ctorsProofScript.sml
deleted file mode 100644
index af7ce92220..0000000000
--- a/compiler/backend/proofs/flat_uncheck_ctorsProofScript.sml
+++ /dev/null
@@ -1,1016 +0,0 @@
-(*
-  Correctness proof for uncheck_ctors
-*)
-open preamble;
-open flatLangTheory flatSemTheory flatPropsTheory flat_uncheck_ctorsTheory;
-
-val _ = new_theory "flat_uncheck_ctorsProof";
-
-val _ = set_grammar_ancestry ["misc","flatProps","flat_uncheck_ctors"];
-
-Theorem pat_bindings_compile_pat[simp]:
- !(p:flatLang$pat) vars. pat_bindings (compile_pat p) vars = pat_bindings p vars
-Proof
-  ho_match_mp_tac compile_pat_ind >>
-  simp [compile_pat_def, astTheory.pat_bindings_def, pat_bindings_def] >>
-  induct_on `ps` >>
-  rw [] >>
-  fs [pat_bindings_def,astTheory.pat_bindings_def, PULL_FORALL]
-QED
-
-Inductive v_rel:
-  (!lit.
-    v_rel (flatSem$Litv lit) (flatSem$Litv lit)) ∧
-  (!cn vs vs'.
-    LIST_REL v_rel vs vs'
-    ⇒
-    v_rel (flatSem$Conv cn vs) (flatSem$Conv (SOME (the (0,NONE) cn)) vs')) ∧
-  (!env x e env'.
-    LIST_REL (\(x,v1) (y,v2). x = y ∧ v_rel v1 v2) env env'
-    ⇒
-    v_rel (flatSem$Closure env x e) (flatSem$Closure env' x (HD (compile [e])))) ∧
-  (!env funs x env'.
-    LIST_REL (\(x,v1) (y,v2). x = y ∧ v_rel v1 v2) env env'
-    ⇒
-    v_rel (Recclosure env funs x)
-      (Recclosure env' (MAP (\(f,x,e). (f, x, HD (compile [e]))) funs) x)) ∧
-  (!loc.
-    v_rel (Loc loc) (Loc loc)) ∧
-  (!vs vs'.
-    LIST_REL v_rel vs vs'
-    ⇒
-    v_rel (Vectorv vs) (Vectorv vs'))
-End
-
-Inductive s_rel:
-  (!s s'.
-    s.clock = s'.clock ∧
-    LIST_REL (sv_rel v_rel) s.refs s'.refs ∧
-    s.ffi = s'.ffi ∧
-    LIST_REL (OPTION_REL v_rel) s.globals s'.globals ∧
-    s.exh_pat = s'.exh_pat ∧
-    s.check_ctor ∧
-    ~s'.check_ctor
-    ⇒
-    s_rel s s')
-End
-
-Inductive env_rel:
-  (!env env'.
-    LIST_REL (\(x,v1) (y,v2). x = y ∧ v_rel v1 v2) env.v env'.v
-    ⇒
-    env_rel env env')
-End
-
-val alookup_env_rel = Q.prove (
-  `!env env' n x.
-    env_rel env env' ∧
-    ALOOKUP env.v n = SOME x
-    ⇒
-    ∃x'. v_rel x x' ∧ ALOOKUP env'.v n = SOME x'`,
-  strip_tac >>
-  Induct_on `env.v` >>
-  rw [env_rel_cases]
-  >- metis_tac [ALOOKUP_def, NOT_SOME_NONE] >>
-  qpat_x_assum `_::_ = _.v` (assume_tac o GSYM) >>
-  fs [LIST_REL_CONS1, ALOOKUP_def] >>
-  rename1 `ALOOKUP (p::_) _ = SOME _` >>
-  Cases_on `p` >>
-  fs [ALOOKUP_def] >>
-  rename1 `ALOOKUP (p::_) _ = SOME _` >>
-  Cases_on `p` >>
-  fs [ALOOKUP_def] >>
-  rw [] >>
-  rw [] >>
-  fs [] >>
-  first_x_assum (qspec_then `env with v := v` mp_tac) >>
-  rw [] >>
-  first_x_assum (qspec_then `env' with v := t'` mp_tac) >>
-  rw [env_rel_cases]);
-
-Theorem v_rel_bool[simp]:
-   !v b. v_rel (Boolv b) v ⇔ v = Boolv b
-Proof
-  rw [Once v_rel_cases, Boolv_def, libTheory.the_def]
-QED
-
-val lemma = Q.prove (
-  `(\(x,y,z). x) = FST`,
-  rw [FUN_EQ_THM] >>
-  pairarg_tac >>
-  fs []);
-
-val do_opapp_correct = Q.prove (
-  `∀vs vs'.
-     LIST_REL v_rel vs vs'
-     ⇒
-     (flatSem$do_opapp vs = NONE ⇒ do_opapp vs' = NONE) ∧
-     (!env e.
-       do_opapp vs = SOME (env,e) ⇒
-       ∃env'. LIST_REL (\(x,v1) (y,v2). x = y ∧ v_rel v1 v2) env env' ∧
-              do_opapp vs' = SOME (env', HD (compile [e])))`,
-  rw [do_opapp_def] >>
-  every_case_tac >>
-  fs [] >>
-  rw [] >>
-  TRY (fs [Once v_rel_cases] >> NO_TAC) >>
-  qpat_x_assum `v_rel (Recclosure _ _ _) _` mp_tac >>
-  simp [Once v_rel_cases] >>
-  CCONTR_TAC >>
-  fs [MAP_MAP_o, combinTheory.o_DEF, LAMBDA_PROD] >>
-  rw [] >>
-  fs [semanticPrimitivesPropsTheory.find_recfun_ALOOKUP, ALOOKUP_NONE] >>
-  imp_res_tac ALOOKUP_MEM >>
-  fs [MEM_MAP, lemma, FORALL_PROD] >>
-  TRY (pairarg_tac >> fs []) >>
-  rw [] >>
-  imp_res_tac ALOOKUP_ALL_DISTINCT_MEM >>
-  fs [] >>
-  rw []
-  >- metis_tac [FST]
-  >- metis_tac [FST] >>
-  fs [build_rec_env_merge, LIST_REL_APPEND_EQ] >>
-  fs [EVERY2_MAP, MAP_MAP_o, combinTheory.o_DEF, LAMBDA_PROD] >>
-  qpat_x_assum`¬_`mp_tac
-  \\ simp[Once v_rel_cases]
-  \\ simp[LIST_REL_EL_EQN,UNCURRY]);
-
-val s_rel_store_assign = Q.prove (
-  `s_rel s1 s1' ∧
-   v_rel v v' ∧
-   store_assign l (Refv v) s1.refs = SOME v1 ⇒
-   ∃v1'. store_assign l (Refv v') s1'.refs = SOME v1' ∧
-         s_rel (s1 with refs := v1) (s1' with refs := v1')`,
-  rw [semanticPrimitivesTheory.store_assign_def, s_rel_cases]
-  >- metis_tac [LIST_REL_LENGTH] >>
-  fs [semanticPrimitivesTheory.store_v_same_type_def, LIST_REL_EL_EQN, EL_LUPDATE] >>
-  rw[] \\ every_case_tac >> fs [] >> rw [] >>
-  res_tac >>
-  fs[semanticPrimitivesPropsTheory.sv_rel_cases] >>
-  rw [] >>
-  fs []);
-
-val s_rel_store_alloc = Q.prove (
-  `s_rel s1 s1' ∧
-   v_rel v v' ∧
-   store_alloc (Refv v) s1.refs = (s,n) ⇒
-   ∃s'. store_alloc (Refv v') s1'.refs = (s',n) ∧
-           s_rel (s1 with refs := s) (s1' with refs := s')`,
-  rw [semanticPrimitivesTheory.store_alloc_def, s_rel_cases]
-  \\ fs[LIST_REL_EL_EQN]);
-
-val sv_rel_store_alloc = Q.prove (
-  `s_rel s1 s1' ∧
-   sv_rel v_rel sv sv' ∧
-   store_alloc sv s1.refs = (s,n) ⇒
-   ∃s' n'. store_alloc sv' s1'.refs = (s',n')`,
-  rw [semanticPrimitivesPropsTheory.sv_rel_cases, semanticPrimitivesTheory.store_alloc_def, s_rel_cases]);
-
-val s_rel_store_lookup = Q.prove (
-  `s_rel s1 s1' ∧
-   store_lookup n s1.refs = SOME sv ⇒
-   ∃sv'. store_lookup n s1'.refs = SOME sv' ∧ sv_rel v_rel sv sv'`,
-  rw [semanticPrimitivesTheory.store_lookup_def, s_rel_cases] >>
-  fs [LIST_REL_EL_EQN] >>
-  res_tac >>
-  fs [semanticPrimitivesPropsTheory.sv_rel_cases] >>
-  fs []);
-
-Theorem v_rel_eqn[simp]:
-  (!lit v. v_rel (flatSem$Litv lit) v ⇔ v = Litv lit) ∧
-  (!lit v. v_rel v (flatSem$Litv lit) ⇔ v = Litv lit) ∧
-  (v_rel (Conv NONE []) (Conv (SOME (0,NONE)) [])) ∧
-  (v_rel subscript_exn_v subscript_exn_v) ∧
-  (v_rel bind_exn_v bind_exn_v) ∧
-  (!loc l. v_rel (Loc loc) l ⇔ l = Loc loc) ∧
-  (!loc l. v_rel l (Loc loc) ⇔ l = Loc loc) ∧
-  (!vs v. v_rel (Vectorv vs) v ⇔ ∃vs'. v = Vectorv vs' ∧ LIST_REL v_rel vs vs') ∧
-  (!vs v. v_rel v (Vectorv vs) ⇔ ∃vs'. v = Vectorv vs' ∧ LIST_REL v_rel vs' vs)
-Proof
-  rw [flatSemTheory.subscript_exn_v_def, flatSemTheory.bind_exn_v_def] >>
-  ONCE_REWRITE_TAC [v_rel_cases] >>
-  rw [libTheory.the_def]
-QED
-
-Theorem do_eq_correct:
-   (∀a c b d e.
-    v_rel a b ∧ v_rel c d ∧
-    do_eq a c = Eq_val e ⇒
-    do_eq b d = Eq_val e) ∧
-   (∀a c b d e.
-    LIST_REL v_rel a b ∧ LIST_REL v_rel c d ∧
-    do_eq_list a c = Eq_val e ⇒
-    do_eq_list b d = Eq_val e)
-Proof
-  ho_match_mp_tac do_eq_ind
-  \\ rw[do_eq_def] \\ fs[do_eq_def] \\ rw[]
-  \\ imp_res_tac LIST_REL_LENGTH
-  \\ fs[case_eq_thms, bool_case_eq] \\ rw[] \\ fs[]
-  \\ fs[Once v_rel_cases, do_eq_def]
-  \\ rw[]
-  \\ Cases_on`cn1` \\ TRY(Cases_on`cn2`) \\ fs[libTheory.the_def, ctor_same_type_def]
-  \\ imp_res_tac LIST_REL_LENGTH \\ fs[] \\ rfs[]
-QED
-
-Theorem v_to_char_list_v_rel:
-   ∀x y ls. v_rel x y ∧ v_to_char_list x = SOME ls ⇒ v_to_char_list y = SOME ls
-Proof
-  recInduct v_to_char_list_ind
-  \\ rw[v_to_char_list_def]
-  >- fs[Once v_rel_cases, v_to_char_list_def, libTheory.the_def]
-  \\ qhdtm_x_assum`v_rel`mp_tac
-  \\ rw[Once v_rel_cases, v_to_char_list_def, libTheory.the_def]
-  \\ rw[v_to_char_list_def]
-  \\ fs[case_eq_thms]
-  \\ metis_tac[]
-QED
-
-Theorem v_to_list_v_rel:
-   ∀x y ls. v_rel x y ∧ v_to_list x = SOME ls ⇒ ∃ls'. v_to_list y = SOME ls' ∧ LIST_REL v_rel ls ls'
-Proof
-  recInduct v_to_list_ind
-  \\ rw[v_to_list_def]
-  \\ qhdtm_x_assum`v_rel`mp_tac
-  \\ rw[Once v_rel_cases, v_to_list_def, libTheory.the_def]
-  \\ rw[ v_to_list_def]
-  \\ fs[case_eq_thms]
-  \\ rw[PULL_EXISTS]
-QED
-
-Theorem vs_to_string_v_rel:
-   ∀vs ws str. LIST_REL v_rel vs ws ∧ vs_to_string vs = SOME str ⇒ vs_to_string ws = SOME str
-Proof
-  recInduct vs_to_string_ind
-  \\ rw[vs_to_string_def]
-  \\ rw[vs_to_string_def]
-  \\ fs[case_eq_thms] \\ rw[]
-QED
-
-Theorem v_rel_list_to_v:
-   ∀x y. LIST_REL v_rel x y ⇒ v_rel (list_to_v x) (list_to_v y)
-Proof
-  Induct \\ rw[list_to_v_def]
-  \\ rw[Once v_rel_cases, libTheory.the_def]
-  \\ fs[PULL_EXISTS, list_to_v_def]
-QED
-
-val do_app_correct = Q.prove (
-  `∀s1 s1' s2 op vs vs' r.
-     LIST_REL v_rel vs vs' ∧
-     s_rel s1 s1' ∧
-     do_app T s1 op vs = SOME (s2,r) ⇒
-     ∃r' s2'. do_app F s1' op vs' = SOME (s2', r') ∧
-              s_rel s2 s2' ∧
-              result_rel v_rel v_rel r r'`,
-  rw [do_app_cases] >>
-  fs [] >>
-  rw [] >>
-  TRY (
-    qmatch_rename_tac`v_rel _ _`
-    \\ EVAL_TAC
-    \\ rw[Once v_rel_cases]
-    \\ EVAL_TAC
-    \\ rw[] \\ NO_TAC )
-  \\ fs [PULL_EXISTS] >>
-  TRY (
-    imp_res_tac s_rel_store_lookup >>
-    fs [semanticPrimitivesPropsTheory.sv_rel_cases] >>
-    NO_TAC)
-  >> TRY ( fsrw_tac[DNF_ss][] >> fs[LIST_REL_EL_EQN] >> NO_TAC)
-  >- (imp_res_tac do_eq_correct \\ fs[])
-  >- metis_tac [s_rel_store_assign]
-  >- metis_tac [semanticPrimitivesPropsTheory.sv_rel_cases, s_rel_store_alloc]
-  >- (
-    fs[semanticPrimitivesTheory.store_alloc_def, s_rel_cases]
-    \\ rw[] \\ fs[LIST_REL_EL_EQN] )
-  >- (
-    fsrw_tac[DNF_ss][] >>
-    imp_res_tac s_rel_store_lookup >>
-    fs [semanticPrimitivesPropsTheory.sv_rel_cases] )
-  >- (
-    fsrw_tac[DNF_ss][] >>
-    imp_res_tac s_rel_store_lookup >>
-    fs[semanticPrimitivesTheory.store_assign_def] >> rw[] >>
-    fs [semanticPrimitivesPropsTheory.sv_rel_cases] >>
-    fs [s_rel_cases] >>
-    fs[EVERY2_LUPDATE_same] >>
-    fs[LIST_REL_EL_EQN, semanticPrimitivesTheory.store_lookup_def] >>
-    EVAL_TAC)
-  >- (
-    imp_res_tac s_rel_store_lookup >>
-    fs [semanticPrimitivesPropsTheory.sv_rel_cases] >>
-    fsrw_tac[DNF_ss][] )
-  >- (
-    fs[semanticPrimitivesTheory.store_lookup_def,
-       semanticPrimitivesTheory.store_assign_def,
-       s_rel_cases]
-    \\ fs[LIST_REL_EL_EQN,EL_LUPDATE]
-    \\ res_tac
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases] \\ fs[]
-    \\ rw[semanticPrimitivesTheory.store_v_same_type_def, EL_LUPDATE])
-  >- (
-    fs[semanticPrimitivesTheory.store_lookup_def,
-       semanticPrimitivesTheory.store_assign_def,
-       s_rel_cases]
-    \\ fs[LIST_REL_EL_EQN,EL_LUPDATE]
-    \\ res_tac
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases] \\ fs[]
-    \\ rw[semanticPrimitivesTheory.store_v_same_type_def, EL_LUPDATE]
-  )
-  >- metis_tac[v_to_char_list_v_rel]
-  >-
-   (rename [`list_to_v (MAP (λc. Litv (Char c)) str)`]
-    \\ Induct_on `str`
-    THEN1 simp [list_to_v_def,Once v_rel_cases,libTheory.the_def]
-    \\ simp [list_to_v_def,Once v_rel_cases,libTheory.the_def])
-  >- (
-    imp_res_tac v_to_list_v_rel
-    \\ fs[] \\ rw[]
-    \\ metis_tac[vs_to_string_v_rel])
-  >- metis_tac[v_to_list_v_rel]
-  >- (
-    fs[semanticPrimitivesTheory.store_alloc_def]
-    \\ fs[s_rel_cases]
-    \\ rw[LIST_REL_REPLICATE_same]
-    \\ fs[LIST_REL_EL_EQN] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ imp_res_tac s_rel_store_lookup
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ fs[LIST_REL_EL_EQN] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ imp_res_tac s_rel_store_lookup
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ fs[LIST_REL_EL_EQN] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ imp_res_tac s_rel_store_lookup
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ fs[LIST_REL_EL_EQN] )
-  >- (
-    imp_res_tac s_rel_store_lookup >>
-    fs [semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ fs[LIST_REL_EL_EQN] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ imp_res_tac s_rel_store_lookup
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ fs[semanticPrimitivesTheory.store_assign_def]
-    \\ fs[s_rel_cases]
-    \\ rw[EVERY2_LUPDATE_same]
-    \\ fs[LIST_REL_EL_EQN]
-    \\ fs[semanticPrimitivesTheory.store_lookup_def]
-    \\ rfs[semanticPrimitivesTheory.store_v_same_type_def] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ imp_res_tac s_rel_store_lookup
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ fs[semanticPrimitivesTheory.store_lookup_def]
-    \\ rw[] \\ fs[LIST_REL_EL_EQN] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ imp_res_tac s_rel_store_lookup
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ fs[semanticPrimitivesTheory.store_lookup_def]
-    \\ rw[] \\ fs[LIST_REL_EL_EQN] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ imp_res_tac s_rel_store_lookup
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ fs[semanticPrimitivesTheory.store_lookup_def]
-    \\ rw[] \\ fs[LIST_REL_EL_EQN] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ imp_res_tac s_rel_store_lookup
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ fs[semanticPrimitivesTheory.store_assign_def]
-    \\ fs[s_rel_cases]
-    \\ rw[EVERY2_LUPDATE_same]
-    \\ fs[LIST_REL_EL_EQN]
-    \\ fs[semanticPrimitivesTheory.store_lookup_def]
-    \\ rfs[semanticPrimitivesTheory.store_v_same_type_def])
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ imp_res_tac s_rel_store_lookup
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ fs[semanticPrimitivesTheory.store_assign_def]
-    \\ fs[s_rel_cases]
-    \\ rw[EVERY2_LUPDATE_same]
-    \\ fs[LIST_REL_EL_EQN]
-    \\ fs[semanticPrimitivesTheory.store_lookup_def]
-    \\ rfs[semanticPrimitivesTheory.store_v_same_type_def])
-  >- (
-    imp_res_tac v_to_list_v_rel
-    \\ fs[] \\ rw[]
-    \\ match_mp_tac v_rel_list_to_v
-    \\ fs[EVERY2_APPEND_suff])
-  >- (
-    fs[semanticPrimitivesTheory.store_lookup_def, s_rel_cases,
-       semanticPrimitivesTheory.store_assign_def, LIST_REL_EL_EQN]
-    \\ rw[EL_LUPDATE]
-    \\ res_tac
-    \\ qpat_x_assum`EL _ _ = _`assume_tac
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ rfs[]
-    \\ rw[] )
-  >- (
-    imp_res_tac s_rel_store_lookup
-    \\ fs[s_rel_cases]
-    \\ rveq \\ fs[]
-    \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases]
-    \\ rfs[])
-  >- (
-    fs[s_rel_cases]
-    \\ match_mp_tac EVERY2_APPEND_suff
-    \\ fs[LIST_REL_REPLICATE_same, OPTREL_def] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ fs[s_rel_cases]
-    \\ fs[LIST_REL_EL_EQN, EL_LUPDATE]
-    \\ res_tac \\ fs[OPTREL_def] \\ rfs[]
-    \\ rw[] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ fs[s_rel_cases]
-    \\ fs[LIST_REL_EL_EQN, EL_LUPDATE]
-    \\ res_tac \\ fs[OPTREL_def] \\ rfs[]
-    \\ rw[] )
-  >- (
-    fsrw_tac[DNF_ss][]
-    \\ fs[s_rel_cases]
-    \\ fs[LIST_REL_EL_EQN, EL_LUPDATE]
-    \\ res_tac \\ fs[OPTREL_def] \\ rfs[]
-    \\ rw[] \\ fs[]));
-
-Theorem pmatch_correct:
-   (∀(s1:'ffi state) p v1 acc1 s2 v2 acc2.
-    s_rel s1 s2 ∧
-    v_rel v1 v2 ∧
-    LIST_REL v_rel (MAP SND acc1) (MAP SND acc2) ∧
-    MAP FST acc1 = MAP FST acc2 ∧
-    pmatch s1 p v1 acc1 ≠ Match_type_error
-    ⇒
-    case pmatch s1 p v1 acc1 of
-    | Match res1 => ∃res2.
-        pmatch s2 (compile_pat p) v2 acc2 = Match res2 ∧
-        LIST_REL v_rel (MAP SND res1) (MAP SND res2) ∧
-        MAP FST res1 = MAP FST res2
-    | r => pmatch s2 (compile_pat p) v2 acc2 = r) ∧
-   (∀(s1:'ffi state) p v1 acc1 s2 v2 acc2.
-    s_rel s1 s2 ∧
-    LIST_REL v_rel v1 v2 ∧
-    LIST_REL v_rel (MAP SND acc1) (MAP SND acc2) ∧
-    MAP FST acc1 = MAP FST acc2 ∧
-    pmatch_list s1 p v1 acc1 ≠ Match_type_error
-    ⇒
-    case pmatch_list s1 p v1 acc1 of
-    | Match res1 => ∃res2.
-        pmatch_list s2 (MAP compile_pat p) v2 acc2 = Match res2 ∧
-        LIST_REL v_rel (MAP SND res1) (MAP SND res2) ∧
-        MAP FST res1 = MAP FST res2
-    | r => pmatch_list s2 (MAP compile_pat p) v2 acc2 = r)
-Proof
-  ho_match_mp_tac pmatch_ind
-  \\ rw[pmatch_def, compile_pat_def, libTheory.the_def]
-  \\ TRY (
-    qpat_x_assum`v_rel (Conv _ _) _`mp_tac
-    \\ rw[Once v_rel_cases, libTheory.the_def] )
-  >- (
-    fs[pmatch_def, s_rel_cases] \\ rfs[]
-    \\ fs[flatSemTheory.same_ctor_def]
-    \\ imp_res_tac LIST_REL_LENGTH \\ fs[] >>
-    simp [ETA_THM])
-  >- (
-    fs[pmatch_def, s_rel_cases] \\ rfs[]
-    \\ fs[flatSemTheory.same_ctor_def]
-    \\ rename1`ctor_same_type (SOME c1) (SOME c2)`
-    \\ Cases_on`c1` \\ Cases_on `c2`
-    \\ fs[flatSemTheory.ctor_same_type_def]
-    \\ rw[]
-    \\ imp_res_tac LIST_REL_LENGTH \\ fs[] )
-  >- (
-    every_case_tac >>
-    fs [pmatch_def] >>
-    rw [ETA_THM] >>
-    fs [s_rel_cases, same_ctor_def] >>
-    metis_tac [LIST_REL_LENGTH])
-  >- (
-    fs[case_eq_thms]
-    \\ Cases_on`store_lookup lnum s1.refs` \\ fs[]
-    \\ Cases_on`x` \\ fs[]
-    \\ `∃b. store_lookup lnum s2.refs = SOME (Refv b) ∧ v_rel a b`
-    by (
-      fs[s_rel_cases, semanticPrimitivesTheory.store_lookup_def, LIST_REL_EL_EQN]
-      \\ metis_tac[semanticPrimitivesPropsTheory.sv_rel_cases,
-                   semanticPrimitivesTheory.store_v_distinct,
-                   semanticPrimitivesTheory.store_v_11] )
-    \\ simp[] )
-  >- (
-    pop_assum mp_tac
-    \\ TOP_CASE_TAC \\ fs[pmatch_def]
-    \\ strip_tac \\ fs[]
-    \\ TOP_CASE_TAC \\ fs[]
-    \\ res_tac \\ fs[] )
-QED
-
-val compile_exp_correct = Q.prove (
-  `(∀env (s : 'a flatSem$state) es s' r s1 env'.
-    evaluate env s es = (s',r) ∧
-    r ≠ Rerr (Rabort Rtype_error) ∧
-    env_rel env env' ∧
-    s_rel s s1
-    ⇒
-    ?s1' r1.
-      result_rel (LIST_REL v_rel) v_rel r r1 ∧
-      s_rel s' s1' ∧
-      evaluate env' s1 (compile es) = (s1', r1)) ∧
-   (∀env (s : 'a flatSem$state) v pes err_v s' r s1 env' err_v1 v1.
-    evaluate_match env s v pes err_v = (s',r) ∧
-    r ≠ Rerr (Rabort Rtype_error) ∧
-    env_rel env env' ∧
-    s_rel s s1 ∧
-    v_rel v v1 ∧
-    v_rel err_v err_v1
-    ⇒
-    ?s1' r1.
-      result_rel (LIST_REL v_rel) v_rel r r1 ∧
-      s_rel s' s1' ∧
-      evaluate_match env' s1 v1 (MAP (λ(p,e'). (compile_pat p,HD (compile [e']))) pes) err_v1 = (s1', r1))`,
-  ho_match_mp_tac evaluate_ind >>
-  rw [evaluate_def, compile_def] >>
-  rw [] >>
-  TRY (fs [s_rel_cases] >> NO_TAC) >>
-  TRY (split_pair_case_tac >> rw []) >>
-  TRY (split_pair_case_tac >> rw [])
-  >- (
-    every_case_tac >>
-    fs [] >>
-    rw [PULL_EXISTS] >>
-    rfs [] >>
-    rw [evaluate_append] >>
-    res_tac >>
-    rw [] >>
-    imp_res_tac evaluate_sing >>
-    rw [] >>
-    res_tac >>
-    fs [])
-  >- (
-    every_case_tac >>
-    fs [] >>
-    imp_res_tac evaluate_sing >>
-    rw [] >>
-    `?e'. compile [e] = [e']` by metis_tac [compile_sing] >>
-    res_tac >>
-    fs [] >>
-    rw [] >>
-    rfs [])
-  >- (
-    fs [] >>
-    `?e'. compile [e] = [e']` by metis_tac [compile_sing] >>
-    fs [] >>
-    rename [`evaluate env s [e] = (s1, r)`] >>
-    Cases_on `r` >>
-    fs [] >>
-    rw []
-    >- (
-      res_tac >>
-      rw [] >>
-      fs [] >>
-      rw []) >>
-    Cases_on `e''` >>
-    rw [] >>
-    fs [] >>
-    rfs [] >>
-    rw [] >>
-    fs [] >>
-    rfs []
-    >- (
-      first_x_assum drule >>
-      disch_then drule >>
-      rw [] >>
-      first_x_assum drule >>
-      disch_then drule >>
-      disch_then drule >>
-      disch_then drule >>
-      rw [])
-    >- (
-      first_x_assum drule >>
-      disch_then drule >>
-      rw []))
-  >- (
-    rename1 `evaluate _ _ _ = (s1', r')` >>
-    Cases_on `r'` >>
-    fs [] >>
-    rw [] >>
-    res_tac >>
-    fs [] >>
-    rw [] >>
-    fs [compile_reverse] >>
-    rw [] >>
-    simp [Once v_rel_cases, libTheory.the_def])
-  >- (
-    rename1 `evaluate _ _ _ = (s1', r')` >>
-    Cases_on `r'` >>
-    fs [] >>
-    rw [] >>
-    res_tac >>
-    fs [] >>
-    rw [] >>
-    fs [compile_reverse] >>
-    rw [] >>
-    simp [Once v_rel_cases, libTheory.the_def])
- >- (
-    every_case_tac >>
-    fs [LIST_REL_def] >>
-    metis_tac [alookup_env_rel, NOT_SOME_NONE, SOME_11])
-  >- (
-    simp [Once v_rel_cases] >>
-    fs [env_rel_cases])
-  >- (
-    fs [] >>
-    rename [`evaluate _ _ _ = (s', r')`,
-            `evaluate env1 _ (REVERSE (compile _)) = (s1', r1')`] >>
-    Cases_on `r'` >>
-    fs [] >>
-    rw [] >>
-    fs []
-    >- (
-      Cases_on `op = Opapp` >>
-      fs []
-      >- (
-        rename1 `do_opapp (REVERSE vs)` >>
-        Cases_on `do_opapp (REVERSE vs)` >>
-        fs [] >>
-        rw [] >>
-        split_pair_case_tac >>
-        fs [] >>
-        res_tac >>
-        fs [] >>
-        rw [] >>
-        Cases_on `s'.clock = 0` >>
-        fs [compile_reverse] >>
-        rw [] >>
-        `LIST_REL v_rel (REVERSE vs) (REVERSE v')` by metis_tac [EVERY2_REVERSE] >>
-        imp_res_tac do_opapp_correct >>
-        rw []
-        >- fs [s_rel_cases]
-        >- fs [s_rel_cases]
-        >- fs [s_rel_cases] >>
-        `env_rel <|v := env'|> <|v := env''|>` by fs [env_rel_cases] >>
-        `s_rel (dec_clock s') (dec_clock s1')` by fs [dec_clock_def,s_rel_cases] >>
-        res_tac >>
-        rw [] >>
-        metis_tac [HD, compile_sing])
-      >- (
-        first_x_assum drule
-        \\ disch_then drule
-        \\ strip_tac
-        \\ rveq \\ fs[]
-        \\ qpat_x_assum`_ = (_, r)`mp_tac
-        \\ TOP_CASE_TAC \\ strip_tac \\ fs[pair_case_eq]
-        \\ imp_res_tac EVERY2_REVERSE
-        \\ drule do_app_correct
-        \\ disch_then drule
-        \\ rveq
-        \\ fs[s_rel_cases] \\ rfs[]
-        \\ disch_then drule
-        \\ strip_tac
-        \\ goal_assum (first_assum o mp_then Any mp_tac)
-        \\ fs[compile_reverse]
-        \\ rveq \\ fs[]))
-    >- (
-      res_tac >>
-      fs [compile_reverse] >>
-      rw []))
-  >- (
-    rename1 `evaluate _ _ _ = (s1', r')` >>
-    Cases_on `r'` >>
-    fs [] >>
-    rw []
-    >- (
-      imp_res_tac evaluate_sing >>
-      rw [] >>
-      fs [] >>
-      rename1 `do_if v e2 e3` >>
-      Cases_on `do_if v e2 e3` >>
-      fs [] >>
-      first_x_assum drule >>
-      disch_then drule >>
-      rw [] >>
-      fs [] >>
-      `?e'. compile [e1] = [e']` by metis_tac [compile_sing] >>
-      fs [] >>
-      rw [] >>
-      fs [do_if_def] >>
-      Cases_on `v = Boolv T` >>
-      fs [v_rel_bool]
-      >- metis_tac [compile_sing, HD] >>
-      rfs [v_rel_bool] >>
-      metis_tac [compile_sing, HD])
-    >- (
-      `?e'. compile [e1] = [e']` by metis_tac [compile_sing] >>
-      res_tac >>
-      fs [] >>
-      rw [] >>
-      rfs []))
-  >- (
-    every_case_tac >>
-    fs [] >>
-    imp_res_tac evaluate_sing >>
-    rw [] >>
-    `?e'. compile [e] = [e']` by metis_tac [compile_sing] >>
-    res_tac >>
-    fs [] >>
-    rw [] >>
-    rfs [] >>
-    metis_tac[v_rel_eqn] )
-  >- (
-    reverse(fsrw_tac[DNF_ss][case_eq_thms, compile_HD_sing] \\ rveq \\ fs[])
-    \\ first_x_assum drule \\ disch_then drule
-    \\ strip_tac \\ fs[] \\ rveq
-    >- metis_tac[]
-    \\ fs[]
-    \\ first_x_assum match_mp_tac
-    \\ fs[env_rel_cases, libTheory.opt_bind_def]
-    \\ CASE_TAC \\ fs[]
-    \\ imp_res_tac evaluate_sing \\ fs[] )
-  >- (
-    fs[compile_HD_sing]
-    \\ first_x_assum match_mp_tac
-    \\ fs[env_rel_cases]
-    \\ fs[build_rec_env_merge]
-    \\ match_mp_tac EVERY2_APPEND_suff
-    \\ fs[MAP_MAP_o, o_DEF, UNCURRY, EVERY2_MAP]
-    \\ simp[Once v_rel_cases]
-    \\ fs[EVERY2_refl] )
-  >- fs[MAP_MAP_o,o_DEF,UNCURRY,ETA_AX]
-  >- (
-    drule(CONJUNCT1 pmatch_correct)
-    \\ disch_then(qspecl_then[`p`,`v`,`[]`]mp_tac) >>
-    disch_then drule >>
-    fs [] >>
-    impl_tac >- (every_case_tac >> fs []) >>
-    TOP_CASE_TAC \\ fs[]
-    \\ strip_tac \\ rfs[]
-    \\ fs[compile_HD_sing]
-    \\ first_x_assum match_mp_tac
-    \\ fs[env_rel_cases]
-    \\ match_mp_tac EVERY2_APPEND_suff
-    \\ fs[]
-    \\ fs[LIST_REL_EL_EQN,Once LIST_EQ_REWRITE,UNCURRY,EL_MAP]));
-
-val dec_res_rel_def = Define `
-  (dec_res_rel NONE NONE <=> T) /\
-  (dec_res_rel (SOME r1) (SOME r2) <=>
-     result_rel (LIST_REL v_rel) v_rel (Rerr r1) (Rerr r2)) /\
-  (dec_res_rel _ _ <=> F)`;
-
-Theorem dec_res_rel_thms[simp]:
-   (!r. dec_res_rel NONE r <=> r = NONE) /\
-   (!r. dec_res_rel r NONE <=> r = NONE) /\
-   (!e r. dec_res_rel (SOME e) r <=>
-      ?e1. r = SOME e1 /\
-           result_rel (LIST_REL v_rel) v_rel (Rerr e) (Rerr e1)) /\
-   (!e r. dec_res_rel r (SOME e) <=>
-      ?e1. r = SOME e1 /\
-           result_rel (LIST_REL v_rel) v_rel (Rerr e1) (Rerr e))
-Proof
-  rw [] \\ Cases_on `r` \\ rw [dec_res_rel_def]
-QED
-
-Theorem compile_dec_correct:
-   ∀(s : 'a flatSem$state) d s' r s1.
-    evaluate_dec s d = (s',r) ∧
-    r ≠ SOME (Rabort Rtype_error) ∧
-    s_rel s s1
-    ⇒
-    ?s1' r1.
-      dec_res_rel r r1 ∧
-      s_rel s' s1' ∧
-      evaluate_decs s1 (compile_decs [d]) = (s1', r1)
-Proof
-  Cases_on `d` >>
-  simp [evaluate_decs_def, evaluate_dec_def, compile_decs_def] >>
-  rpt gen_tac
-  >- (
-    ntac 2 TOP_CASE_TAC >>
-    fs []
-    >| [TOP_CASE_TAC, all_tac] >>
-    rw [] >>
-    drule (List.nth (CONJUNCTS compile_exp_correct, 0)) >>
-    rw [] >>
-    `env_rel <|v := []|> <|v := []|>` by fs [env_rel_cases] >>
-    first_x_assum drule >>
-    disch_then drule >>
-    rw [] >>
-    `?e'. compile [e] = [e']` by metis_tac [compile_sing] >>
-    fs [] >>
-    every_case_tac >>
-    fs [] >>
-    rw [] >>
-    fs [Once v_rel_cases, libTheory.the_def] >>
-    rw [] >>
-    fs [Unitv_def, env_rel_cases] >>
-    rw [] >>
-    fs [] >>
-    rfs [libTheory.the_def, s_rel_cases]) >>
-  fs [s_rel_cases] >>
-  rw [] >>
-  rw []
-QED
-
-Theorem compile_decs_correct:
-   ∀env (s : 'a flatSem$state) ds s' r s1.
-    evaluate_decs s ds = (s',r) ∧
-    r ≠ SOME (Rabort Rtype_error) ∧
-    s_rel s s1
-    ⇒
-    ?s1' r1.
-      dec_res_rel r r1 ∧
-      s_rel s' s1' ∧
-      evaluate_decs s1 (compile_decs ds) = (s1', r1)
-Proof
-  Induct_on `ds` >>
-  rw [evaluate_decs_def, compile_decs_def] >>
-  rw [] >>
-  split_pair_case_tac >>
-  fs [] >>
-  drule compile_dec_correct >>
-  every_case_tac >>
-  fs []
-  >- (
-    disch_then drule >>
-    rw [] >>
-    first_x_assum drule >>
-    simp [] >>
-    disch_then drule >>
-    rw [] >>
-    qexists_tac `s1'` >>
-    qexists_tac `r1` >>
-    rw [] >>
-    Cases_on `h` >>
-    fs [compile_decs_def, evaluate_decs_def] >>
-    every_case_tac >>
-    fs [lemma] >>
-    rw [])
-  >- (
-    rveq >>
-    fs [] >>
-    disch_then drule >>
-    rw [] >>
-    qexists_tac `s1''` >>
-    qexists_tac `SOME e1` >>
-    rw [] >>
-    Cases_on `h` >>
-    fs [compile_decs_def, evaluate_decs_def] >>
-    every_case_tac >>
-    fs [])
-QED
-
-Theorem compile_decs_eval_sim:
-   eval_sim
-     (ffi:'ffi ffi$ffi_state) T T ds1 T F
-     (compile_decs ds1)
-     (\p1 p2. p2 = compile_decs p1) F
-Proof
-  rw [eval_sim_def]
-  \\ qexists_tac `0`
-  \\ CONV_TAC (RESORT_EXISTS_CONV rev)
-  \\ drule compile_decs_correct >>
-  simp [] >>
-  disch_then (qspec_then `initial_state ffi k T F` mp_tac) >>
-  impl_tac
-  >- fs [initial_state_def, s_rel_cases]
-  \\ rw [] >>
-  rw [] >>
-  fs [s_rel_cases]
-QED ;
-
-val compile_decs_semantics = save_thm ("compile_decs_semantics",
-  MATCH_MP (REWRITE_RULE [GSYM AND_IMP_INTRO] IMP_semantics_eq)
-           compile_decs_eval_sim
-  |> DISCH_ALL
-  |> SIMP_RULE (srw_ss()) [AND_IMP_INTRO]);
-
-(* syntactic results *)
-
-Theorem compile_elist_globals_eq_empty:
-   !es. elist_globals es = {||} ==> elist_globals (compile es) = {||}
-Proof
-  ho_match_mp_tac compile_ind
-  \\ rw [compile_def]
-  \\ TRY
-    (rename1 `HD (compile [e])`
-     \\ qspec_then `e` assume_tac compile_sing \\ fs [] \\ fs [])
-  \\ fs [MAP_MAP_o, o_DEF, UNCURRY, elist_globals_append]
-  \\ TRY
-   (map_every (fn tm => qspec_then tm assume_tac compile_sing) [`e1`,`e2`,`e3`]
-    \\ fs [] \\ fs []
-    \\ NO_TAC)
-  \\ pop_assum mp_tac
-  \\ ntac 2 (pop_assum kall_tac)
-  \\ pop_assum mp_tac
-  \\ rename1 `elist_globals (MAP _ xs)`
-  \\ Induct_on `xs` \\ fs [FORALL_PROD] \\ rw []
-  \\ first_x_assum(fn th => mp_tac th \\ impl_tac >- METIS_TAC[])
-  \\ fsrw_tac [DNF_ss] [SUB_BAG_UNION] \\ rw []
-  \\ rename1 `HD (compile [e])`
-  \\ qspec_then `e` assume_tac compile_sing \\ fs [] \\ fs []
-QED
-
-Theorem compile_set_globals_eq_empty:
-   set_globals e = {||} ==> set_globals (HD (compile [e])) = {||}
-Proof
-  qspec_then`[e]`mp_tac compile_elist_globals_eq_empty
-  \\ rw[] \\ fs[] \\ Cases_on `compile [e]` \\ fs []
-QED
-
-Theorem compile_esgc_free:
-   !es. EVERY esgc_free es ==> EVERY esgc_free (compile es)
-Proof
-  ho_match_mp_tac compile_ind
-  \\ rw [compile_def]
-  \\ fs [compile_set_globals_eq_empty]
-  \\ TRY
-    (rename1 `compile [e]`
-     \\ qspec_then `e` assume_tac compile_sing \\ fs [] \\ fs [])
-  \\ fs [EVERY_MAP, EVERY_MEM, FORALL_PROD, elist_globals_eq_empty]
-  \\ fs [MEM_MAP, MAP_MAP_o, PULL_EXISTS, FORALL_PROD]
-  \\ rw []
-  \\ TRY(
-    match_mp_tac compile_set_globals_eq_empty
-    \\ res_tac )
-  \\ rename1 `HD (compile [p])`
-   \\ qspec_then `p` assume_tac compile_sing \\ fs [] \\ fs []
-  \\ res_tac \\ fs []
-QED
-
-Theorem compile_decs_esgc_free:
-   ∀ds. EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet ds)) ⇒
-        EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet (flat_uncheck_ctors$compile_decs ds)))
-Proof
-  Induct \\ simp[flat_uncheck_ctorsTheory.compile_decs_def]
-  \\ Cases \\ simp[] \\ rw[] \\ fs[flat_uncheck_ctorsTheory.compile_decs_def]
-  \\ qspec_then`[e]`mp_tac compile_esgc_free
-  \\ strip_assume_tac (SPEC_ALL flat_uncheck_ctorsTheory.compile_sing)
-  \\ rw[]
-QED
-
-Theorem compile_sub_bag:
-   !es. (elist_globals (compile es)) ≤ (elist_globals es)
-Proof
-  ho_match_mp_tac compile_ind
-  \\ rw [compile_def]
-  \\ TRY
-    (rename1 `compile [e]`
-     \\ qspec_then `e` assume_tac compile_sing \\ fs [] \\ fs [])
-  \\ TRY
-   (map_every (fn tm => qspec_then tm assume_tac compile_sing) [`e1`,`e2`,`e3`]
-    \\ fs [] \\ fs []
-    \\ fs [SUB_BAG_UNION]
-    \\ NO_TAC)
-  \\ fs [SUB_BAG_UNION, elist_globals_append] \\ rfs []
-  \\ fs [MAP_MAP_o, UNCURRY, o_DEF] \\ fs [LAMBDA_PROD]
-  \\ (FIRST
-    (map (fn th => match_mp_tac (MP_CANON th) \\ conj_tac >- simp[])
-         (CONJUNCTS SUB_BAG_UNION)))
-  \\  rename1 `elist_globals (MAP _ xs)`
-  \\ ntac 2 (pop_assum kall_tac)
-  \\ pop_assum mp_tac
-  \\ Induct_on `xs` \\ fs [FORALL_PROD] \\ rw []
-  \\ first_x_assum(fn th => mp_tac th \\ impl_tac >- METIS_TAC[])
-  \\ fsrw_tac [DNF_ss] [SUB_BAG_UNION] \\ rw []
-  \\ rename1 `HD (compile [e])`
-  \\ qspec_then `e` assume_tac compile_sing \\ fs [] \\ fs []
-  \\ fsrw_tac [DNF_ss] [SUB_BAG_UNION]
-QED
-
-Theorem compile_distinct_globals:
-   BAG_ALL_DISTINCT (elist_globals es)
-   ==>
-   BAG_ALL_DISTINCT (elist_globals (compile es))
-Proof
-  metis_tac [compile_sub_bag, BAG_ALL_DISTINCT_SUB_BAG]
-QED
-
-Theorem compile_decs_sub_bag:
-   (elist_globals (MAP dest_Dlet (FILTER is_Dlet (flat_uncheck_ctors$compile_decs ds)))) ≤ (elist_globals (MAP dest_Dlet (FILTER is_Dlet ds)))
-Proof
-  Induct_on`ds` \\ rw [flat_uncheck_ctorsTheory.compile_decs_def]
-  \\ fs [UNCURRY] \\ rw []
-  \\ Cases_on `h` \\ fs [flat_uncheck_ctorsTheory.compile_decs_def]
-  \\ qspec_then `e` assume_tac flat_uncheck_ctorsTheory.compile_sing \\ fs []
-  \\ `elist_globals [e2] <= elist_globals [e]`
-    by metis_tac [compile_sub_bag]
-  \\ fs [SUB_BAG_UNION]
-QED
-
-Theorem compile_decs_distinct_globals:
-   BAG_ALL_DISTINCT (elist_globals (MAP dest_Dlet (FILTER is_Dlet ds))) ⇒
-   BAG_ALL_DISTINCT (elist_globals (MAP dest_Dlet (FILTER is_Dlet (flat_uncheck_ctors$compile_decs ds))))
-Proof
-  metis_tac [compile_decs_sub_bag, BAG_ALL_DISTINCT_SUB_BAG]
-QED
-
-val _ = export_theory ();
diff --git a/compiler/backend/proofs/pat_to_closProofScript.sml b/compiler/backend/proofs/pat_to_closProofScript.sml
deleted file mode 100644
index 49a62c3f39..0000000000
--- a/compiler/backend/proofs/pat_to_closProofScript.sml
+++ /dev/null
@@ -1,829 +0,0 @@
-(*
-  Correctness proof for pat_to_clos
-*)
-open preamble intLib integerTheory backendPropsTheory
-     semanticPrimitivesTheory
-     patSemTheory patPropsTheory pat_to_closTheory
-     closLangTheory closSemTheory closPropsTheory
-
-val _ = new_theory"pat_to_closProof"
-
-val _ = set_grammar_ancestry
-  ["patLang", "patSem", "patProps", "pat_to_clos",
-   "closLang", "closSem", "closProps"];
-val drule = old_drule
-
-(* value translation *)
-
-val compile_v_def = tDefine"compile_v"`
-  (compile_v (Litv (IntLit i)) = (Number i):closSem$v) ∧
-  (compile_v (Litv (Word8 w)) = (Number (& (w2n w)))) ∧
-  (compile_v (Litv (Word64 w)) = (Word64 w)) ∧
-  (compile_v (Litv (Char c)) = (Number (& ORD c))) ∧
-  (compile_v (Litv (StrLit s)) = (ByteVector (MAP (n2w o ORD) s))) ∧
-  (compile_v (Loc m) = (RefPtr m)) ∧
-  (compile_v (Conv cn vs) = (Block cn (MAP (compile_v) vs))) ∧
-  (compile_v (Vectorv vs) = (Block vector_tag (MAP (compile_v) vs))) ∧
-  (compile_v (Closure vs e) = (Closure NONE [] (MAP (compile_v) vs) 1 (compile e))) ∧
-  (compile_v (Recclosure vs es k) = (Recclosure NONE [] (MAP (compile_v) vs) (MAP (λe. (1,compile e)) es) k))`
-    (WF_REL_TAC`measure (patSem$v_size)` >> simp[patSemTheory.v_size_def] >>
-     rpt conj_tac >> rpt gen_tac >>
-     Induct_on`vs` >> simp[patSemTheory.v_size_def] >>
-     rw[] >> res_tac >> fs[] >> simp[patSemTheory.v_size_def])
-val _ = export_rewrites["compile_v_def"]
-
-val compile_sv_def = Define `
-  (compile_sv (Refv v) = ValueArray [compile_v v]) ∧
-  (compile_sv (Varray vs) = ValueArray (MAP compile_v vs)) ∧
-  (compile_sv (W8array bs) = ByteArray F bs)`
-val _ = export_rewrites["compile_sv_def"];
-
-val compile_state_def = Define`
-  compile_state max_app cc (s:('c,'ffi) patSem$state) =
-    <| globals := MAP (OPTION_MAP compile_v) s.globals;
-       refs := alist_to_fmap (GENLIST (λi. (i, compile_sv (EL i s.refs))) (LENGTH s.refs));
-       ffi := s.ffi;
-       clock := s.clock;
-       code := FEMPTY;
-       compile := cc;
-       compile_oracle := pure_co (λes. (MAP compile es,[])) o s.compile_oracle;
-       max_app := max_app
-    |>`;
-
-Theorem compile_state_const[simp]:
-   (compile_state max_app cc s).clock = s.clock ∧
-   (compile_state max_app cc s).ffi = s.ffi ∧
-   (compile_state max_app cc s).compile = cc ∧
-   (compile_state max_app cc s).max_app = max_app ∧
-   (compile_state max_app cc s).compile_oracle = pure_co (λe. (MAP compile e,[])) o s.compile_oracle
-Proof
-  EVAL_TAC
-QED
-
-Theorem compile_state_dec_clock[simp]:
-   compile_state max_app cc (dec_clock y) = dec_clock 1 (compile_state max_app cc y)
-Proof
-  EVAL_TAC >> simp[]
-QED
-
-Theorem compile_state_with_clock[simp]:
-   compile_state max_app cc (s with clock := k) = compile_state max_app cc s with clock := k
-Proof
-  EVAL_TAC >> simp[]
-QED
-
-Theorem compile_state_with_refs_const[simp]:
-   (compile_state w cc (s with refs := r)).globals = (compile_state w cc s).globals ∧
-   (compile_state w cc (s with refs := r)).code = (compile_state w cc s).code
-Proof
-  EVAL_TAC
-QED
-
-Theorem FLOOKUP_compile_state_refs:
-   FLOOKUP (compile_state w cc s).refs =
-   OPTION_MAP compile_sv o (combin$C store_lookup s.refs)
-Proof
-  rw[FUN_EQ_THM,compile_state_def,ALOOKUP_GENLIST,store_lookup_def] \\ rw[]
-QED
-
-Theorem FDOM_compile_state_refs[simp]:
-   FDOM (compile_state w cc s).refs = count (LENGTH s.refs)
-Proof
-  rw[compile_state_def,MAP_GENLIST,o_DEF,LIST_TO_SET_GENLIST]
-QED
-
-Theorem compile_state_with_refs_snoc:
-   compile_state w cc (s with refs := s.refs ++ [x]) =
-   compile_state w cc s with refs :=
-     (compile_state w cc s).refs |+ (LENGTH s.refs, compile_sv x)
-Proof
-  rw[compile_state_def,fmap_eq_flookup,FLOOKUP_UPDATE,ALOOKUP_GENLIST]
-  \\ rw[EL_APPEND1,EL_APPEND2]
-QED
-
-(* semantic functions respect translation *)
-
-Theorem do_eq:
-   (∀v1 v2. do_eq v1 v2 ≠ Eq_type_error ⇒
-      (do_eq v1 v2 = do_eq (compile_v v1) (compile_v v2))) ∧
-    (∀vs1 vs2. do_eq_list vs1 vs2 ≠ Eq_type_error ⇒
-      (do_eq_list vs1 vs2 = do_eq_list (MAP compile_v vs1) (MAP compile_v vs2)))
-Proof
-  ho_match_mp_tac patSemTheory.do_eq_ind >>
-  simp[patSemTheory.do_eq_def,closSemTheory.do_eq_def] >>
-  conj_tac >- (
-    Cases >> Cases >> simp[lit_same_type_def,closSemTheory.do_eq_def] >>
-    rw[LIST_EQ_REWRITE,EL_MAP,EQ_IMP_THM] \\ rfs[EL_MAP] \\ res_tac
-    \\ fs[ORD_11,ORD_BOUND]) >>
-  conj_tac >- rw[ETA_AX] >>
-  conj_tac >- rw[ETA_AX] >>
-  rw[] >>
-  Cases_on`v1`>>fs[]>>TRY(Cases_on`l:lit`>>fs[])>>
-  Cases_on`v2`>>fs[]>>TRY(Cases_on`l:lit`>>fs[])>>
-  fs[closSemTheory.do_eq_def,patSemTheory.do_eq_def,lit_same_type_def,ORD_11] >>
-  rw[]>>fs[]>>rfs[ETA_AX]>>
-  BasicProvers.CASE_TAC>>fs[]>>
-  rw[]>>fs[]>>
-  BasicProvers.CASE_TAC>>fs[]
-QED
-
-val v_to_list_def = closSemTheory.v_to_list_def;
-
-Theorem v_to_char_list:
-   ∀v ls. (v_to_char_list v = SOME ls) ⇒
-           (v_to_list (compile_v v) = SOME (MAP (Number o $& o ORD) ls))
-Proof
-  ho_match_mp_tac v_to_char_list_ind >>
-  simp[v_to_char_list_def,v_to_list_def] >>
-  rw[] >>
-  Cases_on`v`>>fs[v_to_char_list_def] >>
-  Cases_on`l`>>fs[v_to_char_list_def,v_to_list_def] >>
-  rw[]>>fs[]>>
-  Cases_on`h`>>fs[v_to_char_list_def,v_to_list_def] >>
-  Cases_on`l`>>fs[v_to_char_list_def,v_to_list_def] >>
-  Cases_on`t`>>fs[v_to_char_list_def,v_to_list_def] >>
-  Cases_on`t'`>>fs[v_to_char_list_def,v_to_list_def] >>
-  rw[]>>fs[]>>
-  Cases_on`v_to_char_list h`>>fs[]>> rw[]
-QED
-
-Theorem v_to_list:
-   ∀v ls. (v_to_list v = SOME ls) ⇒
-           (v_to_list (compile_v v) = SOME (MAP compile_v ls))
-Proof
-  ho_match_mp_tac patSemTheory.v_to_list_ind >>
-  simp[patSemTheory.v_to_list_def,v_to_list_def] >>
-  rw[] >> Cases_on`v_to_list v`>>fs[]>> rw[]
-QED
-
-Theorem vs_to_string:
-   ∀vs ws. vs_to_string vs = SOME ws ⇒
-    ∃wss. MAP compile_v vs = MAP ByteVector wss ∧
-      FLAT wss = MAP (n2w o ORD) ws
-Proof
-  ho_match_mp_tac vs_to_string_ind
-  \\ rw[vs_to_string_def]
-  \\ every_case_tac \\ fs[] \\ rveq
-  \\ qmatch_goalsub_abbrev_tac`ByteVector ws1`
-  \\ qexists_tac`ws1::wss` \\ simp[]
-QED
-
-Theorem Boolv[simp]:
-   compile_v (Boolv b) = Boolv b
-Proof
-  Cases_on`b`>>EVAL_TAC
-QED
-
-Theorem v_to_bytes:
-   v_to_bytes v = SOME ls ==> v_to_bytes (compile_v v) = SOME ls
-Proof
-  simp[patSemTheory.v_to_bytes_def,v_to_bytes_def]
-  \\ DEEP_INTRO_TAC some_intro \\ rw[]
-  \\ imp_res_tac v_to_list
-  \\ rw[MAP_MAP_o,o_DEF]
-  \\ DEEP_INTRO_TAC some_intro \\ rw[]
-  \\ imp_res_tac INJ_MAP_EQ \\ fs[INJ_DEF]
-  \\ metis_tac[]
-QED
-
-Theorem v_to_words:
-   v_to_words v = SOME ls ==> v_to_words (compile_v v) = SOME ls
-Proof
-  simp[patSemTheory.v_to_words_def,v_to_words_def]
-  \\ DEEP_INTRO_TAC some_intro \\ rw[]
-  \\ imp_res_tac v_to_list
-  \\ rw[MAP_MAP_o,o_DEF]
-  \\ DEEP_INTRO_TAC some_intro \\ rw[ETA_AX]
-  \\ imp_res_tac INJ_MAP_EQ \\ fs[INJ_DEF]
-  \\ metis_tac[]
-QED
-
-Theorem do_install:
-   patSem$do_install vs s = SOME (v1,v2) ∧
-   s.compile = pure_cc (λe. (MAP compile e,[])) cc
-   ==>
-   closSem$do_install (MAP compile_v vs) (compile_state max_app cc s) =
-     if s.clock = 0 then (Rerr (Rabort Rtimeout_error),compile_state max_app cc v2)
-     else (Rval (MAP compile v1),dec_clock 1(compile_state max_app cc v2))
-Proof
-  simp[do_install_def,patSemTheory.do_install_def,case_eq_thms]
-  \\ simp[] \\ strip_tac \\ rveq \\ fs[]
-  \\ imp_res_tac v_to_bytes \\ imp_res_tac v_to_words
-  \\ rpt(pairarg_tac \\ fs[])
-  \\ fs[pure_co_def] \\ rveq
-  \\ rfs[pure_cc_def]
-  \\ fs[case_eq_thms,pair_case_eq,shift_seq_def,FUPDATE_LIST_THM] \\ rveq
-  \\ fs[bool_case_eq,dec_clock_def]
-  \\ fs[state_component_equality,compile_state_def,pure_co_def,FUN_EQ_THM]
-QED
-
-(* compiler correctness *)
-
-val true_neq_false = EVAL``true_tag = false_tag`` |> EQF_ELIM;
-
-val arw = srw_tac[ARITH_ss]
-
-val do_app_def = closSemTheory.do_app_def
-
-val build_rec_env_pat_def = patSemTheory.build_rec_env_def
-val do_opapp_pat_def = patSemTheory.do_opapp_def
-val do_app_pat_def = patSemTheory.do_app_def
-val evaluate_def = closSemTheory.evaluate_def
-val evaluate_pat_def = patSemTheory.evaluate_def;
-
-val s = mk_var("s",
-  ``patSem$evaluate`` |> type_of |> strip_fun |> #1 |> el 2
-  |> type_subst[alpha |-> gamma, beta |-> ``:'ffi``]);
-
-val LENGTH_eq = Q.prove(
-  `(LENGTH ls = 1 ⇔ ∃y. ls = [y]) ∧
-   (LENGTH ls = 2 ⇔ ∃y z. ls = [y; z]) ∧
-   (LENGTH ls = 0 ⇔ ls = []) ∧
-   (0 = LENGTH ls ⇔ LENGTH ls = 0) ∧
-   (1 = LENGTH ls ⇔ LENGTH ls = 1) ∧
-   (2 = LENGTH ls ⇔ LENGTH ls = 2)`,
-  Cases_on`ls`>>simp[]>> Cases_on`t`>>simp[LENGTH_NIL]);
-
-Theorem list_to_v_compile:
-   !x xs.
-   v_to_list x = SOME xs /\
-   v_to_list (compile_v x) = SOME (MAP compile_v xs) ==>
-     list_to_v (MAP compile_v xs) = compile_v (list_to_v xs)
-Proof
-  ho_match_mp_tac patSemTheory.v_to_list_ind
-  \\ rw [patSemTheory.v_to_list_def] \\ fs []
-  \\ fs [list_to_v_def, patSemTheory.list_to_v_def, case_eq_thms] \\ rveq
-  \\ fs [v_to_list_def, case_eq_thms, list_to_v_def, patSemTheory.list_to_v_def]
-QED
-
-Theorem list_to_v_compile_APPEND:
-   !xs ys.
-     list_to_v (MAP compile_v xs) = compile_v (list_to_v xs) /\
-     list_to_v (MAP compile_v ys) = compile_v (list_to_v ys) ==>
-       list_to_v (MAP compile_v (xs ++ ys)) =
-       compile_v (list_to_v (xs ++ ys))
-Proof
-  Induct \\ rw [patSemTheory.list_to_v_def]
-  \\ fs [list_to_v_def, patSemTheory.list_to_v_def]
-QED
-
-Theorem dest_WordToInt_SOME:
-   !w es x. dest_WordToInt w es = SOME x <=>
-             ?tra. es = [App tra (Op (WordToInt w)) [x]]
-Proof
-  ho_match_mp_tac dest_WordToInt_ind
-  \\ fs [dest_WordToInt_def]
-QED
-
-val Rabort_Rtype_error_map_error = prove(
-  ``Rabort Rtype_error = map_error_result compile_v e <=>
-    e = Rabort Rtype_error``,
-  Cases_on `e` \\ fs [] \\ eq_tac \\ rw []);
-
-val do_app_WordToInt_Rerr_IMP = prove(
-  ``closSem$do_app WordToInt ws x = Rerr e ==> e = Rabort Rtype_error``,
-  fs [do_app_def,case_eq_thms,pair_case_eq] \\ rw [] \\ fs []);
-
-Theorem compile_evaluate:
-   0 < max_app ⇒
-   (∀env ^s es s' r.
-      evaluate env s es = (s',r) ∧
-      s.compile = pure_cc (λe. (MAP pat_to_clos$compile e,[])) cc ∧
-      r ≠ Rerr (Rabort Rtype_error) ⇒
-      evaluate (MAP compile es,MAP compile_v env,compile_state max_app cc s) =
-        (map_result (MAP compile_v) compile_v r, compile_state max_app cc s'))
-Proof
-  strip_tac >>
-  ho_match_mp_tac patSemTheory.evaluate_ind >>
-  strip_tac >- (rw[evaluate_pat_def,evaluate_def]>>rw[]) >>
-  strip_tac >- (
-    rpt gen_tac >> strip_tac >>
-    rpt gen_tac >> strip_tac >>
-    qpat_x_assum`_ = (_,_)`mp_tac >>
-    simp[Once evaluate_cons] >>
-    split_pair_case_tac >> fs[] >>
-    simp[Once evaluate_CONS] >> strip_tac >>
-    fs[case_eq_thms,pair_case_eq] \\ rveq \\ fs[] >>
-    imp_res_tac patPropsTheory.evaluate_const \\ fs[] \\
-    imp_res_tac evaluate_sing >> rw[] >>fs[] >> rfs[]) >>
-  strip_tac >- (
-    Cases_on`l`>>
-    rw[evaluate_def,do_app_def] >> rw[] >>
-    simp[GSYM MAP_REVERSE,evaluate_MAP_Op_Const,combinTheory.o_DEF]) >>
-  strip_tac >- (
-    rw[evaluate_def,evaluate_pat_def,case_eq_thms,pair_case_eq] >>
-    imp_res_tac evaluate_const \\ fs[] \\
-    imp_res_tac evaluate_sing >> fs[]) >>
-  strip_tac >- (
-    rw[evaluate_def,evaluate_pat_def,case_eq_thms,pair_case_eq] >>
-    imp_res_tac patPropsTheory.evaluate_const \\ fs[] ) >>
-  strip_tac >- (
-    rw[evaluate_pat_def,evaluate_def,do_app_def,case_eq_thms,pair_case_eq] >>
-    fs[ETA_AX,MAP_REVERSE] ) >>
-  strip_tac >- (
-    rw[evaluate_pat_def,evaluate_def,EL_MAP] >> rw[] >>
-    spose_not_then strip_assume_tac >> rw[] >> fs[]) >>
-  strip_tac >- (
-    rw[evaluate_pat_def,evaluate_def] >> rw[ETA_AX] ) >>
-  strip_tac >- (
-    rw[evaluate_def,evaluate_pat_def] >>
-    Cases_on`op=(Op Opapp)`>>fs[] >- (
-      split_pair_case_tac >> fs[] >>
-      qmatch_assum_rename_tac `_ = (s1,r1)` >>
-      reverse(Cases_on`r1`)>>fs[] >- (
-        rw[]>>fs[evaluate_def,MAP_REVERSE,ETA_AX] >>
-        Cases_on`es`>>fs[] >> Cases_on`t`>>fs[LENGTH_NIL] >>
-        fs[Once evaluate_CONS] >>
-        fs[pair_case_eq,case_eq_thms] >> rw[] >>
-        fs[evaluate_def] ) >>
-      imp_res_tac evaluate_length >>
-      fs[MAP_REVERSE,ETA_AX] >>
-      IF_CASES_TAC >> fs[LENGTH_eq] >- (
-        simp[evaluate_def,do_app_def] >>
-        fs[case_eq_thms,pair_case_eq,bool_case_eq,do_opapp_def,SWAP_REVERSE_SYM] >>
-        rw[] >> fs[LENGTH_eq]) >>
-      rpt var_eq_tac >> fs[LENGTH_eq] >> var_eq_tac >>
-      simp[evaluate_def] >>
-      fs[Once evaluate_CONS] >>
-      split_pair_case_tac >> fs[] >>
-      fs[evaluate_def] >>
-      pop_assum mp_tac >>
-      split_pair_case_tac >> fs[] >>
-      BasicProvers.CASE_TAC >> fs[] >> strip_tac >>
-      rpt var_eq_tac >> fs[] >>
-      split_pair_case_tac >> fs[] >>
-      BasicProvers.CASE_TAC >> fs[] >> rpt var_eq_tac >>
-      imp_res_tac evaluate_IMP_LENGTH >> fs[LENGTH_eq] >> rw[] >>
-      qmatch_assum_rename_tac`_ = (s1,Rval [d; c])` >>
-      Cases_on`do_opapp [c; d]`>>fs[] >>
-      split_pair_case_tac >> fs[] >>
-      rpt var_eq_tac >>
-      fs[bool_case_eq] >- (
-        simp[evaluate_def] >> fs[do_opapp_def] >>
-        Cases_on`c`>>fs[dest_closure_def,check_loc_def,LET_THM] >>
-        simp[state_component_equality,EL_MAP]) >>
-      simp[evaluate_def] >> fs[do_opapp_def] >>
-      imp_res_tac patPropsTheory.evaluate_const >>
-      Cases_on`c`>>fs[dest_closure_def,check_loc_def,EL_MAP,LET_THM,ETA_AX] >>simp[] >>
-      rpt var_eq_tac >> fs[build_rec_env_pat_def,patSemTheory.dec_clock_def,closSemTheory.dec_clock_def] >>
-      split_pair_case_tac >> fs[] >>
-      fs[MAP_GENLIST,o_DEF,ETA_AX] >>
-      fsrw_tac[boolSimps.ETA_ss][] >>
-      qpat_x_assum`(_,_) = _`(assume_tac o SYM) >> fs[] >>
-      BasicProvers.CASE_TAC >> fs[] >>
-      imp_res_tac evaluate_IMP_LENGTH >> fs[LENGTH_eq] >>
-      simp[evaluate_def] >> rw[] >>
-      imp_res_tac evaluate_IMP_LENGTH >> fs[LENGTH_eq] ) >>
-    Cases_on`op = Run` \\ fs[] >- (
-      split_pair_case_tac \\ fs[] \\
-      fs[evaluate_def,MAP_REVERSE,ETA_AX] \\
-      first_x_assum(fn th => mp_tac th \\ (impl_tac >- (strip_tac \\ fs[]))) \\
-      rw[] \\
-      fs[case_eq_thms,pair_case_eq] \\ rveq \\ fs[] \\
-      drule do_install \\
-      imp_res_tac patPropsTheory.evaluate_const \\ fs[MAP_REVERSE] \\
-      imp_res_tac patPropsTheory.do_install_const \\
-      IF_CASES_TAC \\ fs[] \\ fs[patSemTheory.dec_clock_def]
-      \\ fs[CaseEq"prod"] \\ fs[]
-      \\ fs[CaseEq"semanticPrimitives$result"] \\ rveq \\ fs[]
-      \\ rw[]
-      \\ irule LAST_MAP
-      \\ imp_res_tac evaluate_IMP_LENGTH
-      \\ strip_tac \\ fs[do_install_def,CaseEq"prod",CaseEq"option",CaseEq"bool",CaseEq"list"]
-      \\ pairarg_tac \\ fs[CaseEq"bool",CaseEq"prod",CaseEq"option"]) \\
-    reverse(fs[case_eq_thms,pair_case_eq]) \\ rw[] \\ fs[] >- (
-      reverse(Cases_on`op`)>>fs[evaluate_def,ETA_AX,MAP_REVERSE] >- (
-        rw[] >> fs[LENGTH_eq,evaluate_def,do_app_def] >>
-        rw[] >> fs[] ) >>
-      qmatch_assum_rename_tac`op ≠ Opapp` >>
-      (Cases_on`op`)>>fs[evaluate_def,ETA_AX] >>
-      TRY ( qmatch_goalsub_rename_tac`Opn op` >> Cases_on`op`) >>
-      TRY ( qmatch_goalsub_rename_tac`Opb op` >> Cases_on`op`) >>
-      TRY ( qmatch_goalsub_rename_tac`Chopb op` >> Cases_on`op`) >>
-      TRY ( qmatch_goalsub_rename_tac`WordFromInt wz` >> Cases_on`wz`) >>
-      TRY ( qmatch_goalsub_rename_tac`WordToInt wz` >> Cases_on`wz`) >>
-      fs[evaluate_def,ETA_AX,MAP_REVERSE]
-      >- (
-          rw[] >> fs[LENGTH_eq,evaluate_def,ETA_AX,MAP_REVERSE] >>
-          rw[] >> fs[] >> qhdtm_x_assum`evaluate`mp_tac >>
-          simp[Once evaluate_CONS] >>
-          rw[case_eq_thms,pair_case_eq] >> rw[do_app_def])
-      >- (
-        rw[Once evaluate_CONS,evaluate_def] >>
-        rw[do_app_def] ) >>
-      TRY
-       (qmatch_goalsub_abbrev_tac `dest_WordToInt www` >>
-        Cases_on `dest_WordToInt www es` >>
-        qunabbrev_tac `www` >>
-        fs [dest_WordToInt_SOME] >> rw [] >>
-        fs[evaluate_def,ETA_AX,MAP_REVERSE,compile_def] >>
-        TRY (rw[Once evaluate_CONS,evaluate_def] >> rw[do_app_def] >> NO_TAC) >>
-        TOP_CASE_TAC \\ fs [case_eq_thms,pair_case_eq] >>
-        rveq \\ fs [] >>
-        qabbrev_tac `ws = REVERSE vs` >>
-        `vs = REVERSE ws` by (fs [Abbr `ws`]) \\ rveq >>
-        fs [Rabort_Rtype_error_map_error] >>
-        imp_res_tac do_app_WordToInt_Rerr_IMP \\ fs [])
-      >> (
-        rw[] >> fs[LENGTH_eq,evaluate_def,ETA_AX,MAP_REVERSE] >>
-        rw[] >> fs[] >>
-        fs[do_app_def])) >>
-    Cases_on `op = Op Explode`
-    >-
-     (fs [patSemTheory.do_app_def] \\ Cases_on `REVERSE vs` \\ fs []
-      \\ Cases_on `t` \\ fs []
-      \\ Cases_on `h` \\ fs []
-      \\ Cases_on `l` \\ fs [] \\ rveq \\ fs []
-      \\ imp_res_tac evaluate_length
-      \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
-      \\ fs [closSemTheory.evaluate_def,closSemTheory.do_app_def]
-      \\ rename [`MAP _ (MAP _ str)`]
-      \\ rpt (pop_assum kall_tac)
-      \\ Induct_on `str` \\ fs [patSemTheory.list_to_v_def,closSemTheory.list_to_v_def]
-      \\ fs [ORD_BOUND])
-    \\ Cases_on `op = (Op ListAppend)`
-    >-
-     (rw []
-      \\ fs [do_app_cases, SWAP_REVERSE_SYM] \\ rw []
-      \\ fsrw_tac [ETA_ss] [evaluate_def, do_app_def, case_eq_thms,
-                            pair_case_eq, PULL_EXISTS, SWAP_REVERSE_SYM]
-      \\ imp_res_tac evaluate_length
-      \\ fs [LENGTH_EQ_NUM_compute] \\ rveq \\ fs []
-      \\ fs [evaluate_def, case_eq_thms, pair_case_eq] \\ rveq
-      \\ imp_res_tac v_to_list \\ fs []
-      \\ metis_tac [list_to_v_compile_APPEND, list_to_v_compile, MAP_APPEND]) >>
-    fs[patSemTheory.do_app_cases] >> rw[] >>
-    rfs[] >>
-    fsrw_tac[ETA_ss][SWAP_REVERSE_SYM] >>
-    fs[evaluate_def,MAP_REVERSE,do_app_def,PULL_EXISTS,
-       store_alloc_def,FLOOKUP_compile_state_refs,int_gt,
-       prim_exn_def,NOT_LESS,EL_MAP,GREATER_EQ] >>
-    imp_res_tac evaluate_length >> fs[LENGTH_EQ_NUM_compute] >>
-    rveq \\
-    fs[evaluate_def,do_app_def,FLOOKUP_compile_state_refs,
-       compile_state_with_refs_snoc,case_eq_thms,pair_case_eq,
-       INT_NOT_LT,int_ge,PULL_EXISTS,IMPLODE_EXPLODE_I,
-       INT_ABS_EQ_ID |> SPEC_ALL |> EQ_IMP_RULE |> snd] >>
-    simp[MAP_MAP_o,n2w_ORD_CHR_w2n,EL_MAP,Unit_def] >>
-    simp[o_DEF] >>
-    rfs[INT_ABS_EQ_ID |> SPEC_ALL |> EQ_IMP_RULE |> snd] >>
-    TRY (
-      rename1`CopyByteStr`
-      \\ rw[CopyByteStr_def]
-      \\ fs[evaluate_def,do_app_def,do_eq_def,copy_array_def,store_lookup_def]
-      \\ IF_CASES_TAC \\ fs[INT_NOT_LT]
-      \\ IF_CASES_TAC \\ fs[INT_NOT_LT]
-      \\ fs[INT_ABS_EQ_ID |> SPEC_ALL |> EQ_IMP_RULE |> snd]
-      \\ fs[FLOOKUP_compile_state_refs,store_lookup_def]
-      \\ rename1`off + len ≤ &LENGTH st`
-      \\ `off + len ≤ &LENGTH st ⇔ ¬(LENGTH st < Num (off + len))` by COOPER_TAC
-      \\ simp[]
-      \\ IF_CASES_TAC \\ simp[]
-      \\ simp[MAP_TAKE,MAP_DROP,ws_to_chars_def,MAP_MAP_o,o_DEF,ORD_CHR,w2n_lt_256]
-      \\ NO_TAC ) \\
-    TRY (
-      rename1`CopyByteAw8`
-      \\ rw[CopyByteAw8_def]
-      \\ fs[evaluate_def,do_app_def,do_eq_def,copy_array_def,store_lookup_def]
-      \\ TRY IF_CASES_TAC \\ fs[INT_NOT_LT] \\ TRY COOPER_TAC
-      \\ TRY IF_CASES_TAC \\ fs[INT_NOT_LT]
-      \\ fs[INT_ABS_EQ_ID |> SPEC_ALL |> EQ_IMP_RULE |> snd]
-      \\ fs[FLOOKUP_compile_state_refs,store_lookup_def]
-      \\ rename1`off + len ≤ &LENGTH st`
-      \\ `off + len ≤ &LENGTH st ⇔ ¬(LENGTH st < Num (off + len))` by COOPER_TAC
-      \\ simp[]
-      \\ fs[INT_ABS_EQ_ID |> SPEC_ALL |> EQ_IMP_RULE |> snd]
-      \\ fs[ws_to_chars_def]
-      \\ TRY IF_CASES_TAC \\ fs[] \\ TRY COOPER_TAC
-      \\ TRY IF_CASES_TAC \\ fs[] \\ TRY COOPER_TAC
-      \\ simp[FLOOKUP_compile_state_refs,store_lookup_def]
-      \\ fs[INT_NOT_LT]
-      \\ simp[INT_ABS_EQ_ID |> SPEC_ALL |> EQ_IMP_RULE |> snd]
-      \\ rename1`dstoff + len ≤ &LENGTH ds`
-      \\ `dstoff + len ≤ &LENGTH ds ⇔ ¬(LENGTH ds < Num (dstoff + len))` by COOPER_TAC
-      \\ simp[]
-      \\ fs[INT_ABS_EQ_ID |> SPEC_ALL |> EQ_IMP_RULE |> snd]
-      \\ TRY IF_CASES_TAC \\ fs[ws_to_chars_def] \\ TRY COOPER_TAC
-      \\ fs[Unit_def,store_assign_def]
-      \\ simp[state_component_equality,FLOOKUP_compile_state_refs,fmap_eq_flookup,FLOOKUP_UPDATE,ALOOKUP_GENLIST]
-      \\ rw[store_lookup_def,EL_LUPDATE,chars_to_ws_def,MAP_TAKE,MAP_DROP,MAP_MAP_o]
-      \\ simp[INT_ABS_EQ_ID |> SPEC_ALL |> EQ_IMP_RULE |> snd]
-      \\ simp[o_DEF,ORD_CHR,w2n_lt_256,integer_wordTheory.i2w_def]
-      \\ `F` by COOPER_TAC) \\
-    TRY (
-      rename1`do_shift sh n wz wd`
-      \\ Cases_on`wz` \\ Cases_on`wd` \\ fs[]
-      \\ rw[] \\ NO_TAC) >>
-    TRY (
-      rename1`do_word_from_int wz i`
-      \\ Cases_on`wz` \\ fs[evaluate_def,do_app_def,integer_wordTheory.w2n_i2w]
-      \\ NO_TAC) >>
-    TRY (
-      rename1`do_word_to_int wz w`
-      \\ Cases_on`wz` \\ Cases_on`w` \\ fs[evaluate_def,do_app_def]
-      \\ NO_TAC) >>
-    TRY (
-      rename1`ORD(CHR(Num i))`
-      \\ `Num i < 256` by COOPER_TAC
-      \\ simp[ORD_CHR,INT_OF_NUM]
-      \\ COOPER_TAC ) >>
-    TRY (
-      rename1`Opn opn`
-      \\ Cases_on`opn`
-      \\ fs[evaluate_def,do_app_def,opn_lookup_def,
-            closSemTheory.do_eq_def]
-      \\ NO_TAC) >>
-    TRY (
-      rename1`do_eq (Number 0) (Number 0)`
-      \\ simp[closSemTheory.do_eq_def]
-      \\ NO_TAC ) >>
-    TRY (
-      rename1`Opb opb`
-      \\ Cases_on`opb`
-      \\ fs[evaluate_def,do_app_def,opb_lookup_def]
-      \\ NO_TAC) >>
-    TRY (
-      rename1`Chopb op` >>
-      Cases_on`op`>>fs[evaluate_def,ETA_AX,do_app_def,opb_lookup_def] >>
-      NO_TAC) >>
-    TRY (
-      rename1`do_word_op op wz w1 w2`
-      \\ Cases_on`wz` \\ Cases_on`w1` \\ Cases_on`w2` \\ fs[evaluate_def]
-      \\ rveq \\ fs[]
-      \\ DEEP_INTRO_TAC some_intro
-      \\ simp[FORALL_PROD]
-      \\ NO_TAC) >>
-    imp_res_tac v_to_list \\ fs[] >>
-    TRY (
-      rename1`v_to_char_list` >>
-      imp_res_tac v_to_char_list \\ fs[] >>
-      DEEP_INTRO_TAC some_intro >> fs[PULL_EXISTS] >>
-      qexists_tac`MAP ORD ls` \\
-      simp[MAP_MAP_o,EVERY_MAP,ORD_BOUND] \\
-      rw[LIST_EQ_REWRITE,EL_MAP,ORD_BOUND] \\ rfs[]
-      \\ fs[EL_MAP] \\ metis_tac[ORD_BOUND]) >>
-    TRY (
-      rename1`vs_to_string` >>
-      imp_res_tac vs_to_string \\ fs[] >>
-      DEEP_INTRO_TAC some_intro \\ fs[PULL_EXISTS] >>
-      qexists_tac`wss` \\ rw[] >>
-      imp_res_tac INJ_MAP_EQ \\ fs[INJ_DEF] >>
-      simp[o_DEF]
-      \\ NO_TAC) >>
-    TRY (
-      rename1`get_global` >>
-      simp[compile_state_def,get_global_def,EL_MAP] >>
-      simp[LUPDATE_MAP] >> NO_TAC) >>
-    TRY (
-      rename1`patSem$do_eq v1 v2`
-      \\ Cases_on`do_eq v1 v2 = Eq_type_error` \\ fs[]
-      \\ imp_res_tac do_eq \\ fs[] \\ rw[]
-      \\ NO_TAC ) >>
-    TRY (
-      IF_CASES_TAC \\ TRY (`F` by COOPER_TAC)
-      \\ simp[EL_MAP,ORD_BOUND] ) >>
-    TRY (
-      rename1`store_lookup`
-      \\ fs[store_lookup_def,store_assign_def]
-      \\ qmatch_assum_rename_tac`store_v_same_type (EL lnum t.refs) _`
-      \\ Cases_on`EL lnum t.refs` \\ fs[store_v_same_type_def] ) >>
-    TRY (
-      rename1 `Litv w1`
-      \\ Cases_on `w1` \\ fs [compile_v_def]
-      \\ rename1 `do_shift sh n wl _`
-      \\ Cases_on `wl` \\ fs [semanticPrimitivesPropsTheory.do_shift_def]
-      \\ qpat_x_assum `_ = w` (fn thm => rw [GSYM thm])) >>
-    TRY (
-      rename1 `(Op (WordFromInt ws55))`
-      \\ Cases_on `ws55` \\ fs [compile_v_def]
-      \\ TOP_CASE_TAC \\ fs [dest_WordToInt_SOME] \\ rveq \\ fs []
-      \\ fs[evaluate_def,do_app_def,integer_wordTheory.w2n_i2w,
-            case_eq_thms,pair_case_eq] \\ rveq \\ fs [w2w_def]
-      \\ fs [some_def]
-      \\ fs [patSemTheory.evaluate_def,case_eq_thms,pair_case_eq]
-      \\ rveq \\ fs []
-      \\ qabbrev_tac `ws = REVERSE vs`
-      \\ `vs = REVERSE ws` by (fs [Abbr `ws`]) \\ rveq
-      \\ fs [patSemTheory.do_app_def,case_eq_thms,pair_case_eq]
-      \\ FULL_CASE_TAC \\ fs [] \\ rveq \\ fs []
-      \\ FULL_CASE_TAC \\ fs [] \\ rveq \\ fs []
-      \\ fs [patSemTheory.do_app_def,case_eq_thms,pair_case_eq]
-      \\ rveq \\ fs [] \\ Cases_on `l`
-      \\ fs [semanticPrimitivesPropsTheory.do_word_to_int_def]
-      \\ rveq \\ fs [w2w_def]) >>
-    fs[state_component_equality,compile_state_def,fmap_eq_flookup,
-       ALOOKUP_GENLIST,FLOOKUP_UPDATE,store_assign_def,store_lookup_def,
-       get_global_def, EL_MAP, IS_SOME_EXISTS,
-       evaluate_REPLICATE_Op_AllocGlobal, REPLICATE_GENLIST, MAP_GENLIST]
-    \\ rveq \\ simp[EL_LUPDATE] \\ rw[LUPDATE_def,map_replicate,LUPDATE_MAP]
-    \\ simp[ETA_THM]) >>
-  strip_tac >- (
-    simp[evaluate_def,evaluate_pat_def,patSemTheory.do_if_def] >> rw[] >>
-    fs[case_eq_thms,pair_case_eq,bool_case_eq] \\ fs[] \\ rveq \\
-    imp_res_tac evaluate_length >> fs[LENGTH_eq] >>
-    imp_res_tac patPropsTheory.evaluate_const >> rw[] >> fs[] ) >>
-  strip_tac >- (
-    simp[evaluate_def,evaluate_pat_def] >> rw[] >>
-    fs[case_eq_thms,pair_case_eq,bool_case_eq] \\ fs[] \\ rveq \\
-    imp_res_tac evaluate_length >> fs[LENGTH_eq] >>
-    imp_res_tac patPropsTheory.evaluate_const >> rw[] >> fs[] ) >>
-  strip_tac >- (
-    simp[evaluate_def,evaluate_pat_def] >> rw[] >>
-    fs[case_eq_thms,pair_case_eq,bool_case_eq] \\ fs[] \\ rveq \\
-    imp_res_tac patPropsTheory.evaluate_const \\ fs[] \\
-    Cases_on`r` \\ fs[] \\
-    imp_res_tac evaluate_length >> fs[LENGTH_eq]) >>
-  strip_tac >- (
-    simp[evaluate_def,evaluate_pat_def] >>
-    rw[] >> fs[EXISTS_MAP] >>
-    fs[build_rec_env_pat_def,build_recc_def,MAP_GENLIST,
-       combinTheory.o_DEF,ETA_AX,MAP_MAP_o,clos_env_def] >>
-    fsrw_tac[ETA_ss][] )
-QED
-
-Theorem compile_semantics:
-   0 < max_app ∧ st.compile = pure_cc (λe. (MAP compile e,[])) cc ∧ st.globals = [] ∧ st.refs = [] ⇒
-   semantics [] (st:('c,'ffi)patSem$state) es ≠ Fail ⇒
-   semantics st.ffi max_app FEMPTY (pure_co (λe. (MAP compile e,[])) o st.compile_oracle) cc (MAP compile es) =
-   semantics [] st es
-Proof
-  strip_tac >>
-  simp[patSemTheory.semantics_def] >>
-  IF_CASES_TAC >> fs[] >>
-  DEEP_INTRO_TAC some_intro >> simp[] >>
-  conj_tac >- (
-    rw[] >>
-    simp[closSemTheory.semantics_def] >>
-    IF_CASES_TAC >> fs[] >- (
-      qhdtm_x_assum`patSem$evaluate`kall_tac >>
-      last_x_assum(qspec_then`k'`mp_tac)>>simp[] >>
-      (fn g => subterm (fn tm => Cases_on`^(assert(has_pair_type)tm)`) (#2 g) g) >>
-      spose_not_then strip_assume_tac >>
-      drule (UNDISCH compile_evaluate) >>
-      impl_tac >- ( rw[] >> strip_tac >> fs[] ) >>
-      strip_tac >> fs[compile_state_def,initial_state_def] >>
-      rfs[] \\ fs[]) >>
-    DEEP_INTRO_TAC some_intro >> simp[] >>
-    conj_tac >- (
-      rw[] >>
-      qmatch_assum_abbrev_tac`patSem$evaluate env ss es = _` >>
-      qmatch_assum_abbrev_tac`closSem$evaluate bp = _` >>
-      Q.ISPECL_THEN[`env`,`ss`,`es`](mp_tac o Q.GEN`extra`) patPropsTheory.evaluate_add_to_clock_io_events_mono >>
-      Q.ISPEC_THEN`bp`(mp_tac o Q.GEN`extra`) (CONJUNCT1 closPropsTheory.evaluate_add_to_clock_io_events_mono) >>
-      simp[Abbr`ss`,Abbr`bp`] >>
-      disch_then(qspec_then`k`strip_assume_tac) >>
-      disch_then(qspec_then`k'`strip_assume_tac) >>
-      drule(GEN_ALL(SIMP_RULE std_ss [](CONJUNCT1 closPropsTheory.evaluate_add_to_clock))) >>
-      disch_then(qspec_then `k` mp_tac) >>
-      impl_tac >- rpt(PURE_FULL_CASE_TAC >> fs[]) >>
-      drule(GEN_ALL(SIMP_RULE std_ss [] patPropsTheory.evaluate_add_to_clock)) >>
-      disch_then(qspec_then `k'` mp_tac) >>
-      impl_tac >- rpt(PURE_FULL_CASE_TAC >> fs[]) >>
-      ntac 2 strip_tac >> fs[] >>
-      drule (UNDISCH compile_evaluate) >>
-      impl_tac >- rpt(PURE_FULL_CASE_TAC >> fs[]) >>
-      strip_tac >> unabbrev_all_tac >> fs[] >>
-      fs[compile_state_def,initial_state_def] >> rfs[] >>
-      fs[state_component_equality] >> rpt(PURE_FULL_CASE_TAC >> fs[])) >>
-    drule (UNDISCH compile_evaluate) >> simp[] >>
-    impl_tac >- (
-      last_x_assum(qspec_then`k`mp_tac)>>
-      fs[] >> rpt strip_tac >> fs[] ) >>
-    strip_tac >>
-    rfs[initial_state_def,compile_state_def] >>
-    asm_exists_tac >> simp[] >> rpt(PURE_FULL_CASE_TAC >> fs[])) >>
-  strip_tac >>
-  simp[closSemTheory.semantics_def] >>
-  IF_CASES_TAC >> fs[] >- (
-    last_x_assum(qspec_then`k`strip_assume_tac) >>
-    qmatch_assum_abbrev_tac`SND p ≠ _` >>
-    Cases_on`p`>>fs[markerTheory.Abbrev_def] >>
-    pop_assum(assume_tac o SYM) >>
-    first_assum(mp_tac o MATCH_MP (REWRITE_RULE[GSYM AND_IMP_INTRO](UNDISCH compile_evaluate))) >>
-    rw[compile_state_with_clock] >>
-    strip_tac >> fs[initial_state_def,compile_state_def] >>
-    rfs[] \\ fs[]) >>
-  DEEP_INTRO_TAC some_intro >> simp[] >>
-  conj_tac >- (
-    spose_not_then strip_assume_tac >>
-    last_x_assum(qspec_then`k`mp_tac) >>
-    (fn g => subterm (fn tm => Cases_on`^(assert (can dest_prod o type_of) tm)` g) (#2 g)) >>
-    strip_tac >>
-    drule (UNDISCH compile_evaluate) >> simp[] >>
-    spose_not_then strip_assume_tac >>
-    rveq >> fs[] >>
-    last_x_assum(qspec_then`k`mp_tac) >>
-    simp[] >>
-    rfs[initial_state_def,compile_state_def] >> fs[] >>
-    rpt(PURE_FULL_CASE_TAC >> fs[])) >>
-  strip_tac >>
-  rpt (AP_TERM_TAC ORELSE AP_THM_TAC) >>
-  simp[FUN_EQ_THM] >> gen_tac >>
-  rpt (AP_TERM_TAC ORELSE AP_THM_TAC) >>
-  qpat_abbrev_tac`s0 = closSem$initial_state _ _ _ _ _` \\
-  specl_args_of_then``patSem$evaluate``(UNDISCH compile_evaluate) mp_tac >>
-  qpat_abbrev_tac`s1 = compile_state _ _ _` \\
-  `s1 = s0 k` by (
-    simp[Abbr`s1`,Abbr`s0`,initial_state_def,compile_state_def] ) \\
-  srw_tac[QI_ss][]
-QED
-
-(* more correctness properties *)
-
-Theorem compile_contains_App_SOME:
-   0 < max_app ⇒ ∀e. ¬contains_App_SOME max_app [compile e]
-Proof
-  strip_tac >>
-  ho_match_mp_tac compile_ind >>
-  simp[compile_def,contains_App_SOME_def,CopyByteStr_def,CopyByteAw8_def] >>
-  rw[] >> srw_tac[ETA_ss][] >>
-  rw[Once contains_App_SOME_EXISTS,EVERY_MAP] >>
-  rw[contains_App_SOME_def] >> rw[EVERY_MEM] >>
-  rw[Once contains_App_SOME_EXISTS,EVERY_MAP] >>
-  rw[contains_App_SOME_def] >> rw[EVERY_MEM] >>
-  fs[REPLICATE_GENLIST,MEM_GENLIST, MEM_MAP] >>
-  rw[contains_App_SOME_def] >>
-  TOP_CASE_TAC >> fs[contains_App_SOME_def] >>
-  rw[Once contains_App_SOME_EXISTS,EVERY_MAP] >>
-  fs[contains_App_SOME_def,EVERY_MEM,MEM_MAP,PULL_EXISTS]
-QED
-
-Theorem compile_every_Fn_vs_NONE:
-   ∀e. every_Fn_vs_NONE[compile e]
-Proof
-  ho_match_mp_tac compile_ind >>
-  rw[compile_def,CopyByteStr_def,CopyByteAw8_def] >>
-  rw[Once every_Fn_vs_NONE_EVERY] >>
-  simp[EVERY_REVERSE,EVERY_MAP] >>
-  fs[EVERY_MEM,REPLICATE_GENLIST,MEM_GENLIST] >>
-  rw[] >> rw[] >>
-  TOP_CASE_TAC >> fs[] >>
-  rw[Once every_Fn_vs_NONE_EVERY,EVERY_MAP,GSYM MAP_REVERSE] >>
-  fs[EVERY_MEM,MEM_MAP,PULL_EXISTS]
-QED
-
-Theorem set_globals_eq:
-   ∀e. set_globals e = set_globals (compile e)
-Proof
-  ho_match_mp_tac compile_ind >>
-  rw[compile_def,patPropsTheory.op_gbag_def,op_gbag_def,elist_globals_reverse,CopyByteStr_def,CopyByteAw8_def]
-  >>
-    TRY
-    (TRY(qpat_x_assum`LENGTH es ≠ A` kall_tac)>>
-    TRY(qpat_x_assum`LENGTH es = A` kall_tac)>>
-    Induct_on`es`>>fs[]>>NO_TAC)
-  >> TRY
-   (qmatch_goalsub_abbrev_tac `dest_WordToInt www` >>
-    Cases_on `dest_WordToInt www es` >>
-    qunabbrev_tac `www` >>
-    fs [dest_WordToInt_SOME] >> rw [] >>
-    fs[LENGTH_eq,op_gbag_def]>>
-    pop_assum kall_tac >>
-    rpt (pop_assum mp_tac) >>
-    TRY (EVAL_TAC \\ NO_TAC) >>
-    fs [elist_globals_reverse] >>
-    Induct_on`es`>>fs[] \\ EVAL_TAC)
-  >>
-    fs[LENGTH_eq,ETA_AX]>>
-    TRY(pop_assum SUBST_ALL_TAC>>fs[bagTheory.COMM_BAG_UNION])>>
-    Induct_on`n`>>fs[REPLICATE,op_gbag_def] >>
-  Induct_on`es`>>fs[]
-QED
-
-Theorem compile_esgc_free:
-   ∀e. esgc_free e ⇒ esgc_free (compile e)
-Proof
-  ho_match_mp_tac compile_ind >>
-  rw[compile_def,CopyByteStr_def,CopyByteAw8_def] >>
-  fs[EVERY_REVERSE,EVERY_MAP,EVERY_MEM]>>
-  fs[set_globals_eq,LENGTH_eq,REPLICATE_GENLIST,MEM_GENLIST,PULL_EXISTS]
-  >> TRY
-   (qmatch_goalsub_abbrev_tac `dest_WordToInt www` >>
-    Cases_on `dest_WordToInt www es` >>
-    qunabbrev_tac `www` >>
-    fs [dest_WordToInt_SOME] >> rw [] >>
-    fs [EVERY_MEM,MEM_MAP,PULL_EXISTS] >>
-    fs [])
-  >- (Induct_on`es`>>fs[set_globals_eq])
-QED
-
-Theorem compile_distinct_setglobals:
-   ∀e. BAG_ALL_DISTINCT (set_globals e) ⇒
-       BAG_ALL_DISTINCT (set_globals (compile e))
-Proof
-  fs[set_globals_eq]
-QED
-
-Theorem compile_no_Labels:
-   !e. no_Labels (compile e)
-Proof
-  ho_match_mp_tac compile_ind \\ rw [compile_def]
-  \\ fs [EVERY_REVERSE,EVERY_REPLICATE]
-  \\ TRY (fs [EVERY_MEM,MEM_MAP,PULL_EXISTS] \\ NO_TAC)
-  \\ every_case_tac \\ fs []
-  \\ fs [EVERY_REVERSE,EVERY_REPLICATE]
-  \\ fs [EVERY_MEM,MEM_MAP,PULL_EXISTS]
-  \\ EVAL_TAC \\ fs []
-QED
-
-val _ = export_theory()
diff --git a/compiler/backend/proofs/source_to_flatProofScript.sml b/compiler/backend/proofs/source_to_flatProofScript.sml
index b075557d6b..e9b88a6cd8 100644
--- a/compiler/backend/proofs/source_to_flatProofScript.sml
+++ b/compiler/backend/proofs/source_to_flatProofScript.sml
@@ -6,6 +6,7 @@ open preamble semanticsTheory namespacePropsTheory
      semanticPrimitivesTheory semanticPrimitivesPropsTheory
      source_to_flatTheory flatLangTheory flatSemTheory flatPropsTheory
      backendPropsTheory
+local open flat_elimProofTheory flat_patternProofTheory in end
 
 val _ = new_theory "source_to_flatProof";
 
@@ -586,7 +587,6 @@ Inductive s_rel:
     LIST_REL (sv_rel <| v := s'.globals; c := genv_c |>) s.refs s'.refs ∧
     s.clock = s'.clock ∧
     s.ffi = s'.ffi ∧
-    ¬s'.exh_pat ∧
     s'.check_ctor ∧
     s'.c = FDOM genv_c
     ⇒
@@ -1382,8 +1382,25 @@ val ctor_same_type_refl = Q.prove (
   Cases_on `x` >>
   rw [ctor_same_type_def]);
 
+Theorem genv_c_ok_pmatch_stamps_ok:
+  s_rel genv.c s t /\
+  same_type src_stamp src_stamp' /\
+  genv_c_ok genv.c /\
+  FLOOKUP genv.c (flat_stamp, l) = SOME src_stamp /\
+  FLOOKUP genv.c (flat_stamp', l') = SOME src_stamp' /\
+  LENGTH ps = l ==>
+  pmatch_stamps_ok t.c s_cc (SOME flat_stamp) (SOME flat_stamp') ps vs
+Proof
+  rw [genv_c_ok_def] >>
+  `ctor_same_type (SOME src_stamp) (SOME src_stamp')`
+    by simp [semanticPrimitivesTheory.ctor_same_type_def] >>
+  rw [pmatch_stamps_ok_def] >>
+  fs [s_rel_cases, FDOM_FLOOKUP] >>
+  metis_tac []
+QED
+
 val pmatch = Q.prove (
-  `(!cenv s p v env r env' env'' genv env_i1 (s_i1:'ffi flatSem$state) v_i1 comp_map.
+  `(!cenv s p v env r env' env'' env_i1 (s_i1:'ffi flatSem$state) v_i1 st'.
     semanticPrimitives$pmatch cenv s p v env = r ∧
     genv_c_ok genv.c ∧
     (!x arity stamp.
@@ -1392,15 +1409,16 @@ val pmatch = Q.prove (
         FLOOKUP genv.c (cn,arity) = SOME stamp) ∧
     env = env' ++ env'' ∧
     s_i1.globals = genv.v ∧
-    s_rel genv.c <| clock := clk; refs := s; ffi := ffi; next_type_stamp := nts;
-                    next_exn_stamp := nes |> s_i1 ∧
+    s_rel genv.c st' s_i1 ∧
+    st' = <| clock := clk; refs := s; ffi := ffi; next_type_stamp := nts;
+                    next_exn_stamp := nes |> ∧
     v_rel genv v v_i1 ∧
     env_rel genv (alist_to_ns env') env_i1
     ⇒
     ?r_i1.
       flatSem$pmatch s_i1 (compile_pat comp_map p) v_i1 env_i1 = r_i1 ∧
       match_result_rel genv env'' r r_i1) ∧
-   (!cenv s ps vs env r env' env'' genv env_i1 s_i1 vs_i1 comp_map genv_v.
+   (!cenv s ps vs env r env' env'' env_i1 s_i1 vs_i1 st'.
     pmatch_list cenv s ps vs env = r ∧
     genv_c_ok genv.c ∧
     (!x arity stamp.
@@ -1409,8 +1427,9 @@ val pmatch = Q.prove (
         FLOOKUP genv.c (cn,arity) = SOME stamp) ∧
     env = env' ++ env'' ∧
     s_i1.globals = genv.v ∧
-    s_rel genv.c <| clock := clk; refs := s; ffi := ffi; next_type_stamp := nts;
-                    next_exn_stamp := nes |> s_i1 ∧
+    s_rel genv.c st' s_i1 ∧
+    st' = <| clock := clk; refs := s; ffi := ffi; next_type_stamp := nts;
+                    next_exn_stamp := nes |> ∧
     LIST_REL (v_rel genv) vs vs_i1 ∧
     env_rel genv (alist_to_ns env') env_i1
     ⇒
@@ -1427,32 +1446,33 @@ val pmatch = Q.prove (
     qmatch_assum_rename_tac `nsLookup _ _ = SOME p` >>
     `?l stamp. p = (l, stamp)` by metis_tac [pair_CASES] >> fs [] >>
     TOP_CASE_TAC >> simp [match_result_rel_def] >>
+    last_assum (drule_then strip_assume_tac) >>
+    rfs [eta2] >>
+    DEP_REWRITE_TAC [GEN_ALL genv_c_ok_pmatch_stamps_ok] >>
+    conj_tac >- (simp [] >> metis_tac []) >>
     TOP_CASE_TAC >> simp [match_result_rel_def]
     >- (
-      rw [match_result_rel_def] >>
-      rfs [] >>
-      first_x_assum drule >>
-      disch_then drule >>
-      disch_then (qspecl_then [`env'`, `env''`, `env_i1`, `s_i1`] mp_tac) >>
-      simp [] >>
-      disch_then drule >> rw [] >>
-      first_x_assum drule >> rw [] >> simp [pmatch_def] >>
-      fs [s_rel_cases, FDOM_FLOOKUP] >> rw [eta2] >>
-      fs [same_ctor_def, semanticPrimitivesTheory.same_ctor_def,FDOM_FLOOKUP] >>
-      rename [`same_type stamp1 stamp2`] >>
-      `¬ctor_same_type (SOME stamp1) (SOME stamp2)` by metis_tac [genv_c_ok_def] >>
-      fs [semanticPrimitivesTheory.ctor_same_type_def])
+      (* same ctor *)
+      TOP_CASE_TAC >> simp [match_result_rel_def] >>
+      rw [] >>
+      fs [semanticPrimitivesTheory.same_ctor_def] >>
+      metis_tac [genv_c_ok_def]
+    )
     >- (
-      qmatch_abbrev_tac `match_result_rel _ _ _ r` >>
-      `r = No_match` suffices_by rw [match_result_rel_def] >>
-      qunabbrev_tac `r` >> rw [] >>
-      first_x_assum drule >> rw [] >> rw [pmatch_def] >>
-      fs [s_rel_cases] >> rfs [] >> rw [] >> fs [FDOM_FLOOKUP] >>
-      fs [same_ctor_def, semanticPrimitivesTheory.same_ctor_def,FDOM_FLOOKUP] >>
-      rename [`same_type stamp1 stamp2`] >>
-      `¬ctor_same_type (SOME stamp1) (SOME stamp2)` by metis_tac [genv_c_ok_def] >>
-      fs [semanticPrimitivesTheory.ctor_same_type_def]))
-  >- (every_case_tac >>
+      (* diff ctor *)
+      fs [] >>
+      rw [match_result_rel_def] >>
+      rename [`FST flat_stamp2 = FST flat_stamp1`] >>
+      Cases_on `flat_stamp2 = flat_stamp1` >> fs [] >>
+      rfs [semanticPrimitivesTheory.same_ctor_def] >>
+      fs [PAIR_FST_SND_EQ] >> fs [] >>
+      fs [genv_c_ok_def, ctor_same_type_OPTREL, OPTREL_def,
+            semanticPrimitivesTheory.ctor_same_type_def] >>
+      metis_tac []
+    )
+  )
+  >- (simp [pmatch_stamps_ok_def] >>
+      every_case_tac >>
       full_simp_tac(srw_ss())[match_result_rel_def, s_rel_cases] >>
       metis_tac [])
   >- (every_case_tac >>
@@ -1472,7 +1492,14 @@ val pmatch = Q.prove (
           srw_tac[][] >>
           full_simp_tac(srw_ss())[sv_rel_cases] >>
           metis_tac [store_v_distinct])
-  >- (CASE_TAC >>
+  >- (
+      TOP_CASE_TAC >> fs [match_result_rel_def]
+      >- (
+        (* no match *)
+        rpt (first_x_assum (first_assum o mp_then Any strip_assume_tac)) >>
+        rpt (CASE_TAC >> fs [match_result_rel_def]) >>
+        rfs [match_result_rel_def]
+      ) >>
       every_case_tac >>
       full_simp_tac(srw_ss())[match_result_rel_def] >>
       srw_tac[][] >>
@@ -1511,6 +1538,38 @@ val evaluate_foldr_let_err = Q.prove (
   every_case_tac >>
   fs [opt_bind_lem, env_updated_lem]);
 
+Theorem can_pmatch_all_IMP_pmatch_rows:
+  s_rel genv.c (st') (s2:'ffi flatSem$state) /\ genv_c_ok genv.c /\
+  env_all_rel (genv with v := s2.globals) comp_map env env_i1 locals /\
+  can_pmatch_all env.c st'.refs (MAP FST pes) v /\
+  v_rel (genv with v := s2.globals) v v' ==>
+  pmatch_rows (compile_pes t (comp_map with v := bind_locals ts locals comp_map.v) pes)
+    s2 v' ≠ Match_type_error
+Proof
+  Induct_on `pes` \\ fs [pmatch_rows_def,compile_exp_def,FORALL_PROD]
+  \\ rpt gen_tac \\ strip_tac
+  \\ fs [can_pmatch_all_def]
+  \\ `?res. pmatch env.c st'.refs p_1 v [] = res` by fs []
+  \\ drule (pmatch |> CONJUNCT1)
+  \\ REWRITE_TAC [semanticPrimitivesTheory.state_component_equality]
+  \\ simp []
+  \\ `genv_c_ok (genv with v := s2.globals).c` by fs []
+  \\ disch_then drule \\ fs []
+  \\ disch_then (qspecl_then [
+       `comp_map with v := bind_locals ts locals comp_map.v`,
+       `[]`, `s2`, `v'`, `st'`] mp_tac)
+  \\ impl_tac THEN1
+   (fs [v_rel_rules,env_all_rel_cases]
+    \\ rveq \\ fs []
+    \\ qpat_x_assum `global_env_inv _ _ _ _` mp_tac
+    \\ simp [Once v_rel_cases])
+  \\ strip_tac
+  \\ qmatch_assum_abbrev_tac`match_result_rel _ _ _ mm`
+  \\ Cases_on `res`
+  \\ Cases_on`mm` \\ full_simp_tac(srw_ss())[match_result_rel_def]
+  \\ TOP_CASE_TAC \\ fs []
+QED
+
 val s = mk_var("s",
   ``evaluate$evaluate`` |> type_of |> strip_fun |> #1 |> el 1
   |> type_subst[alpha |-> ``:'ffi``]);
@@ -1548,16 +1607,17 @@ val compile_exp_correct' = Q.prove (
        v_rel genv v v_i1 ∧
        LENGTH ts = LENGTH locals ∧
        pes_i1 = compile_pes t (comp_map with v := bind_locals ts locals comp_map.v) pes ∧
+       pmatch_rows pes_i1 s_i1 v_i1 <> Match_type_error ∧
        v_rel genv err_v err_v_i1 ∧
        genv.v = s_i1.globals
        ⇒
        ?s'_i1 r_i1.
          result_rel (LIST_REL o v_rel) (genv with v := s'_i1.globals) r r_i1 ∧
          s_rel genv.c s' s'_i1 ∧
-         flatSem$evaluate_match env_i1 s_i1 v_i1 pes_i1 err_v_i1 = (s'_i1, r_i1) ∧
+         flatProps$evaluate_match env_i1 s_i1 v_i1 pes_i1 err_v_i1 = (s'_i1, r_i1) ∧
          s_i1.globals = s'_i1.globals)`,
   ho_match_mp_tac terminationTheory.evaluate_ind >>
-  srw_tac[][terminationTheory.evaluate_def, flatSemTheory.evaluate_def,compile_exp_def] >>
+  srw_tac[][terminationTheory.evaluate_def, flat_evaluate_def,compile_exp_def] >>
   full_simp_tac(srw_ss())[result_rel_eqns, v_rel_eqns] >>
   rpt (split_pair_case_tac >> fs [])
   >- ( (* sequencing *)
@@ -1607,7 +1667,7 @@ val compile_exp_correct' = Q.prove (
     full_simp_tac(srw_ss())[result_rel_cases] >> rveq >> full_simp_tac(srw_ss())[] >> rveq >> full_simp_tac(srw_ss())[] >>
     full_simp_tac(srw_ss())[] >>
     imp_res_tac evaluate_sing >> full_simp_tac(srw_ss())[])
-  >- (
+  >- ( (* Handle *)
     qpat_x_assum`_ ⇒ _`mp_tac >>
     impl_tac >- ( strip_tac >> full_simp_tac(srw_ss())[] ) >>
     disch_then drule >> simp[] >>
@@ -1624,6 +1684,8 @@ val compile_exp_correct' = Q.prove (
       rw [] >>
       metis_tac [subglobals_refl]) >>
     first_x_assum (qspec_then `genv with v := s2.globals` mp_tac) >>
+    drule can_pmatch_all_IMP_pmatch_rows >>
+    rpt (disch_then drule) >> strip_tac >>
     simp [])
   >- ( (* Constructors *)
     qpat_x_assum`_ ⇒ _`mp_tac >>
@@ -1991,7 +2053,7 @@ val compile_exp_correct' = Q.prove (
     rw [] >>
     fs [genv_c_ok_def, has_bools_def] >>
     metis_tac [])
-  >- ( (* match *)
+  >- ( (* Mat *)
     qpat_x_assum`_ ⇒ _`mp_tac >>
     impl_tac >- ( strip_tac >> full_simp_tac(srw_ss())[] ) >>
     disch_then drule >>
@@ -2019,6 +2081,9 @@ val compile_exp_correct' = Q.prove (
     imp_res_tac evaluatePropsTheory.evaluate_length >> full_simp_tac(srw_ss())[] >>
     Cases_on`a`>>full_simp_tac(srw_ss())[LENGTH_NIL] >> rveq >>
     full_simp_tac(srw_ss())[] >>
+    drule can_pmatch_all_IMP_pmatch_rows >>
+    rpt (disch_then drule) >> strip_tac >>
+    full_simp_tac(srw_ss())[] >>
     first_x_assum drule >>
     simp[bind_exn_v_def] >>
     disch_then irule >>
@@ -2153,11 +2218,12 @@ val compile_exp_correct' = Q.prove (
       qmatch_assum_abbrev_tac`match_result_rel _ _ _ mm` >>
       Cases_on`mm`>>full_simp_tac(srw_ss())[match_result_rel_def] >>
       pop_assum(assume_tac o SYM o SIMP_RULE std_ss [markerTheory.Abbrev_def]) >>
-      simp[evaluate_def]>>
+      simp[flat_evaluate_def]>>
       first_x_assum match_mp_tac >>
       simp[s_rel_cases] >>
       simp[env_all_rel_cases] >>
-      metis_tac[] ) >>
+      fs [pmatch_rows_def] >>
+      metis_tac[]) >>
     rfs [] >>
     drule (GEN_ALL (CONJUNCT1 pmatch)) >>
     `genv_c_ok <| v := s_i1.globals; c := genv.c|>.c` by rw [] >>
@@ -2180,9 +2246,10 @@ val compile_exp_correct' = Q.prove (
     qmatch_assum_abbrev_tac`match_result_rel _ _ _ mm` >>
     Cases_on`mm`>>full_simp_tac(srw_ss())[match_result_rel_def] >>
     pop_assum(assume_tac o SYM o SIMP_RULE std_ss [markerTheory.Abbrev_def]) >>
-    simp[evaluate_def]>>
+    simp[flat_evaluate_def]>>
     qspecl_then [`comp_map.v`, `pat_bindings p []`] assume_tac (Q.GEN `comp_map` nsBindList_pat_tups_bind_locals|>INST_TYPE[alpha|->``:tvarN``])>>
     fs[]>>
+    reverse IF_CASES_TAC THEN1 fs [pmatch_rows_def] >>
     first_x_assum match_mp_tac >>
     simp[s_rel_cases] >>
     simp[env_all_rel_cases] >>
@@ -3236,7 +3303,7 @@ val compile_decs_correct' = Q.prove (
     `<|v := s_i1.globals; c := genv.c|> = genv` by rw [theorem "global_env_component_equality"] >>
     simp [] >>
     reverse (rw [flatSemTheory.evaluate_decs_def, flatSemTheory.evaluate_dec_def,
-        flatSemTheory.evaluate_def, compile_exp_def, result_rel_cases]) >>
+        evaluate_def, compile_exp_def, result_rel_cases, pmatch_rows_def]) >>
     fs [] >> rveq >> fs []
     >- ( (* Expression abort *)
       qexists_tac `genv` >>
@@ -3266,13 +3333,13 @@ val compile_decs_correct' = Q.prove (
       fs [s_rel_cases] >>
       fs [v_rel_eqns] >>
       rfs []) >>
+    fs [pmatch_rows_def,CaseEq"match_result"] >>
     Cases_on `pmatch env.c st'.refs p answer [] ` >>
     fs []
     >- ( (* No match *)
       rw [PULL_EXISTS] >>
       every_case_tac >>
-      fs [match_result_rel_def]
-      >- fs [s_rel_cases] >>
+      fs [match_result_rel_def] >>
       qexists_tac `genv` >>
       rw [subglobals_refl] >>
       rw [v_rel_lems, extend_env_def, extend_dec_env_def] >>
@@ -3412,7 +3479,6 @@ val compile_decs_correct' = Q.prove (
       \\ `s_i1.check_ctor` by fs [invariant_def,s_rel_cases] \\ fs []
       \\ qmatch_goalsub_abbrev_tac `evaluate bc`
       \\ qmatch_goalsub_abbrev_tac`compile_exps None cenv mvf`
-
       \\ `mvf = MAP Var (MAP (Short o FST) funs)`
       by ( simp[Abbr`mvf`, MAP_EQ_f, MAP_MAP_o, FORALL_PROD] )
       \\ fs[Abbr`mvf`]
@@ -3429,7 +3495,7 @@ val compile_decs_correct' = Q.prove (
         \\ fs[nsLookup_alist_to_ns_none, nsLookup_alist_to_ns_some]
         \\ TRY(fs[ALOOKUP_FAILS, MEM_MAP, FORALL_PROD] \\ NO_TAC)
         \\ imp_res_tac ALOOKUP_MEM \\ fs[compile_var_def,MEM_MAP] )
-      \\ fs[Abbr`f`]
+      \\ fs[Abbr`f`,pmatch_rows_def]
       \\ pop_assum kall_tac
       \\ pop_assum kall_tac
       \\ simp[GSYM MAP_REVERSE]
@@ -3447,7 +3513,7 @@ val compile_decs_correct' = Q.prove (
         \\ metis_tac[] )
       \\ drule (GEN_ALL evaluate_MAP_Var_local)
       \\ simp[] \\ disch_then kall_tac
-      \\ simp[pmatch_def]
+      \\ simp[pmatch_def, pmatch_stamps_ok_def]
       \\ qmatch_goalsub_abbrev_tac`MAP f funs`
       \\ `MAP f funs = MAP Pvar (MAP FST funs)`
         by simp[Abbr`f`, MAP_MAP_o, o_DEF, UNCURRY, LAMBDA_PROD]
@@ -3516,10 +3582,10 @@ val compile_decs_correct' = Q.prove (
     \\ qpat_x_assum `v_rel _ (Conv NONE vs) _` mp_tac
     \\ Cases_on `y` \\ simp [Once v_rel_cases]
     \\ strip_tac \\ rveq
-    \\ fs [pmatch_def]
+    \\ fs [pmatch_def,pmatch_rows_def]
     \\ `s'_i1.check_ctor ∧ LENGTH funs = LENGTH l` by
           (imp_res_tac LIST_REL_LENGTH \\ fs [invariant_def,s_rel_cases])
-    \\ fs []
+    \\ fs [pmatch_def, pmatch_stamps_ok_def]
     \\ qexists_tac `s'_i1 with globals := LUPDATE_EACH idx.vidx s_i1.globals l` \\ fs []
     \\ qexists_tac `<| v := LUPDATE_EACH idx.vidx s_i1.globals l; c := genv.c |>`
     \\ fs []
@@ -3528,6 +3594,10 @@ val compile_decs_correct' = Q.prove (
       \\ qunabbrev_tac `stores`
       \\ simp [pairTheory.ELIM_UNCURRY]
       \\ DEP_REWRITE_TAC [evaluate_let_none_list_MAPi]
+      \\ `MAP (λ(f,_). Pvar f) funs =
+          MAP (λx. Pvar (FST x)) funs` by
+            (qid_spec_tac `funs` \\ Induct \\ fs [FORALL_PROD]) \\ fs []
+      \\ fs [MAP_MAP_o,o_DEF]
       \\ simp [rich_listTheory.MAP_REVERSE, listTheory.MAP_ZIP]
       \\ fs [FST_triple, GSYM listTheory.LIST_TO_SET_MAP, listTheory.MAP_ZIP]
       \\ conj_tac THEN1
@@ -3843,13 +3913,13 @@ val compile_decs_correct' = Q.prove (
   ));
 
 Theorem compile_decs_correct:
-   !s env ds s' r comp_map s_i1 idx ds_i1 next' genv.
+   !s env ds s' r s_i1 cfg ds_i1 next' genv.
     evaluate$evaluate_decs s env ds = (s',r) ∧
     r ≠ Rerr (Rabort Rtype_error) ∧
-    invariant genv idx s s_i1 ∧
-    global_env_inv genv comp_map {} env ∧
-    source_to_flat$compile_prog <| next := idx; mod_env := comp_map |> ds = (next', ds_i1) ∧
-    idx.vidx ≤ LENGTH genv.v
+    invariant genv cfg.next s s_i1 ∧
+    source_to_flat$compile_prog cfg ds = (next', ds_i1) ∧
+    global_env_inv genv cfg.mod_env {} env ∧
+    cfg.next.vidx ≤ LENGTH genv.v
     ⇒
     ?(s'_i1:'a flatSem$state) genv' r_i1.
       flatSem$evaluate_decs s_i1 ds_i1 = (s'_i1,r_i1) ∧
@@ -3874,9 +3944,9 @@ Proof
   fs [] >>
   rveq >>
   fs [evaluate_decs_def, evaluate_dec_def, evaluate_def, do_app_def] >>
-  qabbrev_tac `ext_glob = s_i1.globals ⧺ REPLICATE (next.vidx − idx.vidx) NONE` >>
+  qabbrev_tac `ext_glob = s_i1.globals ⧺ REPLICATE (next.vidx − cfg.next.vidx) NONE` >>
   drule compile_decs_correct' >>
-  `invariant (genv with v := ext_glob) idx s (s_i1 with globals := ext_glob)`
+  `invariant (genv with v := ext_glob) cfg.next s (s_i1 with globals := ext_glob)`
   by (
     fs [invariant_def, Abbr`ext_glob`] >>
     rw [EL_APPEND_EQN] >>
@@ -3890,7 +3960,7 @@ Proof
     rw [] >>
     qexists_tac `<|v := s_i1.globals; c := genv.c|>` >>
     rw [subglobals_def, EL_APPEND_EQN]) >>
-  `global_env_inv (genv with v := ext_glob) comp_map {} env`
+  `global_env_inv (genv with v := ext_glob) cfg.mod_env {} env`
   by (
     irule global_env_inv_weak >>
     simp [] >>
@@ -3933,10 +4003,11 @@ QED
 val precondition_def = Define`
   precondition s1 env1 conf  ⇔
     ?genv.
-      invariant genv conf.next s1 (initial_state s1.ffi s1.clock F T) ∧
+      invariant genv conf.next s1 (initial_state s1.ffi s1.clock T) ∧
       global_env_inv genv conf.mod_env {} env1 ∧
       conf.next.vidx ≤ LENGTH genv.v ∧
-      FDOM genv.c = initial_ctors`;
+      FDOM genv.c = initial_ctors ∧
+      flat_patternProof$cfg_precondition conf.pattern_cfg`;
 
 val SND_eq = Q.prove(
   `SND x = y ⇔ ∃a. x = (a,y)`,
@@ -3945,7 +4016,7 @@ val SND_eq = Q.prove(
 Theorem compile_prog_correct:
    precondition s1 env1 c ⇒
    ¬semantics_prog s1 env1 prog Fail ⇒
-   semantics_prog s1 env1 prog (semantics F T s1.ffi (SND (compile_prog c prog)))
+   semantics_prog s1 env1 prog (semantics T s1.ffi (SND (compile_prog c prog)))
 Proof
   rw[semantics_prog_def,SND_eq,precondition_def]
   \\ simp[flatSemTheory.semantics_def]
@@ -3964,14 +4035,10 @@ Proof
     \\ fs[]
     \\ asm_exists_tac \\ fs[]
     \\ qmatch_goalsub_abbrev_tac`flatSem$evaluate_decs env2'`
-    \\ asm_exists_tac \\ fs []
     \\ qmatch_goalsub_abbrev_tac `compile_prog e _ = _`
-    \\ qexists_tac `SND (compile_prog e prog)`
-    \\ qexists_tac `FST (compile_prog e prog)`
-    \\ fs[]
-    \\ `c = e` by (UNABBREV_ALL_TAC >> rw [config_component_equality])
+    \\ Cases_on `compile_prog e prog` \\ fs []
     \\ rveq \\ fs []
-    \\ `env2' = initial_state s1.ffi k F T`
+    \\ `env2' = initial_state s1.ffi k T`
        by (rw[environment_component_equality,initial_state_def,Abbr `env2'`])
     \\ fs[] \\ CCONTR_TAC \\ fs []
     \\ Cases_on`r`
@@ -3992,18 +4059,14 @@ Proof
     \\ fs[]
     \\ simp []
     \\ disch_then drule \\ fs[]
-    \\ disch_then drule \\ fs[]
-    \\ qmatch_goalsub_abbrev_tac `compile_prog e _ = _`
-    \\ disch_then (qspecl_then [ `SND (compile_prog e prog)`
-                               , `FST (compile_prog e prog)`] mp_tac)
-    \\ impl_tac >- (UNABBREV_ALL_TAC >> fs[])
+    \\ qmatch_goalsub_abbrev_tac `compile_prog e prog = _`
+    \\ Cases_on `compile_prog e prog` \\ fs []
     \\ qmatch_goalsub_abbrev_tac`flatSem$evaluate_decs env2'`
-    \\ `env2' = initial_state s1.ffi k F T`
+    \\ `env2' = initial_state s1.ffi k T`
        by (rw[environment_component_equality,initial_state_def,Abbr `env2'`])
     \\ strip_tac
     \\ fs[invariant_def,s_rel_cases]
     \\ rveq \\ fs[]
-    \\ `e = c` by (UNABBREV_ALL_TAC >> rw [config_component_equality])
     \\ fs [initial_state_def] \\ rfs []
     \\ every_case_tac \\ fs[]
     \\ rw[]
@@ -4026,18 +4089,15 @@ Proof
           \\ rfs [])
     \\ disch_then drule \\ fs[]
     \\ disch_then drule \\ fs[]
-    \\ disch_then drule \\ fs[]
-    \\ qmatch_goalsub_abbrev_tac `compile_prog e _ = _`
-    \\ disch_then (qspecl_then [ `SND (compile_prog e prog)`
-                               , `FST (compile_prog e prog)`] mp_tac)
-    \\ impl_tac >- (UNABBREV_ALL_TAC >> fs[])
+    \\ qmatch_goalsub_abbrev_tac `compile_prog e prog = _`
+    \\ Cases_on `compile_prog e prog`
+    \\ fs []
     \\ qmatch_goalsub_abbrev_tac`flatSem$evaluate_decs env2'`
-    \\ `env2' = initial_state s1.ffi k F T`
+    \\ `env2' = initial_state s1.ffi k T`
     by ( unabbrev_all_tac \\ rw[environment_component_equality,initial_state_def])
     \\ strip_tac
     \\ first_x_assum(qspec_then`k`mp_tac)
     \\ rveq \\ fs[]
-    \\ `e = c`  by (UNABBREV_ALL_TAC >> rw [config_component_equality])
     \\ fs [initial_state_def] \\ rfs []
     \\ every_case_tac \\ fs[]
     \\ CCONTR_TAC \\ fs[]
@@ -4067,15 +4127,11 @@ Proof
           \\ rfs [])
     \\ disch_then drule \\ fs[]
     \\ disch_then drule \\ fs[]
-    \\ disch_then drule \\ fs[]
-    \\ qmatch_goalsub_abbrev_tac `compile_prog e _ = _`
-    \\ disch_then (qspecl_then [ `SND (compile_prog e prog)`
-                               , `FST (compile_prog e prog)`] mp_tac)
-    \\ impl_tac >- (UNABBREV_ALL_TAC >> fs[])
-    \\ `e = c`  by (UNABBREV_ALL_TAC >> rw [config_component_equality])
+    \\ qmatch_goalsub_abbrev_tac `compile_prog e prog = _`
+    \\ Cases_on `compile_prog e prog`
     \\ fs [initial_state_def] \\ rfs []
     \\ qmatch_goalsub_abbrev_tac`flatSem$evaluate_decs env2'`
-    \\ `env2' = initial_state s1.ffi k F T`
+    \\ `env2' = initial_state s1.ffi k T`
     by ( unabbrev_all_tac \\ rw[environment_component_equality,initial_state_def])
     \\ rveq
     \\ strip_tac
@@ -4098,94 +4154,36 @@ QED
 
 (* - connect semantics theorems of flat-to-flat passes --------------------- *)
 
-open flat_uncheck_ctorsProofTheory flat_elimProofTheory
-     flat_exh_matchProofTheory flat_reorder_matchProofTheory
-
 val _ = set_grammar_ancestry
-  (["flat_uncheck_ctorsProof", "flat_elimProof",
-    "flat_exh_matchProof", "flat_reorder_matchProof"]
+  (["flat_elimProof", "flat_patternProof"]
    @ grammar_ancestry);
 
-Theorem compile_decs_tidx_thm:
-   !n1 next1 env1 ds1 n2 next2 env2 ds2.
-   compile_decs n1 next1 env1 ds1 = (n2, next2, env2, ds2)
-   ==>
-   ALL_DISTINCT (get_tdecs ds2) /\
-   EVERY (\d. !t s. d = Dtype t s ==> next1.tidx <= t /\ t < next2.tidx) ds2 /\
-   (next1.tidx = next2.tidx <=> get_tdecs ds2 = [])
-Proof
-  ho_match_mp_tac compile_decs_ind
-  \\ rw [compile_decs_def] \\ fs [get_tdecs_def]
-  \\ rpt (pairarg_tac \\ fs []) \\ rw []
-  \\ fs [FILTER_APPEND, ALL_DISTINCT_APPEND, compile_exp_def,
-         MAPi_enumerate_MAP, FILTER_MAP, MAP_MAP_o, o_DEF, UNCURRY,
-         EVERY_MEM, MEM_MAPi] \\ rw []
-  \\ fs [MAP_enumerate_MAPi, LAMBDA_PROD]
-  >-
-   (rename1 `_ + x`
-    \\ map_every qid_spec_tac [`x`,`type_def`]
-    \\ Induct \\ rw [MEM_MAPi]
-    \\ fs [ELIM_UNCURRY, o_DEF, ADD1]
-    \\ first_x_assum (qspec_then `x + 1` assume_tac)
-    \\ once_rewrite_tac [DECIDE ``x + (n + 1) = n + (x + 1n)``] \\ fs [])
-  >-
-   (rename1 `_ + x`
-    \\ map_every qid_spec_tac [`x`,`type_def`]
-    \\ Induct \\ rw [miscTheory.enumerate_def])
-  \\ fs [GSYM get_tdecs_def]
-  \\ imp_res_tac get_tdecs_MEM \\ fs []
-  \\ res_tac \\ fs []
-  \\ imp_res_tac compile_decs_num_bindings \\ fs []
-  \\ TRY (eq_tac \\ rw [] \\ fs [])
-  \\
-   (strip_tac
-    \\ imp_res_tac get_tdecs_MEM \\ fs []
-    \\ res_tac \\ fs [])
-QED
-
 Theorem compile_flat_correct:
-   EVERY (is_new_type init_ctors) prog /\
-   ALL_DISTINCT (get_tdecs prog) /\
-   semantics F T ffi prog <> Fail
+   compile_flat cfg prog = (cfg', prog') /\
+   semantics T ffi prog <> Fail /\
+   cfg_precondition cfg
    ==>
-   semantics F T ffi prog = semantics T F ffi (compile_flat prog)
+   semantics T ffi prog = semantics T ffi prog'
 Proof
   rw [compile_flat_def]
-  \\ metis_tac [flat_uncheck_ctorsProofTheory.compile_decs_semantics,
-                flat_elimProofTheory.flat_remove_semantics,
-                flat_reorder_matchProofTheory.compile_decs_semantics,
-                flat_exh_matchProofTheory.compile_decs_semantics]
+  \\ metis_tac [flat_patternProofTheory.compile_decs_semantics,
+        flat_elimProofTheory.flat_remove_semantics]
 QED
 
 Theorem compile_semantics:
    source_to_flatProof$precondition s env c ⇒
    ¬semantics_prog s env prog Fail ⇒
-   semantics_prog s env prog (semantics T F s.ffi (SND (compile c prog)))
+   semantics_prog s env prog (semantics T s.ffi (SND (compile c prog)))
 Proof
   rw [compile_def] \\ pairarg_tac \\ fs []
   \\ imp_res_tac compile_prog_correct \\ rfs []
-  \\ `semantics F T s.ffi p' <> Fail` by (CCONTR_TAC \\ fs [])
-  \\ `semantics F T s.ffi p' = semantics T F s.ffi (compile_flat p')`
-    suffices_by (rw []\\ fs [])
-  \\ match_mp_tac compile_flat_correct \\ fs []
-  \\ fs [compile_prog_def]
-  \\ pairarg_tac \\ fs [] \\ rveq
-  \\ imp_res_tac compile_decs_tidx_thm
-  \\ fs [glob_alloc_def, get_tdecs_def]
-  \\ fs [GSYM glob_alloc_def, GSYM get_tdecs_def]
-  \\ rw [EVERY_MEM, is_new_type_def]
-  \\ strip_tac
-  \\ `tid <> 0 ==> tid = 1`
-    by fs [flat_exh_matchTheory.init_ctors_def, FDOM_FUPDATE_LIST]
-  \\ `c.next.tidx > 1`
-    by (fs [precondition_def, invariant_def]
-        \\ qhdtm_x_assum `source_to_flatProof$genv_c_ok` mp_tac
-        \\ qpat_x_assum `!x.!y.!z._ ==> _` mp_tac
-        \\ qpat_x_assum `FDOM _ = _` mp_tac
-        \\ EVAL_TAC \\ fs [flookup_thm] \\ rw []
-        \\ CCONTR_TAC \\ fs [])
-  \\ fs [glob_alloc_def, EVERY_MEM]
-  \\ res_tac \\ fs []
+  \\ `semantics T s.ffi p' <> Fail` by (CCONTR_TAC \\ fs [])
+  \\ pairarg_tac \\ fs []
+  \\ drule_then drule compile_flat_correct
+  \\ impl_tac \\ rw [] \\ fs []
+  \\ fs [precondition_def, compile_prog_def]
+  \\ pairarg_tac \\ fs []
+  \\ rveq \\ fs []
 QED
 
 (* - esgc_free theorems for compile_exp ------------------------------------ *)
@@ -4314,18 +4312,14 @@ Proof
 QED
 
 Theorem compile_flat_esgc_free:
+   compile_flat cfg ds = (cfg', ds') /\
    EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet ds))
    ==>
-   EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet (compile_flat ds)))
+   EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet ds'))
 Proof
-  rw [compile_flat_def, flat_exh_matchTheory.compile_def]
-  \\ drule flat_exh_matchProofTheory.compile_decs_esgc_free
-  \\ disch_then (qspec_then `init_ctors` mp_tac) \\ rw []
-  \\ drule flat_elimProofTheory.remove_flat_prog_esgc_free \\ rw []
-  \\ rename1 `compile_decs (compile_decs ds1)`
-  \\ irule flat_reorder_matchProofTheory.compile_decs_esgc_free
-  \\ irule flat_uncheck_ctorsProofTheory.compile_decs_esgc_free
-  \\ rw[]
+  rw [compile_flat_def, compile_def]
+  \\ drule_then irule flat_patternProofTheory.compile_decs_esgc_free
+  \\ simp [flat_elimProofTheory.remove_flat_prog_esgc_free]
 QED
 
 Theorem compile_esgc_free:
@@ -4334,7 +4328,7 @@ Theorem compile_esgc_free:
    EVERY esgc_free (MAP dest_Dlet (FILTER is_Dlet p1))
 Proof
   rw [compile_def]
-  \\ pairarg_tac \\ fs [] \\ rveq
+  \\ rpt (pairarg_tac \\ fs [])
   \\ metis_tac [compile_prog_esgc_free, compile_flat_esgc_free]
 QED
 
@@ -4439,17 +4433,14 @@ Proof
 QED
 
 Theorem compile_flat_sub_bag:
-  elist_globals (MAP dest_Dlet (FILTER is_Dlet (compile_flat p))) <=
+  compile_flat cfg p = (cfg', p') ==>
+  elist_globals (MAP dest_Dlet (FILTER is_Dlet p')) <=
   elist_globals (MAP dest_Dlet (FILTER is_Dlet p))
 Proof
-  fs [source_to_flatTheory.compile_flat_def,
-    flat_exh_matchTheory.compile_def]
-  \\ metis_tac [flat_exh_matchProofTheory.compile_decs_sub_bag,
-        flat_exh_matchProofTheory.compile_decs_sub_bag,
-       flat_reorder_matchProofTheory.compile_decs_sub_bag,
-       flat_uncheck_ctorsProofTheory.compile_decs_sub_bag,
+  fs [source_to_flatTheory.compile_flat_def]
+  \\ metis_tac [
        flat_elimProofTheory.remove_flat_prog_sub_bag,
-        bagTheory.SUB_BAG_TRANS]
+       flat_patternProofTheory.compile_decs_elist_globals]
 QED
 
 Theorem SUB_BAG_IMP:
@@ -4484,7 +4475,8 @@ Proof
   \\ imp_res_tac compile_decs_elist_globals
   \\ fs []
   \\ rpt (gen_tac ORELSE disch_tac)
-  \\ drule (MATCH_MP SUB_BAG_IMP compile_flat_sub_bag)
+  \\ imp_res_tac compile_flat_sub_bag
+  \\ drule_then drule SUB_BAG_IMP
   \\ fs [source_to_flatTheory.glob_alloc_def, flatPropsTheory.op_gbag_def]
   \\ fs [IN_LIST_TO_BAG, MEM_MAP, MEM_COUNT_LIST]
 QED
diff --git a/compiler/backend/semantics/README.md b/compiler/backend/semantics/README.md
index 44e4f805ff..7658a45fcf 100644
--- a/compiler/backend/semantics/README.md
+++ b/compiler/backend/semantics/README.md
@@ -46,12 +46,6 @@ Properties about labLang and its semantics
 [labSemScript.sml](labSemScript.sml):
 The formal semantics of labLang
 
-[patPropsScript.sml](patPropsScript.sml):
-Properties about patLang and its semantics
-
-[patSemScript.sml](patSemScript.sml):
-The formal semantics of patLang
-
 [stackPropsScript.sml](stackPropsScript.sml):
 Properties about stackLang and its semantics
 
diff --git a/compiler/backend/semantics/bvlSemScript.sml b/compiler/backend/semantics/bvlSemScript.sml
index 3a2b4fec3f..02e8b1db9f 100644
--- a/compiler/backend/semantics/bvlSemScript.sml
+++ b/compiler/backend/semantics/bvlSemScript.sml
@@ -157,8 +157,15 @@ val do_app_def = Define `
         else
           Rval (Block tag (xs++TAKE (Num len) (DROP (Num lower) xs')), s)
     | (ConsExtend tag,_) => Error
-    | (El,[Block tag xs;Number i]) =>
+    | (El,[Block tag xs; Number i]) =>
         if 0 ≤ i ∧ Num i < LENGTH xs then Rval (EL (Num i) xs, s) else Error
+    | (El,[RefPtr ptr; Number i]) =>
+        (case FLOOKUP s.refs ptr of
+         | SOME (ValueArray xs) =>
+            (if 0 <= i /\ i < & (LENGTH xs)
+             then Rval (EL (Num i) xs, s)
+             else Error)
+         | _ => Error)
     | (ListAppend,[x1;x2]) =>
         (case (v_to_list x1, v_to_list x2) of
          | (SOME xs, SOME ys) => Rval (list_to_v (xs ++ ys),s)
@@ -251,6 +258,8 @@ val do_app_def = Define `
         | _ => Error)
     | (TagEq n,[Block tag xs]) =>
         Rval (Boolv (tag = n), s)
+    | (LenEq l,[Block tag xs]) =>
+        Rval (Boolv (LENGTH xs = l),s)
     | (TagLenEq n l,[Block tag xs]) =>
         Rval (Boolv (tag = n ∧ LENGTH xs = l),s)
     | (EqualInt i,[x1]) =>
@@ -264,13 +273,6 @@ val do_app_def = Define `
     | (Ref,xs) =>
         let ptr = (LEAST ptr. ~(ptr IN FDOM s.refs)) in
           Rval (RefPtr ptr, s with refs := s.refs |+ (ptr,ValueArray xs))
-    | (Deref,[RefPtr ptr; Number i]) =>
-        (case FLOOKUP s.refs ptr of
-         | SOME (ValueArray xs) =>
-            (if 0 <= i /\ i < & (LENGTH xs)
-             then Rval (EL (Num i) xs, s)
-             else Error)
-         | _ => Error)
     | (Update,[RefPtr ptr; Number i; x]) =>
         (case FLOOKUP s.refs ptr of
          | SOME (ValueArray xs) =>
diff --git a/compiler/backend/semantics/closPropsScript.sml b/compiler/backend/semantics/closPropsScript.sml
index 9c21c20a2a..f87dcda326 100644
--- a/compiler/backend/semantics/closPropsScript.sml
+++ b/compiler/backend/semantics/closPropsScript.sml
@@ -371,7 +371,55 @@ Proof
   once_rewrite_tac[every_Fn_vs_SOME_EVERY] \\ rw[]
 QED
 
-val fv_def = tDefine "fv" `
+Theorem exp3_size:
+  closLang$exp3_size xs = LENGTH xs + SUM (MAP exp_size xs)
+Proof
+  Induct_on `xs` \\ simp [closLangTheory.exp_size_def]
+QED
+
+Theorem exp1_size_rw[simp]:
+   exp1_size fbinds =
+     exp3_size (MAP SND fbinds) + SUM (MAP FST fbinds) + LENGTH fbinds
+Proof
+  Induct_on `fbinds` \\ simp[FORALL_PROD, closLangTheory.exp_size_def]
+QED
+
+Definition no_mti_def:
+  (no_mti (Var t n) = T) ∧
+  (no_mti (If t e1 e2 e3) <=>
+    no_mti e1 /\
+    no_mti e2 /\
+    no_mti e3) ∧
+  (no_mti (Let t es e) <=>
+    EVERY no_mti es /\
+    no_mti e) ∧
+  (no_mti (Raise t e) <=>
+    no_mti e) ∧
+  (no_mti (Handle t e1 e2) <=>
+    no_mti e1 /\
+    no_mti e2) ∧
+  (no_mti (Tick t e) <=>
+    no_mti e) ∧
+  (no_mti (Call t ticks n es) = F) /\
+  (no_mti (App t opt e es) <=>
+    LENGTH es = 1 /\ opt = NONE /\
+    EVERY no_mti es /\
+    no_mti e) ∧
+  (no_mti (Fn t opt1 opt2 num_args e) <=>
+    num_args = 1 /\ opt1 = NONE /\ opt2 = NONE /\
+    no_mti e) /\
+  (no_mti (Letrec t opt1 opt2 funs e) <=>
+    no_mti e /\ opt1 = NONE /\ opt2 = NONE /\
+    EVERY (\x. FST x = 1 /\ no_mti (SND x)) funs) ∧
+  (no_mti (closLang$Op t op es) <=>
+    EVERY no_mti es)
+Termination
+  WF_REL_TAC `measure exp_size` \\ simp []
+  \\ rw []
+  \\ fs [MEM_SPLIT, SUM_APPEND, exp3_size, exp_size_def]
+End
+
+Definition fv_def:
   (fv n [] <=> F) /\
   (fv n ((x:closLang$exp)::y::xs) <=>
      fv n [x] \/ fv n (y::xs)) /\
@@ -391,15 +439,13 @@ val fv_def = tDefine "fv" `
      EXISTS (\(num_args, x). fv (n + num_args + LENGTH fns) [x]) fns \/ fv (n + LENGTH fns) [x1]) /\
   (fv n [Handle _ x1 x2] <=>
      fv n [x1] \/ fv (n+1) [x2]) /\
-  (fv n [Call _ ticks dest xs] <=> fv n xs)`
- (WF_REL_TAC `measure (exp3_size o SND)`
-  \\ REPEAT STRIP_TAC \\ TRY DECIDE_TAC \\
-  Induct_on `fns` >>
-  srw_tac [ARITH_ss] [exp_size_def] >>
-  res_tac >>
-  srw_tac [ARITH_ss] [exp_size_def]);
-
-val fv_ind = theorem"fv_ind";
+  (fv n [Call _ ticks dest xs] <=> fv n xs)
+Termination
+  WF_REL_TAC `measure (exp3_size o SND)`
+  \\ simp []
+  \\ rw []
+  \\ fs [MEM_SPLIT, exp3_size, SUM_APPEND]
+End
 
 Theorem fv_append[simp]:
    ∀v l1. fv v (l1 ++ l2) ⇔ fv v l1 ∨ fv v l2
@@ -555,6 +601,23 @@ Proof
   \\ Cases_on `t` \\ full_simp_tac(srw_ss())[]
 QED
 
+Theorem evaluate_APPEND:
+  !xs ys env s.
+    evaluate (xs ++ ys,env,s) =
+      case evaluate (xs,env,s) of
+        (Rval vs,s2) =>
+          (case evaluate (ys,env,s2) of
+             (Rval ws,s1) => (Rval (vs ++ ws),s1)
+           | (Rerr v8,s1) => (Rerr v8,s1))
+      | (Rerr v10,s2) => (Rerr v10,s2)
+Proof
+  Induct \\ fs [evaluate_def]
+  THEN1 (rw [] \\ every_case_tac \\ fs [])
+  \\ once_rewrite_tac [evaluate_CONS] \\ rw []
+  \\ every_case_tac \\ fs []
+  \\ rveq \\ fs []
+QED
+
 Theorem evaluate_SNOC:
    !xs env s x.
       evaluate (SNOC x xs,env,s) =
@@ -565,18 +628,7 @@ Theorem evaluate_SNOC:
           | t => t)
       | t => t
 Proof
-  Induct THEN1
-   (full_simp_tac(srw_ss())[SNOC_APPEND,evaluate_def] \\ REPEAT STRIP_TAC
-    \\ Cases_on `evaluate ([x],env,s)` \\ Cases_on `q` \\ full_simp_tac(srw_ss())[])
-  \\ full_simp_tac(srw_ss())[SNOC_APPEND,APPEND]
-  \\ ONCE_REWRITE_TAC [evaluate_CONS]
-  \\ REPEAT STRIP_TAC
-  \\ Cases_on `evaluate ([h],env,s)` \\ Cases_on `q` \\ full_simp_tac(srw_ss())[]
-  \\ Cases_on `evaluate (xs,env,r)` \\ Cases_on `q` \\ full_simp_tac(srw_ss())[]
-  \\ Cases_on `evaluate ([x],env,r')` \\ Cases_on `q` \\ full_simp_tac(srw_ss())[evaluate_def]
-  \\ IMP_RES_TAC evaluate_IMP_LENGTH
-  \\ Cases_on `a''` \\ full_simp_tac(srw_ss())[LENGTH]
-  \\ REV_FULL_SIMP_TAC std_ss [LENGTH_NIL] \\ full_simp_tac(srw_ss())[]
+  fs [SNOC_APPEND,evaluate_APPEND]
 QED
 
 val evaluate_const_ind =
@@ -1680,8 +1732,7 @@ Theorem exp_size_MEM:
    (∀e elist. MEM e elist ⇒ exp_size e < exp3_size elist) ∧
    (∀x e ealist. MEM (x,e) ealist ⇒ exp_size e < exp1_size ealist)
 Proof
-  conj_tac >| [Induct_on `elist`, Induct_on `ealist`] >> dsimp[] >>
-  rpt strip_tac >> res_tac >> simp[]
+  rw [MEM_SPLIT] \\ simp [exp3_size, SUM_APPEND]
 QED
 
 Theorem evaluate_eq_nil[simp]:
@@ -1706,13 +1757,6 @@ Proof
   Cases_on `h` >> simp[]
 QED
 
-Theorem exp1_size_rw[simp]:
-   exp1_size fbinds =
-     exp3_size (MAP SND fbinds) + SUM (MAP FST fbinds) + LENGTH fbinds
-Proof
-  Induct_on `fbinds` >> simp[]
-QED
-
 val set_globals_def = tDefine "set_globals" `
   (set_globals (Var _ _) = {||}) ∧
   (set_globals (If _ e1 e2 e3) =
@@ -2199,6 +2243,7 @@ Proof
                (?n. opp = Label n) \/ (?n. opp = Cons n) \/
                (?i. opp = LessConstSmall i) \/ opp = LengthByteVec \/
                (?i. opp = EqualInt i) \/ (?n. opp = TagEq n) \/
+               (?n. opp = LenEq n) \/
                (?n n1. opp = TagLenEq n n1) \/ opp = Install \/
                (?w oo k. opp = WordShift w oo k) \/
                (?b. opp = WordFromWord b) \/
@@ -2214,8 +2259,8 @@ Proof
     \\ TRY (res_tac \\ fs [isClos_cases] \\ NO_TAC))
   \\ Cases_on `opp = Length \/ (?b. opp = BoundsCheckByte b) \/
                opp = BoundsCheckArray \/ opp = LengthByte \/
-               opp = DerefByteVec \/ opp = DerefByte \/ opp = Deref \/
-               opp = GlobalsPtr \/ opp = El \/ opp = SetGlobalsPtr`
+               opp = DerefByteVec \/ opp = DerefByte \/
+               opp = GlobalsPtr \/ opp = SetGlobalsPtr \/ opp = El`
   THEN1
    (Cases_on `do_app opp ys t` \\ fs [] \\ rveq \\ pop_assum mp_tac
     \\ simp [do_app_def,case_eq_thms,pair_case_eq,bool_case_eq]
@@ -3410,4 +3455,11 @@ Proof
   >- ( rw[EXTENSION] \\ metis_tac[] )
 QED
 
+Theorem initial_state_clock:
+  (initial_state ffi max_app f co cc k).clock = k /\
+  ((initial_state ffi max_app f co cc k' with clock := k) = initial_state ffi max_app f co cc k)
+Proof
+  EVAL_TAC
+QED
+
 val _ = export_theory();
diff --git a/compiler/backend/semantics/closSemScript.sml b/compiler/backend/semantics/closSemScript.sml
index c1660e4b64..bf1cddb6f6 100644
--- a/compiler/backend/semantics/closSemScript.sml
+++ b/compiler/backend/semantics/closSemScript.sml
@@ -182,8 +182,15 @@ val do_app_def = Define `
         else
           Rval (Block tag (xs++TAKE (Num len) (DROP (Num lower) xs')), s)
     | (ConsExtend tag,_) => Error
-    | (El,[Block tag xs;Number i]) =>
+    | (El,[Block tag xs; Number i]) =>
         if 0 ≤ i ∧ Num i < LENGTH xs then Rval (EL (Num i) xs, s) else Error
+    | (El,[RefPtr ptr; Number i]) =>
+        (case FLOOKUP s.refs ptr of
+         | SOME (ValueArray xs) =>
+            (if 0 <= i /\ i < & (LENGTH xs)
+             then Rval (EL (Num i) xs, s)
+             else Error)
+         | _ => Error)
     | (ListAppend, [x1; x2]) =>
         (case (v_to_list x1, v_to_list x2) of
         | (SOME xs, SOME ys) => Rval (list_to_v (xs ++ ys), s)
@@ -276,6 +283,8 @@ val do_app_def = Define `
         | _ => Error)
     | (TagEq n,[Block tag xs]) =>
         Rval (Boolv (tag = n), s)
+    | (LenEq l,[Block tag xs]) =>
+        Rval (Boolv (LENGTH xs = l),s)
     | (TagLenEq n l,[Block tag xs]) =>
         Rval (Boolv (tag = n ∧ LENGTH xs = l),s)
     | (Equal,[x1;x2]) =>
@@ -285,13 +294,6 @@ val do_app_def = Define `
     | (Ref,xs) =>
         let ptr = (LEAST ptr. ~(ptr IN FDOM s.refs)) in
           Rval (RefPtr ptr, s with refs := s.refs |+ (ptr,ValueArray xs))
-    | (Deref,[RefPtr ptr; Number i]) =>
-        (case FLOOKUP s.refs ptr of
-         | SOME (ValueArray xs) =>
-            (if 0 <= i /\ i < & (LENGTH xs)
-             then Rval (EL (Num i) xs, s)
-             else Error)
-         | _ => Error)
     | (Update,[RefPtr ptr; Number i; x]) =>
         (case FLOOKUP s.refs ptr of
          | SOME (ValueArray xs) =>
diff --git a/compiler/backend/semantics/dataSemScript.sml b/compiler/backend/semantics/dataSemScript.sml
index 2aabe2a78b..e3bbdc2041 100644
--- a/compiler/backend/semantics/dataSemScript.sml
+++ b/compiler/backend/semantics/dataSemScript.sml
@@ -709,8 +709,15 @@ val do_app_aux_def = Define `
                                     in Rval (Block ts tag l,
                                              check_lim s' (LENGTH l)))
     | (ConsExtend tag,_) => Error
-    | (El,[Block _ tag xs;Number i]) =>
+    | (El,[Block _ tag xs; Number i]) =>
         if 0 ≤ i ∧ Num i < LENGTH xs then Rval (EL (Num i) xs, s) else Error
+    | (El,[RefPtr ptr; Number i]) =>
+        (case lookup ptr s.refs of
+         | SOME (ValueArray xs) =>
+            (if 0 <= i /\ i < & (LENGTH xs)
+             then Rval (EL (Num i) xs, s)
+             else Error)
+         | _ => Error)
     | (ListAppend,[x1;x2]) =>
         (case (v_to_list x1, v_to_list x2) of
          | (SOME xs, SOME ys) =>
@@ -763,6 +770,8 @@ val do_app_aux_def = Define `
          | _ => Error)
     | (TagEq n,[Block _ tag xs]) =>
         Rval (Boolv (tag = n), s)
+    | (LenEq l,[Block _ tag xs]) =>
+        Rval (Boolv (LENGTH xs = l),s)
     | (TagLenEq n l,[Block _ tag xs]) =>
         Rval (Boolv (tag = n ∧ LENGTH xs = l),s)
     | (EqualInt i,[x1]) =>
@@ -776,13 +785,6 @@ val do_app_aux_def = Define `
     | (Ref,xs) =>
         let ptr = (LEAST ptr. ~(ptr IN domain s.refs)) in
           Rval (RefPtr ptr, s with <| refs := insert ptr (ValueArray xs) s.refs|>)
-    | (Deref,[RefPtr ptr; Number i]) =>
-        (case lookup ptr s.refs of
-         | SOME (ValueArray xs) =>
-            (if 0 <= i /\ i < & (LENGTH xs)
-             then Rval (EL (Num i) xs, s)
-             else Error)
-         | _ => Error)
     | (Update,[RefPtr ptr; Number i; x]) =>
         (case lookup ptr s.refs of
          | SOME (ValueArray xs) =>
diff --git a/compiler/backend/semantics/flatPropsScript.sml b/compiler/backend/semantics/flatPropsScript.sml
index 1a60d2e035..e086eff44a 100644
--- a/compiler/backend/semantics/flatPropsScript.sml
+++ b/compiler/backend/semantics/flatPropsScript.sml
@@ -1,7 +1,7 @@
 (*
   Properties about flatLang and its semantics
 *)
-open preamble flatSemTheory
+open preamble flatSemTheory flatLangTheory
 local
   open astTheory semanticPrimitivesPropsTheory terminationTheory
        evaluatePropsTheory
@@ -21,12 +21,12 @@ Proof
 QED
 
 Theorem pat_bindings_accum:
-   (∀p acc. flatSem$pat_bindings p acc = pat_bindings p [] ⧺ acc) ∧
+   (∀p acc. flatLang$pat_bindings p acc = pat_bindings p [] ⧺ acc) ∧
     ∀ps acc. pats_bindings ps acc = pats_bindings ps [] ⧺ acc
 Proof
   ho_match_mp_tac flatLangTheory.pat_induction >>
   rw [] >>
-  REWRITE_TAC [flatSemTheory.pat_bindings_def] >>
+  REWRITE_TAC [flatLangTheory.pat_bindings_def] >>
   metis_tac [APPEND, APPEND_ASSOC]
 QED
 
@@ -34,11 +34,21 @@ Theorem pats_bindings_FLAT_MAP:
   ∀ps acc. pats_bindings ps acc = FLAT (REVERSE (MAP (λp. pat_bindings p []) ps)) ++ acc
 Proof
   Induct
-  \\ simp[pat_bindings_def]
-  \\ Cases \\ simp[pat_bindings_def]
+  \\ simp[flatLangTheory.pat_bindings_def]
+  \\ Cases \\ simp[flatLangTheory.pat_bindings_def]
   \\ metis_tac[pat_bindings_accum]
 QED
 
+Theorem pmatch_stamps_ok_OPTREL:
+  pmatch_stamps_ok c chk_c stmp stmp' ps vs =
+  (OPTREL (\n n'. chk_c ⇒ (n,LENGTH ps) ∈ c ∧ ctor_same_type (SOME n) (SOME n'))
+        stmp stmp'
+    ∧ (stmp = NONE ⇒ chk_c ∧ LENGTH ps = LENGTH vs))
+Proof
+  Cases_on `stmp` \\ Cases_on `stmp'`
+  \\ simp [pmatch_stamps_ok_def, OPTREL_def]
+QED
+
 Theorem pmatch_state:
   (∀ (st:'ffi state) p v l (st':'ffi state) res .
     pmatch st p v l = res ∧
@@ -55,7 +65,7 @@ Theorem pmatch_state:
 Proof
   ho_match_mp_tac pmatch_ind >>
   rw[pmatch_def] >>
-  EVERY_CASE_TAC >> fs[]
+  EVERY_CASE_TAC >> fs[] >> res_tac >> fs []
 QED
 
 Theorem pmatch_extend:
@@ -69,7 +79,7 @@ Theorem pmatch_extend:
     ?env''. env' = env'' ++ env ∧ MAP FST env'' = pats_bindings ps [])
 Proof
   ho_match_mp_tac pmatch_ind >>
-  srw_tac[][pat_bindings_def, pmatch_def] >>
+  srw_tac[][flatLangTheory.pat_bindings_def, pmatch_def] >>
   every_case_tac >>
   full_simp_tac(srw_ss())[] >>
   srw_tac[][] >>
@@ -90,7 +100,7 @@ Theorem pmatch_bindings:
      MAP FST r = pats_bindings ps [] ++ MAP FST env
 Proof
   ho_match_mp_tac flatSemTheory.pmatch_ind >>
-  rw [pmatch_def, pat_bindings_def] >>
+  rw [pmatch_def, flatLangTheory.pat_bindings_def] >>
   rw [] >>
   every_case_tac >>
   fs [] >>
@@ -120,6 +130,7 @@ Proof
   BasicProvers.CASE_TAC >>
   full_simp_tac(srw_ss())[] >> strip_tac >> full_simp_tac(srw_ss())[] >>
   BasicProvers.CASE_TAC >> full_simp_tac(srw_ss())[] >>
+  fs [CaseEq"match_result"] >>
   metis_tac[semanticPrimitivesTheory.match_result_distinct]
 QED
 
@@ -135,6 +146,7 @@ Proof
   BasicProvers.CASE_TAC >>
   full_simp_tac(srw_ss())[] >> strip_tac >> full_simp_tac(srw_ss())[] >>
   BasicProvers.CASE_TAC >> full_simp_tac(srw_ss())[] >>
+  fs [CaseEq"match_result"] >>
   imp_res_tac pmatch_any_match >>
   metis_tac[semanticPrimitivesTheory.match_result_distinct]
 QED
@@ -156,6 +168,7 @@ Theorem pmatch_list_pairwise:
 Proof
   Induct >> Cases_on`vs` >> simp[pmatch_def] >>
   rpt gen_tac >> BasicProvers.CASE_TAC >> strip_tac >>
+  fs [CaseEq"match_result"] >>
   res_tac >> simp[] >> metis_tac[pmatch_any_match]
 QED;
 
@@ -167,15 +180,40 @@ Proof
   Cases_on`ps`>>Cases_on`vs`>>simp[pmatch_def]
 QED;
 
+Theorem pmatch_list_append:
+   ∀ps vs ps' vs' s env. LENGTH ps = LENGTH vs ⇒
+      pmatch_list s (ps ++ ps') (vs ++ vs') env =
+      case pmatch_list s ps vs env of
+      | Match env' => pmatch_list s ps' vs' env'
+      | Match_type_error => Match_type_error
+      | No_match =>
+          case pmatch_list s ps' vs' env of
+          | Match_type_error => Match_type_error
+          | _ => No_match
+Proof
+  Induct >> Cases_on`vs` >> simp[pmatch_def] >> srw_tac[][]
+  \\ reverse (Cases_on `pmatch s h' h env`) \\ fs []
+  \\ first_x_assum (qspec_then `t` mp_tac) \\ fs []
+  \\ rpt (CASE_TAC \\ fs [])
+  \\ imp_res_tac pmatch_any_no_match \\ fs []
+  \\ imp_res_tac pmatch_any_match_error \\ fs []
+QED
+
 Theorem pmatch_list_snoc:
    ∀ps vs p v s env. LENGTH ps = LENGTH vs ⇒
       pmatch_list s (SNOC p ps) (SNOC v vs) env =
       case pmatch_list s ps vs env of
       | Match env' => pmatch s p v env'
-      | res => res
-Proof
-  Induct >> Cases_on`vs` >> simp[pmatch_def] >> srw_tac[][] >>
-  BasicProvers.CASE_TAC
+      | Match_type_error => Match_type_error
+      | No_match =>
+          case pmatch s p v env of
+          | Match_type_error => Match_type_error
+          | _ => No_match
+Proof
+  fs [SNOC_APPEND,pmatch_list_append]
+  \\ fs [pmatch_def] \\ rw []
+  \\ Cases_on `pmatch s p v env` \\ fs []
+  \\ every_case_tac \\ fs []
 QED;
 
 Theorem pmatch_append:
@@ -190,9 +228,13 @@ Proof
   srw_tac[][pmatch_def] \\ fs[]
   >- ( BasicProvers.CASE_TAC >> full_simp_tac(srw_ss())[] >>
        BasicProvers.CASE_TAC >> full_simp_tac(srw_ss())[]) >>
-  pop_assum (qspec_then`n`mp_tac) >>
+  first_x_assum (qspec_then`n`mp_tac) >>
   Cases_on `pmatch s p v (TAKE n env)`>>full_simp_tac(srw_ss())[] >>
-  strip_tac >> res_tac >>
+  strip_tac >> res_tac
+  THEN1
+   (first_x_assum (qspec_then`n`mp_tac) >> fs []
+    \\ first_x_assum (qspec_then`n`mp_tac) >> fs []
+    \\ Cases_on `pmatch_list s ps vs (TAKE n env)` \\ fs []) >>
   qmatch_assum_rename_tac`pmatch s p v (TAKE n env) = Match env1` >>
   pop_assum(qspec_then`LENGTH env1`mp_tac) >>
   simp_tac(srw_ss())[rich_listTheory.TAKE_LENGTH_APPEND,rich_listTheory.DROP_LENGTH_APPEND]
@@ -219,9 +261,17 @@ Theorem pmatch_ignore_clock:
 Proof
   ho_match_mp_tac pmatch_ind >>
   rw [pmatch_def] >>
-  fs [] >>
+  fs [pmatch_stamps_ok_OPTREL] >>
   every_case_tac >>
-  rw []
+  rw [] >>
+  rfs []
+QED
+
+Theorem pmatch_rows_ignore_clock[simp]:
+  !pes s v c.
+    pmatch_rows pes (s with clock := c) v = pmatch_rows pes s v
+Proof
+  Induct \\ fs [FORALL_PROD,pmatch_rows_def,pmatch_ignore_clock]
 QED
 
 val build_rec_env_help_lem = Q.prove (
@@ -255,9 +305,7 @@ val Unitv_simp = save_thm("Unitv_simp[simp]",
 
 Theorem evaluate_length:
    (∀env (s:'ffi flatSem$state) ls s' vs.
-      evaluate env s ls = (s',Rval vs) ⇒ LENGTH vs = LENGTH ls) ∧
-   (∀env (s:'ffi flatSem$state) v pes ev s' vs.
-      evaluate_match env s v pes ev = (s', Rval vs) ⇒ LENGTH vs = 1)
+      evaluate env s ls = (s',Rval vs) ⇒ LENGTH vs = LENGTH ls)
 Proof
   ho_match_mp_tac evaluate_ind >>
   srw_tac[][evaluate_def] >> srw_tac[][] >>
@@ -280,8 +328,7 @@ Proof
 QED
 
 Theorem evaluate_sing:
-   (evaluate env s [e] = (s',Rval vs) ⇒ ∃y. vs = [y]) ∧
-   (evaluate_match env s v pes ev = (s',Rval vs) ⇒ ∃y. vs = [y])
+   (evaluate env s [e] = (s',Rval vs) ⇒ ∃y. vs = [y])
 Proof
   srw_tac[][] >> imp_res_tac evaluate_length >> full_simp_tac(srw_ss())[] >> metis_tac[SING_HD]
 QED
@@ -309,7 +356,6 @@ QED
 Theorem do_app_state_unchanged:
   !c s op vs s' r. do_app c s op vs = SOME (s', r) ⇒
      s.c = s'.c ∧
-     s.exh_pat = s'.exh_pat ∧
      s.check_ctor = s'.check_ctor
 Proof
   rw [do_app_cases] >>
@@ -320,11 +366,6 @@ QED
 Theorem evaluate_state_unchanged:
   (!env (s:'ffi state) e s' r. evaluate env s e = (s', r) ⇒
      s.c = s'.c ∧
-     s.exh_pat = s'.exh_pat ∧
-     s.check_ctor = s'.check_ctor) ∧
-  (!env (s:'ffi state) v pes ev s' r. evaluate_match env s v pes ev = (s', r) ⇒
-     s.c = s'.c ∧
-     s.exh_pat = s'.exh_pat ∧
      s.check_ctor = s'.check_ctor)
 Proof
   ho_match_mp_tac evaluate_ind >>
@@ -337,7 +378,6 @@ QED
 
 Theorem evaluate_dec_state_unchanged:
   !(s:'ffi state) d s' r. evaluate_dec s d = (s', r) ⇒
-     s.exh_pat = s'.exh_pat ∧
      s.check_ctor = s'.check_ctor
 Proof
   Cases_on `d` >> rw [evaluate_dec_def] >>
@@ -347,7 +387,6 @@ QED
 
 Theorem evaluate_decs_state_unchanged:
   !(s:'ffi state) ds s' r. evaluate_decs s ds = (s', r) ⇒
-     s.exh_pat = s'.exh_pat ∧
      s.check_ctor = s'.check_ctor
 Proof
   Induct_on `ds` >> rw [evaluate_decs_def] >>
@@ -408,24 +447,19 @@ val do_app_add_to_clock_NONE = Q.prove (
   \\ fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs []
   \\ rpt (pairarg_tac \\ fs [])
   \\ fs [bool_case_eq, case_eq_thms]
-  \\ fs [IS_SOME_EXISTS,CaseEq"option"]);
+  \\ fs [IS_SOME_EXISTS,CaseEq"option",CaseEq"store_v"]);
 
 Theorem evaluate_add_to_clock:
    (∀env (s:'ffi flatSem$state) es s' r.
        evaluate env s es = (s',r) ∧
        r ≠ Rerr (Rabort Rtimeout_error) ⇒
        evaluate env (s with clock := s.clock + extra) es =
-         (s' with clock := s'.clock + extra,r)) ∧
-   (∀env (s:'ffi flatSem$state) pes v err_v s' r.
-       evaluate_match env s pes v err_v = (s',r) ∧
-       r ≠ Rerr (Rabort Rtimeout_error) ⇒
-       evaluate_match env (s with clock := s.clock + extra) pes v err_v =
          (s' with clock := s'.clock + extra,r))
 Proof
   ho_match_mp_tac evaluate_ind \\ rw [evaluate_def]
   \\ fs [case_eq_thms, pair_case_eq] \\ rw [] \\ fs [PULL_EXISTS]
   \\ rw [] \\ fs [pmatch_ignore_clock]
-  \\ fs [case_eq_thms, pair_case_eq, bool_case_eq] \\ rw []
+  \\ fs [case_eq_thms, pair_case_eq, bool_case_eq, CaseEq"match_result"] \\ rw []
   \\ fs [dec_clock_def]
   \\ rw [METIS_PROVE [] ``a \/ b <=> ~a ==> b``]
   \\ map_every imp_res_tac
@@ -524,9 +558,7 @@ QED
 
 Theorem evaluate_io_events_mono:
    (∀env (s:'ffi flatSem$state) es.
-      s.ffi.io_events ≼ (FST (evaluate env s es)).ffi.io_events) ∧
-   (∀env (s:'ffi flatSem$state) pes v err_v.
-      s.ffi.io_events ≼ (FST (evaluate_match env s pes v err_v)).ffi.io_events)
+      s.ffi.io_events ≼ (FST (evaluate env s es)).ffi.io_events)
 Proof
   ho_match_mp_tac evaluate_ind \\ rw [evaluate_def]
   \\ every_case_tac \\ fs [] \\ rfs []
@@ -544,10 +576,7 @@ QED
 Theorem evaluate_add_to_clock_io_events_mono:
    (∀env (s:'ffi flatSem$state) es extra.
        (FST (evaluate env s es)).ffi.io_events ≼
-       (FST (evaluate env (s with clock := s.clock + extra) es)).ffi.io_events) ∧
-   (∀env (s:'ffi flatSem$state) pes v err_v extra.
-       (FST (evaluate_match env s pes v err_v)).ffi.io_events ≼
-       (FST (evaluate_match env (s with clock := s.clock + extra) pes v err_v)).ffi.io_events)
+       (FST (evaluate env (s with clock := s.clock + extra) es)).ffi.io_events)
 Proof
   ho_match_mp_tac evaluate_ind \\ rw [evaluate_def] \\ fs []
   \\ rpt (PURE_FULL_CASE_TAC \\ fs []) \\ rfs []
@@ -582,7 +611,7 @@ Proof
   \\ qmatch_assum_abbrev_tac `evaluate ee (s with clock := _) pp = _`
   \\ qispl_then
          [`ee`,`s`,`pp`,`extra`] mp_tac
-         (CONJUNCT1 evaluate_add_to_clock_io_events_mono)
+         (evaluate_add_to_clock_io_events_mono)
   \\ rw [] \\ fs []
   \\ every_case_tac \\ fs []
 QED
@@ -735,6 +764,7 @@ Proof
 QED
   *)
 
+(*
 Theorem pmatch_evaluate_vars:
   (!(s:'a state) p v evs env' ts.
     flatSem$pmatch s p v evs = Match env' ∧
@@ -768,17 +798,17 @@ Proof
     every_case_tac >> full_simp_tac(srw_ss())[] )
   >- (
     match_mp_tac evaluate_vars >> srw_tac[][] >>
-    first_assum(match_exists_tac o concl) >> simp[] )
-  >- (
-    every_case_tac >> full_simp_tac(srw_ss())[] >>
-    `ALL_DISTINCT (pat_bindings p (MAP FST evs))`
-            by metis_tac[pat_bindings_accum, ALL_DISTINCT_APPEND] >>
-    `pat_bindings p (MAP FST evs) = MAP FST a`
-                 by (imp_res_tac pmatch_extend >>
-                     srw_tac[][] >>
-                     metis_tac [pat_bindings_accum]) >>
-    fsrw_tac[QUANT_INST_ss[record_default_qp]][] >>
-    rev_full_simp_tac(srw_ss())[])
+    first_assum(match_exists_tac o concl) >> simp[] ) >>
+  every_case_tac >> full_simp_tac(srw_ss())[] >>
+  `ALL_DISTINCT (pat_bindings p (MAP FST evs))`
+          by metis_tac[pat_bindings_accum, ALL_DISTINCT_APPEND] >>
+  rfs [] >> fs [] >>
+  `pat_bindings p (MAP FST evs) = MAP FST a`
+               by (imp_res_tac pmatch_extend >>
+                   srw_tac[][] >>
+                   metis_tac [pat_bindings_accum]) >>
+  fsrw_tac[QUANT_INST_ss[record_default_qp]][] >>
+  rev_full_simp_tac(srw_ss())[]
 QED
 
 Theorem pmatch_evaluate_vars_lem:
@@ -793,6 +823,7 @@ Proof
   imp_res_tac pmatch_evaluate_vars >>
   fs []
 QED
+*)
 
 Theorem pmatch_list_MAP_Pvar:
   LENGTH xs = LENGTH vs ⇒
@@ -1026,16 +1057,16 @@ QED
 
 val evaluate_decs_add_to_clock_initial_state = Q.prove(
   `r ≠ SOME (Rabort Rtimeout_error) ∧
-   evaluate_decs (initial_state ffi k x y) decs = (s',r) ⇒
-   evaluate_decs (initial_state ffi (ck + k) x y) decs =
+   evaluate_decs (initial_state ffi k x) decs = (s',r) ⇒
+   evaluate_decs (initial_state ffi (ck + k) x) decs =
    (s' with clock := s'.clock + ck,r)`,
   rw [initial_state_def]
   \\ imp_res_tac evaluate_decs_add_to_clock \\ fs []);
 
 val evaluate_decs_add_to_clock_initial_state_io_events_mono = Q.prove (
-  `evaluate_decs (initial_state ffi k x y) prog = (s',r) ==>
+  `evaluate_decs (initial_state ffi k x) prog = (s',r) ==>
    s'.ffi.io_events ≼
-   (FST (evaluate_decs (initial_state ffi (k+ck) x y) prog)).ffi.io_events`,
+   (FST (evaluate_decs (initial_state ffi (k+ck) x) prog)).ffi.io_events`,
   rw [initial_state_def]
   \\ qmatch_assum_abbrev_tac `evaluate_decs s1 _ = _`
   \\ qispl_then
@@ -1044,8 +1075,8 @@ val evaluate_decs_add_to_clock_initial_state_io_events_mono = Q.prove (
   \\ fs [Abbr`s1`]);
 
 val initial_state_with_clock = Q.prove (
-  `(initial_state ffi k x y with clock := (initial_state ffi k x y).clock + ck) =
-   initial_state ffi (k + ck) x y`,
+  `(initial_state ffi k x with clock := (initial_state ffi k x).clock + ck) =
+   initial_state ffi (k + ck) x`,
   rw [initial_state_def]);
 
 val SND_SND_lemma = prove(
@@ -1053,15 +1084,15 @@ val SND_SND_lemma = prove(
   PairCases_on `x` \\ fs []);
 
 val eval_sim_def = Define `
-  eval_sim ffi exh1 ctor1 ds1 exh2 ctor2 ds2 rel allow_fail =
+  eval_sim ffi ctor1 ds1 ctor2 ds2 rel allow_fail =
     !k res1 s2.
-      evaluate_decs (initial_state ffi k exh1 ctor1) ds1 =
+      evaluate_decs (initial_state ffi k ctor1) ds1 =
         (s2, res1) /\
       (allow_fail \/ res1 <> SOME (Rabort Rtype_error)) /\
       rel ds1 ds2
       ==>
       ?ck res2 t2.
-        evaluate_decs (initial_state ffi (k + ck) exh2 ctor2) ds2 =
+        evaluate_decs (initial_state ffi (k + ck) ctor2) ds2 =
           (t2, res2) /\
         s2.ffi = t2.ffi /\
         (res1 = NONE ==> res2 = NONE) /\
@@ -1069,11 +1100,11 @@ val eval_sim_def = Define `
         (!a. res1 = SOME (Rabort a) ==> res2 = SOME (Rabort a))`;
 
 Theorem IMP_semantics_eq:
-   eval_sim ffi exh1 ctor1 ds1 exh2 ctor2 ds2 rel F /\
-   semantics exh1 ctor1 (ffi:'ffi ffi_state) ds1 <> Fail ==>
+   eval_sim ffi ctor1 ds1 ctor2 ds2 rel F /\
+   semantics ctor1 (ffi:'ffi ffi_state) ds1 <> Fail ==>
    rel ds1 ds2 ==>
-   semantics exh1 ctor1 ffi ds1 =
-   semantics exh2 ctor2 ffi ds2
+   semantics ctor1 ffi ds1 =
+   semantics ctor2 ffi ds2
 Proof
   rewrite_tac [GSYM AND_IMP_INTRO]
   \\ strip_tac
@@ -1087,7 +1118,7 @@ Proof
     \\ IF_CASES_TAC \\ fs [SND_SND_lemma]
     \\ DEEP_INTRO_TAC some_intro \\ fs [] \\ rw []
     \\ fs [eval_sim_def]
-    \\ Cases_on `evaluate_decs (initial_state ffi k' exh1 ctor1) ds1`
+    \\ Cases_on `evaluate_decs (initial_state ffi k' ctor1) ds1`
     \\ `r' <> SOME (Rabort Rtype_error)` by metis_tac []
     \\ last_x_assum drule \\ strip_tac \\ rfs [])
   \\ DEEP_INTRO_TAC some_intro \\ fs [] \\ rw []
@@ -1134,7 +1165,7 @@ Proof
   \\ simp [Once semantics_def]
   \\ IF_CASES_TAC \\ fs [SND_SND_lemma]
   >-
-   (Cases_on `evaluate_decs (initial_state ffi k exh1 ctor1) ds1`
+   (Cases_on `evaluate_decs (initial_state ffi k ctor1) ds1`
     \\ first_x_assum (qspec_then `k` mp_tac)
     \\ disch_then (qspec_then `q` mp_tac)
     \\ disch_then (qspec_then `r` mp_tac)
@@ -1150,7 +1181,7 @@ Proof
   \\ DEEP_INTRO_TAC some_intro
   \\ fs [] \\ rw []
   >-
-   (Cases_on `evaluate_decs (initial_state ffi k exh1 ctor1) ds1`
+   (Cases_on `evaluate_decs (initial_state ffi k ctor1) ds1`
     \\ last_x_assum (qspecl_then [`k`, `q`, `r'`] mp_tac)
     \\ strip_tac \\ rfs []
     \\ fs [eval_sim_def]
@@ -1185,7 +1216,7 @@ Proof
   \\ unabbrev_all_tac \\ simp [PULL_EXISTS]
   \\ simp [LNTH_fromList, PULL_EXISTS, GSYM FORALL_AND_THM]
   \\ rpt gen_tac
-  \\ Cases_on `evaluate_decs (initial_state ffi k exh1 ctor1) ds1`
+  \\ Cases_on `evaluate_decs (initial_state ffi k ctor1) ds1`
   \\ fs [eval_sim_def]
   \\ first_x_assum drule
   \\ impl_keep_tac >- metis_tac []
@@ -1273,6 +1304,12 @@ Proof
   Induct_on `es` >> simp[]
 QED
 
+Theorem elist_globals_REVERSE:
+  elist_globals (REVERSE es) = elist_globals es
+Proof
+  Induct_on `es` \\ simp [elist_globals_append, COMM_BAG_UNION]
+QED
+
 val is_Dlet_def = Define `
   (is_Dlet (Dlet _) <=> T) /\
   (is_Dlet _ <=> F)`;
@@ -1281,4 +1318,487 @@ val dest_Dlet_def = Define `dest_Dlet (Dlet e) = e`;
 
 val _ = export_rewrites ["is_Dlet_def", "dest_Dlet_def"];
 
+Theorem initial_state_clock:
+  (initial_state ffi k b1).clock = k /\
+  ((initial_state ffi k b1 with clock := k1) = initial_state ffi k1 b1)
+Proof
+  EVAL_TAC
+QED
+
+Theorem build_rec_env_eq_MAP:
+  build_rec_env funs cl_env env =
+  MAP (\(f,x,e). (f,Recclosure cl_env funs f)) funs ++ env
+Proof
+  fs [build_rec_env_def]
+  \\ qspec_tac (`Recclosure cl_env funs`,`rr`)
+  \\ qid_spec_tac `env`
+  \\ qid_spec_tac `funs`
+  \\ Induct \\ fs [FORALL_PROD]
+QED
+
+Theorem evaluate_decs_add_to_clock_io_events_mono_alt:
+  !extra s1 res s prog s2 res2.
+    evaluate_decs s prog = (s1,res) /\
+    evaluate_decs (s with clock := s.clock + extra) prog = (s2,res2) ==>
+    s1.ffi.io_events ≼ s2.ffi.io_events
+Proof
+  rw []
+  \\ assume_tac (SPEC_ALL evaluate_decs_add_to_clock_io_events_mono)
+  \\ rfs []
+QED
+
+(* generic proof support for most val_rel/state_rel examples *)
+
+Definition isClosure_def:
+  isClosure exp = (
+    (?vs n x. exp = Closure vs n x) \/
+    (?vs fs x. exp = Recclosure vs fs x))
+End
+
+val v_conss = TypeBase.nchotomy_of ``: v``
+  |> concl |> dest_forall |> snd |> strip_disj
+  |> map (rhs o snd o strip_exists)
+
+Theorem isClosure_simps[simp] = map (fn x => SPEC x isClosure_def) v_conss
+  |> map (SIMP_RULE (bool_ss ++ simpLib.type_ssfrag ``: v``) [])
+  |> LIST_CONJ
+
+Definition simple_basic_val_rel_def[simp]:
+  (simple_basic_val_rel (Litv l) v = (v = Litv l)) /\
+  (simple_basic_val_rel (Loc i) v = (v = Loc i)) /\
+  (simple_basic_val_rel (Conv stmp vs1) v = (?vs2. v = Conv stmp vs2)) /\
+  (simple_basic_val_rel (Vectorv vs1) v = (?vs2. v = Vectorv vs2)) /\
+  (simple_basic_val_rel (Closure vs nm exp) v = F) /\
+  (simple_basic_val_rel (Recclosure vs exps nm) v = F)
+End
+
+Definition v_container_xs_def[simp]:
+  v_container_xs (Litv _) = [] /\
+  v_container_xs (Loc _) = [] /\
+  v_container_xs (Conv _ vs) = vs /\
+  v_container_xs (Vectorv vs) = vs /\
+  v_container_xs (Closure vs nm exp) = [] /\
+  v_container_xs (Recclosure vs exps nm) = []
+End
+
+Definition simple_val_rel_def:
+  simple_val_rel vr = ((!v1 v2. (vr v1 v2 ==> isClosure v1 = isClosure v2))
+    /\ (!v1 v2. ~ isClosure v1 ==> vr v1 v2 = (simple_basic_val_rel v1 v2
+        /\ LIST_REL vr (v_container_xs v1) (v_container_xs v2))))
+End
+
+Theorem simple_val_rel_rew = ASSUME ``simple_val_rel vr``
+    |> REWRITE_RULE [simple_val_rel_def] |> CONJUNCTS |> tl |> hd
+
+Theorem simple_val_rel_simps[simp] =
+  map (fn x => SPEC x simple_val_rel_rew) v_conss
+    |> map (SIMP_RULE bool_ss [isClosure_simps])
+    |> filter (not o same_const T o concl)
+    |> map DISCH_ALL |> LIST_CONJ
+
+Theorem simple_val_rel_isClosure:
+  simple_val_rel vr /\ vr x y ==> (isClosure x = isClosure y)
+Proof
+  metis_tac [simple_val_rel_def]
+QED
+
+Definition simple_state_rel_def:
+  simple_state_rel vr sr <=>
+    (!s t. sr s t ==> LIST_REL (sv_rel vr) s.refs t.refs) /\
+    (!s t srefs trefs. sr s t /\ LIST_REL (sv_rel vr) srefs trefs
+        ==> sr (s with refs := srefs) (t with refs := trefs)) /\
+    (!s t. sr s t ==> LIST_REL (OPTREL vr) s.globals t.globals) /\
+    (!s t sglob tglob. sr s t /\ LIST_REL (OPTREL vr) sglob tglob
+        ==> sr (s with globals := sglob) (t with globals := tglob)) /\
+    (!s t. sr s t ==> s.ffi = t.ffi) /\
+    (!s t sffi tffi. sr s t /\ sffi = tffi
+        ==> sr (s with ffi := sffi) (t with ffi := tffi))
+End
+
+Theorem simple_do_eq_thm_ind:
+  (!x1 y1 x2 y2 b. simple_val_rel vr /\
+  do_eq x1 y1 = Eq_val b /\
+  vr x1 x2 /\ vr y1 y2
+  ==>
+  do_eq x2 y2 = Eq_val b) /\
+  (!x1 y1 x2 y2 b. simple_val_rel vr /\
+  do_eq_list x1 y1 = Eq_val b /\
+  LIST_REL vr x1 x2 /\ LIST_REL vr y1 y2
+  ==>
+  do_eq_list x2 y2 = Eq_val b)
+Proof
+  ho_match_mp_tac do_eq_ind
+  \\ simp [PULL_EXISTS, do_eq_def, bool_case_eq, CaseEq "eq_result"]
+  \\ rw []
+  \\ fs [Q.ISPEC `Eq_val v` EQ_SYM_EQ]
+  \\ rfs [do_eq_def]
+  \\ imp_res_tac LIST_REL_LENGTH
+  \\ fs []
+  \\ imp_res_tac simple_val_rel_isClosure
+  \\ fs []
+  \\ fs [isClosure_def, do_eq_def]
+QED
+
+Theorem simple_do_eq_thm = simple_do_eq_thm_ind |> CONJUNCTS |> hd
+
+Theorem simple_state_rel_store_assign:
+  simple_state_rel vr sr /\
+  store_assign lnum x s.refs = SOME srefs' /\
+  sr s t /\ sv_rel vr x y ==>
+  ?trefs'. store_assign lnum y t.refs = SOME trefs' /\
+  sr (s with refs := srefs') (t with refs := trefs')
+Proof
+  rw []
+  \\ fs [simple_state_rel_def]
+  \\ fs [semanticPrimitivesTheory.store_assign_def]
+  \\ rveq \\ fs []
+  \\ last_x_assum (drule_then assume_tac)
+  \\ imp_res_tac LIST_REL_LENGTH
+  \\ simp []
+  \\ simp [EVERY2_LUPDATE_same]
+  \\ rpt (first_x_assum (drule_then kall_tac))
+  \\ fs [LIST_REL_EL_EQN]
+  \\ res_tac
+  \\ fs[semanticPrimitivesPropsTheory.sv_rel_cases] \\ fs[]
+  \\ fs [semanticPrimitivesTheory.store_v_same_type_def]
+QED
+
+Theorem simple_state_rel_store_alloc:
+  simple_state_rel vr sr /\
+  store_alloc x s.refs = (srefs', lnum) /\
+  sr s t /\ sv_rel vr x y ==>
+  ?trefs'. store_alloc y t.refs = (trefs', lnum) /\
+  sr (s with refs := srefs') (t with refs := trefs')
+Proof
+  rw []
+  \\ fs [simple_state_rel_def]
+  \\ fs [semanticPrimitivesTheory.store_alloc_def]
+  \\ rveq \\ fs []
+  \\ res_tac
+  \\ imp_res_tac LIST_REL_LENGTH
+  \\ simp []
+QED
+
+Theorem simple_state_rel_store_lookup:
+  simple_state_rel vr sr /\
+  store_lookup lnum s.refs = SOME x /\
+  sr s t ==>
+  ?y. store_lookup lnum t.refs = SOME y /\ sv_rel vr x y
+Proof
+  rw []
+  \\ fs [simple_state_rel_def]
+  \\ fs [semanticPrimitivesTheory.store_lookup_def]
+  \\ rveq \\ fs []
+  \\ last_x_assum (drule_then assume_tac)
+  \\ fs [LIST_REL_EL_EQN]
+QED
+
+Theorem simple_v_to_char_list_v_rel:
+   simple_val_rel vr ==>
+   ∀x y ls. vr x y ∧ v_to_char_list x = SOME ls ⇒ v_to_char_list y = SOME ls
+Proof
+  disch_tac
+  \\ recInduct v_to_char_list_ind
+  \\ rw[v_to_char_list_def]
+  \\ fs [option_case_eq]
+  \\ res_tac
+  \\ rw [v_to_char_list_def]
+QED
+
+Theorem simple_v_to_list_v_rel:
+   simple_val_rel vr ==>
+   ∀x y ls. vr x y ∧ v_to_list x = SOME ls ⇒
+   ∃ls'. v_to_list y = SOME ls' /\ LIST_REL vr ls ls'
+Proof
+  disch_tac
+  \\ recInduct v_to_list_ind
+  \\ rw[v_to_list_def]
+  \\ fs [option_case_eq]
+  \\ res_tac
+  \\ rw [v_to_list_def]
+QED
+
+Theorem simple_v_rel_list_to_v:
+   simple_val_rel vr ==>
+   ∀x y. LIST_REL vr x y ==> vr (list_to_v x) (list_to_v y)
+Proof
+  disch_tac
+  \\ Induct \\ rw [list_to_v_def]
+  \\ fs[PULL_EXISTS, list_to_v_def]
+QED
+
+Theorem simple_vs_to_string_v_rel:
+   simple_val_rel vr ==>
+   ∀vs ws str. LIST_REL vr vs ws ∧ vs_to_string vs = SOME str ==>
+   vs_to_string ws = SOME str
+Proof
+  disch_tac
+  \\ recInduct vs_to_string_ind
+  \\ rw [vs_to_string_def]
+  \\ fs [case_eq_thms]
+  \\ res_tac
+  \\ simp [vs_to_string_def]
+QED
+
+val sv_rel_cases = semanticPrimitivesPropsTheory.sv_rel_cases
+
+Theorem simple_do_app_thm:
+  simple_val_rel vr /\
+  simple_state_rel vr sr ==>
+  !cc s1 vs1 t1 r1 s2 vs2.
+  do_app cc s1 op vs1 = SOME (t1, r1) ==>
+  sr s1 s2 /\ LIST_REL vr vs1 vs2
+  ==>
+  ?t2 r2. result_rel vr vr r1 r2 /\
+  sr t1 t2 /\ do_app cc s2 op vs2 = SOME (t2, r2)
+Proof
+  disch_tac \\ fs []
+  \\ `?this_is_case. this_is_case op` by (qexists_tac `K T` \\ fs [])
+  \\ simp [Once do_app_def]
+  \\ simp [case_eq_thms, bool_case_eq, pair_case_eq]
+  \\ simp_tac bool_ss [PULL_EXISTS, DISJ_IMP_THM, FORALL_AND_THM]
+  \\ Cases_on `?x. op = FFI x`
+  >- (
+    fs [GSYM AND_IMP_INTRO]
+    \\ rpt (gen_tac ORELSE disch_tac)
+    \\ drule_then (drule_then drule) simple_state_rel_store_lookup
+    \\ rw []
+    \\ TRY (drule_then (drule_then drule) simple_state_rel_store_assign)
+    \\ fs [sv_rel_cases, do_app_def]
+    \\ rw []
+    \\ fs [simple_state_rel_def]
+    \\ res_tac \\ fs [Unitv_def]
+  )
+  \\ Cases_on `?n. op = El n`
+  >- (
+    fs [GSYM AND_IMP_INTRO]
+    \\ rpt (gen_tac ORELSE disch_tac)
+    \\ fs [] \\ rveq
+    \\ fs [simple_val_rel_def]
+    \\ rfs [isClosure_def] \\ rveq \\ fs [PULL_EXISTS,do_app_def]
+    \\ imp_res_tac LIST_REL_LENGTH \\ fs [LIST_REL_EL_EQN]
+    \\ fs [CaseEq"option",CaseEq"list",CaseEq"v"] \\ rveq \\ fs []
+    \\ drule_then (drule_then drule) simple_state_rel_store_lookup
+    \\ rw []
+    \\ rfs [sv_rel_cases]
+  )
+  \\ Cases_on `op = Aupdate \/ op = Aupdate_unsafe \/ op = Aalloc \/ op = ListAppend`
+  >- (
+    fs [GSYM AND_IMP_INTRO]
+    >- (
+      rpt (gen_tac ORELSE disch_tac)
+      \\ drule_then (drule_then drule) simple_state_rel_store_lookup
+      \\ fs [sv_rel_cases] \\ rw [] \\ rveq \\ fs []
+      \\ imp_res_tac LIST_REL_LENGTH
+      \\ simp [do_app_def, subscript_exn_v_def]
+      \\ qmatch_goalsub_abbrev_tac `Num (ABS i)`
+      \\ Q.ISPEC_THEN `vr` (drule_then drule) EVERY2_LUPDATE_same
+      \\ disch_then (qspec_then `Num (ABS i)` assume_tac)
+      \\ drule_then (drule_then drule) simple_state_rel_store_assign
+      \\ simp [sv_rel_cases, PULL_EXISTS]
+      \\ disch_then drule
+      \\ rw []
+      \\ simp [Unitv_def]
+    )
+    >- (
+      rpt (gen_tac ORELSE disch_tac)
+      \\ drule_then (drule_then drule) simple_state_rel_store_lookup
+      \\ fs [sv_rel_cases] \\ rw [] \\ rveq \\ fs []
+      \\ imp_res_tac LIST_REL_LENGTH
+      \\ simp [do_app_def, subscript_exn_v_def]
+      \\ qmatch_goalsub_abbrev_tac `Num (ABS i)`
+      \\ Q.ISPEC_THEN `vr` (drule_then drule) EVERY2_LUPDATE_same
+      \\ disch_then (qspec_then `Num (ABS i)` assume_tac)
+      \\ drule_then (drule_then drule) simple_state_rel_store_assign
+      \\ simp [sv_rel_cases, PULL_EXISTS]
+      \\ disch_then drule
+      \\ rw []
+      \\ simp [Unitv_def]
+    )
+    >- (
+      rpt (gen_tac ORELSE disch_tac)
+      \\ rpt (pairarg_tac \\ fs [])
+      \\ rveq \\ fs []
+      \\ simp [do_app_def, subscript_exn_v_def]
+      \\ qmatch_goalsub_abbrev_tac `Varray arr`
+      \\ drule_then (drule_then drule) simple_state_rel_store_alloc
+      \\ disch_then (qspec_then `Varray arr` mp_tac)
+      \\ unabbrev_all_tac
+      \\ simp [sv_rel_cases, PULL_EXISTS, LIST_REL_REPLICATE_same]
+    )
+    >- (
+      rw []
+      \\ imp_res_tac simple_v_to_list_v_rel
+      \\ fs []
+      \\ rveq \\ fs []
+      \\ simp [do_app_def]
+      \\ drule_then irule simple_v_rel_list_to_v
+      \\ simp [LIST_REL_APPEND_suff]
+    )
+  )
+  (* giant mallet for remaining cases - not very pretty *)
+  \\ rw []
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ imp_res_tac LIST_REL_LENGTH
+  \\ TRY (drule_then (drule_then imp_res_tac) simple_do_eq_thm)
+  \\ TRY (drule_then (drule_then imp_res_tac) simple_state_rel_store_assign)
+  \\ TRY (drule_then (drule_then imp_res_tac) simple_state_rel_store_alloc)
+  \\ TRY (drule_then (drule_then imp_res_tac) simple_state_rel_store_lookup)
+  \\ TRY (drule_then (drule_then drule) simple_v_to_list_v_rel)
+  \\ TRY (drule_then (drule_then drule) simple_v_to_char_list_v_rel)
+  \\ rw [do_app_def, div_exn_v_def, Boolv_def, subscript_exn_v_def, Unitv_def, chr_exn_v_def]
+  \\ TRY (drule_then irule simple_v_rel_list_to_v)
+  \\ TRY (fs [sv_rel_cases, PULL_EXISTS, LIST_REL_EL_EQN]
+    \\ first_x_assum drule \\ rw [])
+  \\ TRY (imp_res_tac simple_state_rel_store_lookup \\ fs [sv_rel_cases]
+    \\ NO_TAC)
+  \\ TRY (irule listTheory.EVERY2_refl)
+  \\ TRY (drule_then (drule_then drule) simple_vs_to_string_v_rel)
+  \\ TRY (qmatch_goalsub_abbrev_tac `sr (_ with globals := _) _`
+    \\ fs [simple_state_rel_def, do_app_def]
+    \\ first_x_assum irule
+    \\ res_tac
+    \\ imp_res_tac LIST_REL_LENGTH
+    \\ simp [EVERY2_LUPDATE_same, optionTheory.OPTREL_def, LIST_REL_APPEND_EQ,
+        LIST_REL_REPLICATE_same, optionTheory.OPTREL_def]
+  )
+  \\ TRY (qmatch_asmsub_abbrev_tac `i < LENGTH _.globals`
+    \\ fs [simple_state_rel_def, do_app_def, LIST_REL_EL_EQN]
+    \\ res_tac
+    \\ fs [optionTheory.OPTREL_def]
+    \\ fs [optionTheory.OPTREL_def]
+    \\ NO_TAC
+  )
+  \\ simp [MEM_MAP, PULL_EXISTS]
+QED
+
+Definition evaluate_match_def:
+  evaluate_match env s v pes err_v =
+    case pmatch_rows pes s v of
+    | Match_type_error => (s, Rerr (Rabort Rtype_error))
+    | No_match => (s, Rerr (Rraise err_v))
+    | Match (env', p', e') =>
+        if ALL_DISTINCT (pat_bindings p' [])
+        then evaluate (env with v := env' ++ env.v) s [e']
+        else (s, Rerr (Rabort Rtype_error))
+End
+
+Theorem evaluate_Mat:
+  evaluate env s [Mat tra e pes] =
+  case evaluate env s [e] of
+  | (s, Rval v) =>
+      if pmatch_rows pes s (HD v) <> Match_type_error
+      then evaluate_match env s (HD v) pes bind_exn_v
+      else (s,Rerr (Rabort Rtype_error))
+  | res => res
+Proof
+  fs [evaluate_def,evaluate_match_def]
+  \\ every_case_tac \\ fs []
+QED
+
+Theorem evaluate_Handle:
+  evaluate env s [Handle _ e pes] =
+  case evaluate env s [e] of
+  | (s, Rerr (Rraise v)) =>
+      if pmatch_rows pes s v <> Match_type_error
+      then evaluate_match env s v pes v
+      else (s,Rerr (Rabort Rtype_error))
+  | res => res
+Proof
+  fs [evaluate_def,evaluate_match_def]
+  \\ every_case_tac \\ fs []
+QED
+
+Theorem evaluate_match_NIL:
+  evaluate_match (env:flatSem$environment) s v [] err_v =
+    (s, Rerr(Rraise err_v))
+Proof
+  fs [evaluate_match_def,pmatch_rows_def]
+QED
+
+Theorem evaluate_match_CONS:
+  evaluate_match env s v ((p,e)::pes) err_v =
+    case pmatch s p v [] of
+    | No_match => evaluate_match env s v pes err_v
+    | Match_type_error => (s, Rerr(Rabort Rtype_error))
+    | Match env_v' =>
+        if ALL_DISTINCT (pat_bindings p []) /\
+           pmatch_rows pes s v <> Match_type_error
+        then evaluate (env with v := env_v' ++ env.v) s [e]
+        else (s, Rerr(Rabort Rtype_error))
+Proof
+  fs [evaluate_match_def,pmatch_rows_def]
+  \\ Cases_on `pmatch s p v [] = Match_type_error` \\ fs []
+  \\ Cases_on `pmatch_rows pes s v = Match_type_error` \\ fs []
+  THEN1 (CASE_TAC \\ fs [])
+  \\ rpt (CASE_TAC \\ fs [])
+QED
+
+local
+  val tm1 = ``flatLang$Mat``
+  val tm2 = ``flatLang$Handle``
+in
+  val flat_evaluate_def =
+    flatSemTheory.evaluate_def
+    |> CONJUNCTS
+    |> filter (fn th => not (can (find_term (aconv tm1)) (concl th)) andalso
+                        not (can (find_term (aconv tm2)) (concl th)))
+    |> (fn thms => thms @ [GEN_ALL evaluate_Handle])
+    |> (fn thms => thms @ [GEN_ALL evaluate_Mat])
+    |> (fn thms => thms @ [GEN_ALL evaluate_match_NIL])
+    |> (fn thms => thms @ [GEN_ALL evaluate_match_CONS])
+    |> LIST_CONJ
+end
+
+Theorem flat_evaluate_def = flat_evaluate_def
+
+Definition store_v_vs_def[simp]:
+  store_v_vs (Varray vs) = vs /\
+  store_v_vs (Refv v) = [v] /\
+  store_v_vs (W8array xs) = []
+End
+
+Definition result_vs_def[simp]:
+  result_vs (Rval xs) = xs /\
+  result_vs (Rerr (Rraise x)) = [x] /\
+  result_vs (Rerr (Rabort y)) = []
+End
+
+Theorem v1_size:
+  v1_size xs = LENGTH xs + SUM (MAP v2_size xs)
+Proof
+  Induct_on `xs` \\ simp [v_size_def]
+QED
+
+Theorem v3_size:
+  v3_size xs = LENGTH xs + SUM (MAP v_size xs)
+Proof
+  Induct_on `xs` \\ simp [v_size_def]
+QED
+
+Definition no_Mat_def[simp]:
+  (no_Mat (flatLang$Raise t e) <=> no_Mat e) /\
+  (no_Mat (Lit t l) <=> T) /\
+  (no_Mat (Var_local t v) <=> T) /\
+  (no_Mat (Con t n es) <=> EVERY no_Mat es) /\
+  (no_Mat (App t op es) <=> EVERY no_Mat es) /\
+  (no_Mat (Fun t v e) <=> no_Mat e) /\
+  (no_Mat (If t x1 x2 x3) <=> no_Mat x1 /\ no_Mat x2 /\ no_Mat x3) /\
+  (no_Mat (Let t vo e1 e2) <=> no_Mat e1 /\ no_Mat e2) /\
+  (no_Mat (Mat t e pes) <=> F) /\
+  (no_Mat (Handle t e pes) <=> no_Mat e /\ EVERY no_Mat (MAP SND pes) /\
+    (case pes of [(Pvar _, _)] => T | _ => F)) /\
+  (no_Mat (Letrec t funs e) <=> EVERY no_Mat (MAP (SND o SND) funs) /\ no_Mat e)
+Termination
+  WF_REL_TAC `measure (flatLang$exp_size)` \\ rw []
+  \\ fs [MEM_MAP, EXISTS_PROD]
+  \\ fs [MEM_SPLIT, exp1_size, exp3_size, SUM_APPEND, exp_size_def]
+End
+
+Definition no_Mat_decs_def[simp]:
+  no_Mat_decs [] = T /\
+  no_Mat_decs ((Dlet e)::xs) = (no_Mat e /\ no_Mat_decs xs) /\
+  no_Mat_decs (_::xs) = no_Mat_decs xs
+End
+
 val _ = export_theory()
diff --git a/compiler/backend/semantics/flatSemScript.sml b/compiler/backend/semantics/flatSemScript.sml
index fc8772eef7..a844c388ef 100644
--- a/compiler/backend/semantics/flatSemScript.sml
+++ b/compiler/backend/semantics/flatSemScript.sml
@@ -44,8 +44,6 @@ val _ = Datatype`
     globals : (v option) list;
     (* The set of constructors that exist, according to their id, type and arity *)
     c : ((ctor_id # type_id) # num) set;
-    (* T if all patterns are required to be exhaustive *)
-    exh_pat : bool;
     (* T if constructors must be declared *)
     check_ctor : bool
   |>`;
@@ -226,10 +224,6 @@ val do_app_def = Define `
   | (Opref, [v]) =>
     let (s',n) = (store_alloc (Refv v) s.refs) in
       SOME (s with refs := s', Rval (Loc n))
-  | (Opderef, [Loc n]) =>
-    (case store_lookup n s.refs of
-     | SOME (Refv v) => SOME (s,Rval v)
-     | _ => NONE)
   | (Aw8alloc, [Litv (IntLit n); Litv (Word8 w)]) =>
     if n < 0 then
       SOME (s, Rerr (Rraise subscript_exn_v))
@@ -481,6 +475,17 @@ val do_app_def = Define `
       SOME (s, Rval (THE (EL n s.globals)))
     else
       NONE
+  | (TagLenEq n l, [Conv (SOME (tag,_)) xs]) =>
+    SOME (s, Rval (Boolv (tag = n /\ LENGTH xs = l)))
+  | (LenEq l, [Conv _ xs]) =>
+    SOME (s, Rval (Boolv (LENGTH xs = l)))
+ | (El n, [Conv _ vs]) =>
+    (if n < LENGTH vs then SOME (s, Rval (EL n vs)) else NONE)
+  | (El n, [Loc p]) =>
+    (if n <> 0 then NONE else
+       case store_lookup p s.refs of
+       | SOME (Refv v) => SOME (s,Rval v)
+       | _ => NONE)
   | _ => NONE`;
 
 val do_if_def = Define `
@@ -501,15 +506,6 @@ Proof
     Cases_on `v = Boolv F` THEN simp []])
 QED
 
-val pat_bindings_def = Define `
-  (pat_bindings Pany already_bound = already_bound) ∧
-  (pat_bindings (Pvar n) already_bound = n::already_bound) ∧
-  (pat_bindings (Plit l) already_bound = already_bound) ∧
-  (pat_bindings (Pcon _ ps) already_bound = pats_bindings ps already_bound) ∧
-  (pat_bindings (Pref p) already_bound = pat_bindings p already_bound) ∧
-  (pats_bindings [] already_bound = already_bound) ∧
-  (pats_bindings (p::ps) already_bound = pats_bindings ps (pat_bindings p already_bound))`;
-
 val same_ctor_def = Define `
   same_ctor check_type n1 n2 ⇔
     if check_type then
@@ -517,6 +513,15 @@ val same_ctor_def = Define `
     else
       FST n1 = FST n2`;
 
+Definition pmatch_stamps_ok_def:
+  pmatch_stamps_ok c chk_c (SOME n) (SOME n') ps vs =
+    (chk_c ==> (n, LENGTH ps) ∈ c ∧ ctor_same_type (SOME n) (SOME n'))
+  ∧
+  pmatch_stamps_ok _ chk_c NONE NONE ps vs = (chk_c ∧ LENGTH ps = LENGTH vs)
+  ∧
+  pmatch_stamps_ok _ _ _ _ ps vs = F
+End
+
 val pmatch_def = tDefine "pmatch" `
   (pmatch s (Pvar x) v' bindings = (Match ((x,v') :: bindings))) ∧
   (pmatch s flatLang$Pany v' bindings = Match bindings) ∧
@@ -527,19 +532,14 @@ val pmatch_def = tDefine "pmatch" `
       No_match
     else
       Match_type_error) ∧
-  (pmatch s (Pcon (SOME n) ps) (Conv (SOME n') vs) bindings =
-    if s.check_ctor ∧
-       ((n, LENGTH ps) ∉ s.c ∨ ~ctor_same_type (SOME n) (SOME n')) then
+  (pmatch s (Pcon stmp ps) (Conv stmp' vs) bindings =
+    if ~ pmatch_stamps_ok s.c s.check_ctor stmp stmp' ps vs then
       Match_type_error
-    else if same_ctor s.check_ctor n n' ∧ LENGTH ps = LENGTH vs then
+    else if OPTION_MAP FST stmp = OPTION_MAP FST stmp' ∧
+            LENGTH ps = LENGTH vs then
       pmatch_list s ps vs bindings
     else
       No_match) ∧
-  (pmatch s (Pcon NONE ps) (Conv NONE vs) bindings =
-    if s.check_ctor ∧ LENGTH ps = LENGTH vs then
-      pmatch_list s ps vs bindings
-    else
-      Match_type_error) ∧
   (pmatch s (Pref p) (Loc lnum) bindings =
     case store_lookup lnum s.refs of
     | SOME (Refv v) => pmatch s p v bindings
@@ -548,16 +548,31 @@ val pmatch_def = tDefine "pmatch" `
   (pmatch_list s [] [] bindings = Match bindings) ∧
   (pmatch_list s (p::ps) (v::vs) bindings =
     case pmatch s p v bindings of
-    | No_match => No_match
     | Match_type_error => Match_type_error
-    | Match bindings' => pmatch_list s ps vs bindings') ∧
+    | Match bindings' => pmatch_list s ps vs bindings'
+    | No_match =>
+      case pmatch_list s ps vs bindings of
+      | Match_type_error => Match_type_error
+      | _ => No_match) ∧
   (pmatch_list s _ _ bindings = Match_type_error)`
  (WF_REL_TAC `inv_image $< (\x. case x of INL (x,p,y,z) => pat_size p
                                         | INR (x,ps,y,z) => pat1_size ps)` >>
   srw_tac [ARITH_ss] [terminationTheory.size_abbrevs, astTheory.pat_size_def]);
 
+Definition pmatch_rows_def:
+  pmatch_rows [] s v = No_match /\
+  pmatch_rows ((p,e)::pes) s v =
+    case pmatch s p v [] of
+    | Match_type_error => Match_type_error
+    | No_match => pmatch_rows pes s v
+    | Match env =>
+       case pmatch_rows pes s v of
+       | Match_type_error => Match_type_error
+       | _ => Match (env, p, e)
+End
+
 val dec_clock_def = Define`
-dec_clock s = s with clock := s.clock -1`;
+  dec_clock s = s with clock := s.clock -1`;
 
 val fix_clock_def = Define `
   fix_clock s (s1,res) = (s1 with clock := MIN s.clock s1.clock,res)`;
@@ -566,7 +581,16 @@ val fix_clock_IMP = Q.prove(
   `fix_clock s x = (s1,res) ==> s1.clock <= s.clock`,
   Cases_on `x` \\ fs [fix_clock_def] \\ rw [] \\ fs []);
 
-val evaluate_def = tDefine "evaluate"`
+Theorem pmatch_rows_Match_exp_size:
+  !pes s v env e.
+    pmatch_rows pes s v = Match (env,p,e) ==>
+    exp_size e < exp3_size pes
+Proof
+  Induct \\ fs [pmatch_rows_def,FORALL_PROD,CaseEq"match_result",CaseEq"bool"]
+  \\ rw [] \\ res_tac \\ fs [exp_size_def]
+QED
+
+Definition evaluate_def:
   (evaluate (env:flatSem$environment) (s:'ffi flatSem$state) ([]:flatLang$exp list) = (s,Rval [])) ∧
   (evaluate env s (e1::e2::es) =
     case fix_clock s (evaluate env s [e1]) of
@@ -582,7 +606,14 @@ val evaluate_def = tDefine "evaluate"`
    | res => res) ∧
   (evaluate env s [Handle _ e pes] =
    case fix_clock s (evaluate env s [e]) of
-   | (s, Rerr (Rraise v)) => evaluate_match env s v pes v
+   | (s, Rerr (Rraise v)) =>
+       (case pmatch_rows pes s v of
+        | Match_type_error => (s, Rerr (Rabort Rtype_error))
+        | No_match => (s, Rerr (Rraise v))
+        | Match (env', p', e') =>
+           if ALL_DISTINCT (pat_bindings p' [])
+           then evaluate (env with v := env' ++ env.v) s [e']
+           else (s, Rerr (Rabort Rtype_error)))
    | res => res) ∧
   (evaluate env s [Con _ NONE es] =
     if s.check_ctor then
@@ -629,7 +660,13 @@ val evaluate_def = tDefine "evaluate"`
   (evaluate env s [Mat _ e pes] =
    case fix_clock s (evaluate env s [e]) of
    | (s, Rval v) =>
-       evaluate_match env s (HD v) pes bind_exn_v
+       (case pmatch_rows pes s (HD v) of
+        | Match_type_error => (s, Rerr (Rabort Rtype_error))
+        | No_match => (s, Rerr (Rraise bind_exn_v))
+        | Match (env', p', e') =>
+           if ALL_DISTINCT (pat_bindings p' [])
+           then evaluate (env with v := env' ++ env.v) s [e']
+           else (s, Rerr (Rabort Rtype_error)))
    | res => res) ∧
   (evaluate env s [Let _ n e1 e2] =
    case fix_clock s (evaluate env s [e1]) of
@@ -638,29 +675,17 @@ val evaluate_def = tDefine "evaluate"`
   (evaluate env s [Letrec _ funs e] =
    if ALL_DISTINCT (MAP FST funs)
    then evaluate (env with v := build_rec_env funs env.v env.v) s [e]
-   else (s, Rerr (Rabort Rtype_error))) ∧
-  (evaluate_match (env:flatSem$environment) s v [] err_v =
-    if s.exh_pat then
-      (s, Rerr(Rabort Rtype_error))
-    else
-      (s, Rerr(Rraise err_v))) ∧
-  (evaluate_match env s v ((p,e)::pes) err_v =
-   if ALL_DISTINCT (pat_bindings p []) then
-     case pmatch s p v [] of
-     | Match env_v' => evaluate (env with v := env_v' ++ env.v) s [e]
-     | No_match => evaluate_match env s v pes err_v
-     | _ => (s, Rerr(Rabort Rtype_error))
-   else (s, Rerr(Rabort Rtype_error)))`
-  (wf_rel_tac`inv_image ($< LEX $<)
-                (λx. case x of (INL(_,s,es)) => (s.clock,exp6_size es)
-                             | (INR(_,s,_,pes,_)) => (s.clock,exp3_size pes))`
-  >> rpt strip_tac
-  >> simp[dec_clock_def]
-  >> imp_res_tac fix_clock_IMP
-  >> imp_res_tac do_if_either_or
-  >> rw[]);
-
-val evaluate_ind = theorem"evaluate_ind";
+   else (s, Rerr (Rabort Rtype_error)))
+Termination
+  wf_rel_tac`inv_image ($< LEX $<)
+                (λx. case x of (_,s,es) => (s.clock,exp6_size es))`
+  \\ rpt strip_tac
+  \\ simp[dec_clock_def]
+  \\ imp_res_tac fix_clock_IMP
+  \\ imp_res_tac do_if_either_or
+  \\ imp_res_tac pmatch_rows_Match_exp_size
+  \\ rw[]
+End
 
 val op_thms = { nchotomy = op_nchotomy, case_def = op_case_def};
 val list_thms = { nchotomy = list_nchotomy, case_def = list_case_def};
@@ -706,8 +731,7 @@ Proof
 QED
 
 Theorem evaluate_clock:
-   (∀env (s1:'a state) e r s2. evaluate env s1 e = (s2,r) ⇒ s2.clock ≤ s1.clock) ∧
-   (∀env (s1:'a state) v pes v_err r s2. evaluate_match env s1 v pes v_err = (s2,r) ⇒ s2.clock ≤ s1.clock)
+   (∀env (s1:'a state) e r s2. evaluate env s1 e = (s2,r) ⇒ s2.clock ≤ s1.clock)
 Proof
   ho_match_mp_tac evaluate_ind >> rw[evaluate_def] >>
   every_case_tac >> fs[dec_clock_def] >> rw[] >> rfs[] >>
@@ -795,24 +819,23 @@ val initial_ctors_def = Define `
    initial_ctors = bool_ctors UNION list_ctors UNION exn_ctors`;
 
 val initial_state_def = Define `
-  initial_state ffi k exh_pat check_ctor =
+  initial_state ffi k check_ctor =
     <| clock   := k
      ; refs    := []
      ; ffi     := ffi
      ; globals := []
      ; c       := initial_ctors
-     ; exh_pat := exh_pat
      ; check_ctor := check_ctor |>`;
 
 val semantics_def = Define`
-  semantics exh_pat check_ctor ffi prog =
-    if ∃k. SND (evaluate_decs (initial_state ffi k exh_pat check_ctor) prog) =
+  semantics check_ctor ffi prog =
+    if ∃k. SND (evaluate_decs (initial_state ffi k check_ctor) prog) =
            SOME (Rabort Rtype_error)
       then Fail
     else
     case some res.
       ∃k s r outcome.
-        evaluate_decs (initial_state ffi k exh_pat check_ctor) prog = (s,r) ∧
+        evaluate_decs (initial_state ffi k check_ctor) prog = (s,r) ∧
         (case r of
          | SOME (Rabort (Rffi_error e)) => outcome = FFI_outcome e
          | SOME (Rabort _) => F
@@ -824,11 +847,10 @@ val semantics_def = Define`
          (build_lprefix_lub
            (IMAGE (λk. fromList
              (FST (evaluate_decs
-               (initial_state ffi k exh_pat check_ctor) prog)).ffi.io_events) UNIV))`;
+               (initial_state ffi k check_ctor) prog)).ffi.io_events) UNIV))`;
 
 val _ = map delete_const
   ["do_eq_UNION_aux","do_eq_UNION",
-   "pmatch_UNION_aux","pmatch_UNION",
-   "evaluate_UNION_aux","evaluate_UNION"];
+   "pmatch_UNION_aux","pmatch_UNION"];
 
 val _ = export_theory();
diff --git a/compiler/backend/semantics/patPropsScript.sml b/compiler/backend/semantics/patPropsScript.sml
deleted file mode 100644
index c0cde7d924..0000000000
--- a/compiler/backend/semantics/patPropsScript.sml
+++ /dev/null
@@ -1,382 +0,0 @@
-(*
-  Properties about patLang and its semantics
-*)
-open preamble patSemTheory
-
-val _ = new_theory"patProps"
-
-val evaluate_lit = save_thm("evaluate_lit[simp]",
-      EVAL``patSem$evaluate env s [Lit tra l]``)
-
-Theorem Boolv_11[simp]:
-  patSem$Boolv b1 = Boolv b2 ⇔ b1 = b2
-Proof
-EVAL_TAC>>srw_tac[][]
-QED
-
-val Boolv_disjoint = save_thm("Boolv_disjoint",EVAL``patSem$Boolv T = Boolv F``);
-
-val evaluate_Con_nil =
-  ``evaluate env s [Con tra x []]``
-  |> EVAL
-  |> curry save_thm"evaluate_Con_nil";
-
-val no_closures_def = tDefine"no_closures"`
-  (no_closures (Litv _) ⇔ T) ∧
-  (no_closures (Conv _ vs) ⇔ EVERY no_closures vs) ∧
-  (no_closures (Closure _ _) = F) ∧
-  (no_closures (Recclosure _ _ _) = F) ∧
-  (no_closures (Loc _) = T) ∧
-  (no_closures (Vectorv vs) ⇔ EVERY no_closures vs)`
-(WF_REL_TAC`measure v_size`>>CONJ_TAC >|[all_tac,gen_tac]>>Induct>>
- simp[v_size_def]>>srw_tac[][]>>res_tac>>simp[])
-val _ = export_rewrites["no_closures_def"];
-
-Theorem no_closures_Boolv[simp]:
-   no_closures (Boolv b)
-Proof
-  EVAL_TAC
-QED
-
-Theorem evaluate_raise_rval:
-   ∀env s e s' v. patSem$evaluate env s [Raise tra e] ≠ (s', Rval v)
-Proof
-  EVAL_TAC >> srw_tac[][] >> every_case_tac >> simp[]
-QED
-val _ = export_rewrites["evaluate_raise_rval"]
-
-Theorem evaluate_length:
-   ∀env s ls s' vs.
-      evaluate env s ls = (s',Rval vs) ⇒ LENGTH vs = LENGTH ls
-Proof
-  ho_match_mp_tac evaluate_ind >> rw[evaluate_def]
-  \\ fs[case_eq_thms,pair_case_eq,bool_case_eq] \\ rw[] \\ fs[]
-  \\ TRY(qpat_x_assum`(_,_) = _`(assume_tac o SYM)) \\ fs[]
-  \\ rename1`list_result lr`
-  \\ Cases_on`lr` \\ fs[] \\ rw[]
-QED
-
-Theorem evaluate_cons:
-   evaluate env s (e::es) =
-   (case evaluate env s [e] of
-    | (s,Rval v) =>
-      (case evaluate env s es of
-       | (s,Rval vs) => (s,Rval (v++vs))
-       | r => r)
-    | r => r)
-Proof
-  Cases_on`es`>>srw_tac[][evaluate_def] >>
-  every_case_tac >> full_simp_tac(srw_ss())[evaluate_def] >>
-  imp_res_tac evaluate_length >> full_simp_tac(srw_ss())[SING_HD]
-QED
-
-Theorem evaluate_sing:
-   evaluate env s [e] = (s',Rval vs) ⇒ ∃y. vs = [y]
-Proof
-  srw_tac[][] >> imp_res_tac evaluate_length >> full_simp_tac(srw_ss())[] >> metis_tac[SING_HD]
-QED
-
-Theorem evaluate_append_Rval:
-   ∀l1 env s l2 s' vs.
-    evaluate env s (l1 ++ l2) = (s',Rval vs) ⇒
-    ∃s1 v1 v2. evaluate env s l1 = (s1,Rval v1) ∧
-               evaluate env s1 l2 = (s',Rval v2) ∧
-               vs = v1++v2
-Proof
-  Induct >> simp[evaluate_def,Once evaluate_cons] >>
-  srw_tac[][] >> simp[Once evaluate_cons] >>
-  every_case_tac >> full_simp_tac(srw_ss())[] >> srw_tac[][] >> res_tac >>
-  srw_tac[][] >> full_simp_tac(srw_ss())[] >> srw_tac[][]
-QED
-
-Theorem evaluate_append_Rval_iff:
-   ∀l1 env s l2 s' vs.
-    evaluate env s (l1 ++ l2) = (s',Rval vs) ⇔
-    ∃s1 v1 v2. evaluate env s l1 = (s1,Rval v1) ∧
-               evaluate env s1 l2 = (s',Rval v2) ∧
-               vs = v1++v2
-Proof
-  srw_tac[][] >> EQ_TAC >- MATCH_ACCEPT_TAC evaluate_append_Rval >>
-  map_every qid_spec_tac[`vs`,`s`] >>
-  Induct_on`l1`>>srw_tac[][evaluate_def,Once evaluate_cons] >> srw_tac[][] >>
-  srw_tac[][Once evaluate_cons] >>
-  every_case_tac >> full_simp_tac(srw_ss())[] >> srw_tac[][] >>
-  full_simp_tac(srw_ss())[PULL_EXISTS] >>
-  res_tac >> full_simp_tac(srw_ss())[]
-QED
-
-Theorem evaluate_append_Rerr:
-   ∀l1 env s l2 s' e.
-    evaluate env s (l1 ++ l2) = (s',Rerr e) ⇔
-    (evaluate env s l1 = (s', Rerr e) ∨
-       ∃s1 v1.
-         evaluate env s l1 = (s1, Rval v1) ∧
-         evaluate env s1 l2 = (s', Rerr e))
-Proof
-  Induct >> srw_tac[][evaluate_def] >>
-  srw_tac[][Once evaluate_cons] >> MATCH_MP_TAC EQ_SYM >>
-  srw_tac[][Once evaluate_cons] >> MATCH_MP_TAC EQ_SYM >>
-  every_case_tac >> simp[] >>
-  srw_tac[][Once evaluate_cons] >>
-  TRY EQ_TAC >>
-  spose_not_then strip_assume_tac >> srw_tac[][] >> full_simp_tac(srw_ss())[] >>
-  full_simp_tac(srw_ss())[evaluate_append_Rval_iff] >>
-  first_x_assum(qspecl_then[`env`,`q`,`l2`]mp_tac) >>
-  simp[] >> metis_tac[]
-QED
-
-Theorem evaluate_append:
-   evaluate env s (l1 ++ l2) =
-   case evaluate env s l1 of
-   | (s,Rval v1) =>
-     (case evaluate env s l2 of
-      | (s,Rval v2) => (s,Rval(v1++v2))
-      | r => r)
-   | r => r
-Proof
-  map_every qid_spec_tac[`l2`,`s`] >> Induct_on`l1` >>
-  srw_tac[][evaluate_def] >- (
-    every_case_tac >> full_simp_tac(srw_ss())[] ) >>
-  srw_tac[][Once evaluate_cons] >>
-  match_mp_tac EQ_SYM >>
-  srw_tac[][Once evaluate_cons] >>
-  BasicProvers.CASE_TAC >> full_simp_tac(srw_ss())[] >>
-  Cases_on`r`>>full_simp_tac(srw_ss())[] >>
-  every_case_tac  >> full_simp_tac(srw_ss())[]
-QED
-
-Theorem dec_clock_with_clock[simp]:
-   dec_clock s with clock := y = s with clock := y
-Proof
-  EVAL_TAC
-QED
-
-Theorem do_app_add_to_clock:
-   (do_app (s with clock := s.clock + extra) op vs =
-    OPTION_MAP (λ(s',r). (s' with clock := s'.clock + extra,r)) (do_app s op vs))
-Proof
-  Cases_on`do_app s op vs`
-  \\ ((pop_assum(strip_assume_tac o CONV_RULE(REWR_CONV do_app_cases_none)))
-     ORELSE(pop_assum(strip_assume_tac o CONV_RULE(REWR_CONV do_app_cases))))
-  \\ rw[do_app_def] >>
-  fs[semanticPrimitivesTheory.store_alloc_def,
-     semanticPrimitivesTheory.store_lookup_def,
-     semanticPrimitivesTheory.store_assign_def]
-  >> srw_tac[][]
-  >> every_case_tac \\ fs[] \\ rw[] \\ rfs[]
-QED
-
-Theorem do_app_const:
-   do_app s op vs = SOME (s',r) ⇒ s'.compile = s.compile
-Proof
-  rw[do_app_def,case_eq_thms,bool_case_eq,UNCURRY,pair_case_eq] \\ rw[]
-QED
-
-Theorem do_install_with_clock:
-   do_install vs (s with clock := k) =
-   OPTION_MAP (λ(e,s'). (e, s' with clock := k)) (do_install vs s)
-Proof
-  rw[do_install_def] \\ rpt(PURE_TOP_CASE_TAC \\ fs[UNCURRY])
-QED
-
-Theorem do_install_const:
-   do_install vs s = SOME (e,s') ⇒ s'.ffi = s.ffi ∧ s'.clock = s.clock ∧ s'.compile = s.compile
-Proof
-  rw[do_install_def,case_eq_thms,UNCURRY,pair_case_eq] \\ rw[]
-QED
-
-Theorem evaluate_add_to_clock:
-   ∀env s es s' r.
-      evaluate env s es = (s',r) ∧
-      r ≠ Rerr (Rabort Rtimeout_error) ⇒
-      evaluate env (s with clock := s.clock + extra) es =
-        (s' with clock := s'.clock + extra,r)
-Proof
-  ho_match_mp_tac evaluate_ind >>
-  srw_tac[][evaluate_def,case_eq_thms,pair_case_eq] >>
-  full_simp_tac(srw_ss())[do_app_add_to_clock,do_install_with_clock,case_eq_thms,pair_case_eq,bool_case_eq] >>
-  srw_tac[][] >> rev_full_simp_tac(srw_ss())[] >>
-  rev_full_simp_tac(srw_ss()++ARITH_ss)[dec_clock_def] >>
-  imp_res_tac do_install_const >> fs [] \\ rfs[]
-QED
-
-val do_app_io_events_mono = Q.prove(
-  `do_app s op vs = SOME(s',r) ⇒
-   s.ffi.io_events ≼ s'.ffi.io_events`,
-  srw_tac[][] >> full_simp_tac(srw_ss())[do_app_cases] >>
-  every_case_tac >>
-  full_simp_tac(srw_ss())[LET_THM,
-     semanticPrimitivesTheory.store_alloc_def,
-     semanticPrimitivesTheory.store_lookup_def,
-     semanticPrimitivesTheory.store_assign_def] >> srw_tac[][] >>
-  every_case_tac >> full_simp_tac(srw_ss())[] >> srw_tac[][] >>
-  full_simp_tac(srw_ss())[ffiTheory.call_FFI_def,IS_SOME_EXISTS] >>
-  every_case_tac >> full_simp_tac(srw_ss())[] >> srw_tac[][]);
-
-Theorem evaluate_io_events_mono:
-   ∀env s es. s.ffi.io_events ≼ (FST (evaluate env s es)).ffi.io_events
-Proof
-  ho_match_mp_tac evaluate_ind >> srw_tac[][evaluate_def] >>
-  every_case_tac >> full_simp_tac(srw_ss())[] >> rev_full_simp_tac(srw_ss())[] >> full_simp_tac(srw_ss())[dec_clock_def] >>
-  metis_tac[IS_PREFIX_TRANS,do_app_io_events_mono,do_install_const]
-QED
-
-val evaluate_io_events_mono_imp = Q.prove(
-  `evaluate env s es = (s',r) ⇒
-    s.ffi.io_events ≼ s'.ffi.io_events`,
-  metis_tac[evaluate_io_events_mono,FST])
-
-val with_clock_ffi = Q.prove(
-  `(s with clock := k).ffi = s.ffi`,EVAL_TAC)
-val lemma = DECIDE``x ≠ 0n ⇒ x - 1 + y = x + y - 1``
-
-Theorem evaluate_add_to_clock_io_events_mono:
-   ∀env s es.
-    (FST(evaluate env s es)).ffi.io_events ≼
-    (FST(evaluate env (s with clock := s.clock + extra) es)).ffi.io_events
-Proof
-  ho_match_mp_tac evaluate_ind >> srw_tac[][evaluate_def] >>
-  every_case_tac >> fsrw_tac[][] >>
-  imp_res_tac evaluate_add_to_clock >> rev_full_simp_tac(srw_ss())[] >> fsrw_tac[][] >> srw_tac[][] >>
-  imp_res_tac evaluate_io_events_mono_imp >> fsrw_tac[][] >> srw_tac[][] >>
-  fsrw_tac[][dec_clock_def] >> fsrw_tac[][do_app_add_to_clock,do_install_with_clock] >>
-  TRY(first_assum(split_uncurry_arg_tac o rhs o concl) >> fsrw_tac[][]) >>
-  imp_res_tac do_app_io_events_mono >>
-  imp_res_tac do_install_const >> fsrw_tac[][] >>
-  rveq >> fsrw_tac[][do_install_with_clock] >>
-  rpt(first_x_assum(qspec_then`extra`mp_tac) \\ srw_tac[][]) >> rev_full_simp_tac(srw_ss())[] >>
-  TRY(rfs[] \\ fs[] \\ NO_TAC) \\
-  metis_tac[evaluate_io_events_mono,with_clock_ffi,FST,IS_PREFIX_TRANS,lemma]
-QED
-
-Theorem evaluate_const:
-   ∀env s xs res s'.
-    evaluate env s xs = (s',res) ⇒ s'.compile = s.compile
-Proof
-  ho_match_mp_tac evaluate_ind
-  \\ rw[evaluate_def,case_eq_thms,pair_case_eq,bool_case_eq]
-  \\ fs[] \\ rfs[patSemTheory.dec_clock_def]
-  \\ imp_res_tac do_install_const \\ fs[]
-  \\ imp_res_tac do_app_const \\ fs[]
-  \\ metis_tac[]
-QED
-
-(*
-Theorem not_evaluate_list_append:
-   ∀l1 ck env s l2 res.
-    (∀res. ¬evaluate_list ck env s (l1 ++ l2) res) ⇔
-    ((∀res. ¬evaluate_list ck env s l1 res) ∨
-       ∃s1 v1.
-         evaluate_list ck env s l1 (s1, Rval v1) ∧
-         (∀res. ¬evaluate_list ck env s1 l2 res))
-Proof
-  Induct >- (
-    srw_tac[][EQ_IMP_THM] >- (
-      full_simp_tac(srw_ss())[Once(CONJUNCT2(evaluate_cases))] >>
-      simp[Once(CONJUNCT2(evaluate_cases))] >>
-      simp[Once(CONJUNCT2(evaluate_cases))] >>
-      srw_tac[][] >> metis_tac[] )
-    >- (
-      full_simp_tac(srw_ss())[Once(CONJUNCT2(evaluate_cases))] ) >>
-    full_simp_tac(srw_ss())[Once(Q.SPECL[`ck`,`env`,`s`,`[]`](CONJUNCT2(evaluate_cases)))] >>
-    srw_tac[][] ) >>
-  full_simp_tac(srw_ss())[Q.SPECL[`ck`,`env`,`s`,`X::Y`](CONJUNCT2(evaluate_cases))] >>
-  srw_tac[][PULL_EXISTS] >>
-  reverse(Cases_on`∃res. evaluate ck env s h res`) >- (
-    metis_tac[] ) >>
-  full_simp_tac(srw_ss())[] >>
-  `∃s1 r1. res = (s1,r1)` by metis_tac[PAIR] >>
-  reverse (Cases_on`r1`) >- (
-    srw_tac[boolSimps.DNF_ss][] >>
-    EQ_TAC >> strip_tac >>
-    metis_tac[evaluate_determ,semanticPrimitivesTheory.result_distinct,PAIR_EQ]) >>
-  srw_tac[boolSimps.DNF_ss][] >>
-  first_x_assum(qspecl_then[`ck`,`env`,`s1`,`l2`]strip_assume_tac) >>
-  Cases_on`∀res. ¬evaluate_list ck env s1 (l1++l2) res` >- (
-    full_simp_tac(srw_ss())[] >>
-    metis_tac[evaluate_determ,PAIR_EQ,
-              semanticPrimitivesTheory.result_11,
-              semanticPrimitivesTheory.result_distinct] ) >>
-  FULL_SIMP_TAC pure_ss [] >> full_simp_tac(srw_ss())[] >>
-  `∃s2 r2. res = (s2,r2)` by metis_tac[PAIR] >>
-  Cases_on`r2` >>
-  metis_tac[evaluate_determ,PAIR_EQ,pair_CASES,
-            semanticPrimitivesTheory.result_11,
-            semanticPrimitivesTheory.result_nchotomy,
-            semanticPrimitivesTheory.result_distinct]
-QED
-*)
-
-open bagTheory
-
-(* finding the InitGlobal operations *)
-val op_gbag_def = Define`
-  op_gbag (Op (GlobalVarInit n)) = BAG_INSERT n {||} ∧
-  op_gbag _ = {||}
-`;
-
-(* Same naming scheme as clos *)
-val set_globals_def = tDefine "set_globals"`
-  (set_globals (Raise _ e) = set_globals e) ∧
-  (set_globals (Handle _ e1 e2) = set_globals e1 ⊎ set_globals e2) ∧
-  (set_globals (Con _ _ es) = elist_globals es) ∧
-  (set_globals (Fun _ e) = set_globals e) ∧
-  (set_globals (App _ op es) = op_gbag op ⊎ elist_globals es) ∧
-  (set_globals (If _ e1 e2 e3) = set_globals e1 ⊎ set_globals e2 ⊎ set_globals e3) ∧
-  (set_globals (Let _ e1 e2) = set_globals e1 ⊎ set_globals e2) ∧
-  (set_globals (Seq _ e1 e2) = set_globals e1 ⊎ set_globals e2) ∧
-  (set_globals (Letrec _ es e) =
-    set_globals e ⊎ elist_globals es) ∧
-  (set_globals _ = {||}) ∧
-  (elist_globals [] = {||}) ∧
-  (elist_globals (e::es) = set_globals e ⊎ elist_globals es)`
- (WF_REL_TAC `
-      measure (λa. case a of INL e => exp_size e | INR y => exp1_size y)` >>
-  rw[]);
-val _ = export_rewrites ["set_globals_def"]
-
-Theorem elist_globals_append:
-   ∀a b. elist_globals (a++b) =
-  elist_globals a ⊎ elist_globals b
-Proof
-  Induct>>fs[set_globals_def,ASSOC_BAG_UNION]
-QED
-
-Theorem elist_globals_reverse:
-   ∀ls. elist_globals (REVERSE ls) = elist_globals ls
-Proof
-  Induct>>fs[set_globals_def,elist_globals_append,COMM_BAG_UNION]
-QED
-
-Theorem elist_globals_FOLDR:
-   elist_globals es = FOLDR BAG_UNION {||} (MAP set_globals es)
-Proof
-  Induct_on `es` >> simp[]
-QED
-
-Theorem exp_size_MEM:
-   (∀elist e. MEM e elist ⇒ exp_size e < patLang$exp1_size elist)
-Proof
-  Induct>>rw[]>>fs[patLangTheory.exp_size_def]>>rw[]>>
-  res_tac>>fs[]
-QED
-
-val esgc_free_def = tDefine "esgc_free" `
-  (esgc_free (Raise _ e) ⇔ esgc_free e) ∧
-  (esgc_free (Handle _ e1 e2) ⇔ esgc_free e1 ∧ esgc_free e2) ∧
-  (esgc_free (Con _ _ es) ⇔ EVERY esgc_free es) ∧
-  (esgc_free (Fun _ e) ⇔ set_globals e = {||}) ∧
-  (esgc_free (App _ op es) ⇔ EVERY esgc_free es) ∧
-  (esgc_free (If _ e1 e2 e3) ⇔ esgc_free e1 ∧ esgc_free e2 ∧ esgc_free e3) ∧
-  (esgc_free (Let _ e1 e2) ⇔ esgc_free e1 ∧ esgc_free e2) ∧
-  (esgc_free (Seq _ e1 e2) ⇔ esgc_free e1 ∧ esgc_free e2) ∧
-  (esgc_free (Letrec _ es e) ⇔
-    elist_globals es = {||} ∧ esgc_free e) ∧
-  (esgc_free _ = T)`
-  (WF_REL_TAC `measure exp_size` >> simp[] >> rpt strip_tac >>
-   imp_res_tac exp_size_MEM >> simp[])
-
-val esgc_free_def = save_thm("esgc_free_def[simp,compute]",
-  SIMP_RULE (bool_ss ++ ETA_ss) [] esgc_free_def)
-
-val _ = export_theory()
diff --git a/compiler/backend/semantics/patSemScript.sml b/compiler/backend/semantics/patSemScript.sml
deleted file mode 100644
index 457aa6ce76..0000000000
--- a/compiler/backend/semantics/patSemScript.sml
+++ /dev/null
@@ -1,694 +0,0 @@
-(*
-  The formal semantics of patLang
-*)
-open preamble backend_commonTheory patLangTheory;
-open semanticPrimitivesPropsTheory; (* for do_shift and others *)
-
-val _ = new_theory"patSem"
-
-(*
- * The values and semantics of patLang are the same as exhLang, modulo the
- * changes to expressions.
- *)
-
-val _ = Datatype`
-  v =
-   | Litv lit
-   | Conv num (v list)
-   | Closure (v list) patLang$exp
-   | Recclosure (v list) (patLang$exp list) num
-   | Loc num
-   | Vectorv (v list)`;
-
-val _ = Define `
-  build_rec_env funs cl_env =
-  GENLIST (Recclosure cl_env funs) (LENGTH funs)`;
-
-val _ = Define `
-  do_opapp vs =
-  (case vs of
-   | [Closure env e; v] => SOME ((v::env), e)
-   | [Recclosure env funs n; v] =>
-     if n < LENGTH funs then
-       SOME ((v::((build_rec_env funs env)++env)), EL n funs)
-     else NONE
-   | _ => NONE)`;
-
-val do_eq_def = tDefine"do_eq"`
-  (do_eq ((Litv l1):patSem$v) ((Litv l2):patSem$v) =
-   if lit_same_type l1 l2 then Eq_val (l1 = l2)
-   else Eq_type_error)
-  ∧
-  (do_eq (Loc l1) (Loc l2) = Eq_val (l1 = l2))
-  ∧
-  (do_eq (Conv tag1 vs1) (Conv tag2 vs2) =
-   if tag1 = tag2 ∧ LENGTH vs1 = LENGTH vs2 then
-     do_eq_list vs1 vs2
-   else
-     Eq_val F)
-  ∧
-  (do_eq (Vectorv vs1) (Vectorv vs2) =
-   if LENGTH vs1 = LENGTH vs2 then
-     do_eq_list vs1 vs2
-   else
-     Eq_val F)
-  ∧
-  (do_eq (Closure _ _) (Closure _ _) = Eq_val T)
-  ∧
-  (do_eq (Closure _ _) (Recclosure _ _ _) = Eq_val T)
-  ∧
-  (do_eq (Recclosure _ _ _) (Closure _ _) = Eq_val T)
-  ∧
-  (do_eq (Recclosure _ _ _) (Recclosure _ _ _) = Eq_val T)
-  ∧
-  (do_eq _ _ = Eq_type_error)
-  ∧
-  (do_eq_list [] [] = Eq_val T)
-  ∧
-  (do_eq_list (v1::vs1) (v2::vs2) =
-   (case do_eq v1 v2 of
-    | Eq_type_error => Eq_type_error
-    | Eq_val r =>
-      if r then
-        do_eq_list vs1 vs2
-      else
-        Eq_val F))
-  ∧
-  (do_eq_list _ _ = Eq_val F)`
-  (WF_REL_TAC `inv_image $< (\x. case x of INL (x,y) => v_size x
-                                        | INR (xs,ys) => v1_size xs)`);
-
-val _ = Define `
-  prim_exn tag = Conv tag []`;
-
-val _ = Define `
-  (v_to_list (Conv tag []) =
-   if tag = nil_tag then
-     SOME []
-   else
-     NONE)
-  ∧
-  (v_to_list (Conv tag [v1;v2]) =
-   if tag = cons_tag then
-     (case v_to_list v2 of
-      | SOME vs => SOME (v1::vs)
-      | NONE => NONE)
-   else
-     NONE)
-  ∧
-  (v_to_list _ = NONE)`;
-
-val list_to_v_def = Define `
-  list_to_v []      = Conv nil_tag [] /\
-  list_to_v (x::xs) = Conv cons_tag [x; list_to_v xs]`
-
-val _ = Define `
-  (v_to_char_list (Conv tag []) =
-   if tag = nil_tag then
-     SOME []
-   else
-     NONE)
-  ∧
-  (v_to_char_list (Conv tag [Litv (Char c);v]) =
-   if tag = cons_tag then
-     (case v_to_char_list v of
-      | SOME cs => SOME (c::cs)
-      | NONE => NONE)
-   else
-     NONE)
-  ∧
-  (v_to_char_list _ = NONE)`;
-
-val vs_to_string_def = Define`
-  (vs_to_string [] = SOME "") ∧
-  (vs_to_string (Litv(StrLit s1)::vs) =
-   case vs_to_string vs of
-   | SOME s2 => SOME (s1++s2)
-   | _ => NONE) ∧
-  (vs_to_string _ = NONE)`;
-
-val v_to_bytes_def = Define `
-  v_to_bytes lv = some ns. v_to_list lv = SOME (MAP (Litv o Word8) ns)`;
-
-val v_to_words_def = Define `
-  v_to_words lv = some ns. v_to_list lv = SOME (MAP (Litv o Word64) ns)`;
-
-val _ = Define `
-  Boolv b = Conv (if b then true_tag else false_tag) []`;
-
-val _ = Datatype`
-  state =
-    <| clock   : num
-     ; refs    : patSem$v store
-     ; ffi     : 'ffi ffi_state
-     ; globals : patSem$v option list
-     ; compile : 'c -> patLang$exp list -> (word8 list # word64 list # 'c) option
-     ; compile_oracle : num -> 'c # patLang$exp list
-     |>`;
-
-val do_app_def = Define `
- (do_app s (op : patLang$op) vs =
-((case (op,vs) of
-      (Op (Opn op), [Litv (IntLit n1); Litv (IntLit n2)]) =>
-        if ((op = Divide) \/ (op = Modulo)) /\ (n2 =( 0 : int)) then
-          SOME (s, Rerr (Rraise (prim_exn div_tag)))
-        else
-          SOME (s, Rval (Litv (IntLit (opn_lookup op n1 n2))))
-    | (Op (Opb op), [Litv (IntLit n1); Litv (IntLit n2)]) =>
-        SOME (s, Rval (Boolv (opb_lookup op n1 n2)))
-    | (Op (Opw wz op), [Litv w1; Litv w2]) =>
-       (case do_word_op op wz w1 w2 of
-            | NONE => NONE
-            | SOME w => SOME (s, Rval (Litv w)))
-    | (Op (FP_top top),
-        [Litv (Word64 w1); Litv (Word64 w2); Litv (Word64 w3)]) =>
-      SOME (s, Rval (Litv (Word64 (fp_top top w1 w2 w3))))
-    | (Op (FP_bop bop), [Litv (Word64 w1); Litv (Word64 w2)]) =>
-      SOME (s,Rval (Litv (Word64 (fp_bop bop w1 w2))))
-    | (Op (FP_uop uop), [Litv (Word64 w)]) =>
-        SOME (s,Rval (Litv (Word64 (fp_uop uop w))))
-    | (Op (FP_cmp cmp), [Litv (Word64 w1); Litv (Word64 w2)]) =>
-        SOME (s,Rval (Boolv (fp_cmp cmp w1 w2)))
-    | (Op (Shift wz sh n), [Litv w]) =>
-        (case do_shift sh n wz w of
-           | NONE => NONE
-           | SOME w => SOME (s, Rval (Litv w)))
-    | (Op Equality, [v1; v2]) =>
-        (case do_eq v1 v2 of
-            Eq_type_error => NONE
-          | Eq_val b => SOME (s, Rval(Boolv b))
-        )
-    | (Op Opassign, [Loc lnum; v]) =>
-        (case store_assign lnum (Refv v) s.refs of
-          SOME st => SOME (s with refs := st, Rval (Conv tuple_tag []))
-        | NONE => NONE
-        )
-    | (Op Opderef, [Loc n]) =>
-        (case store_lookup n s.refs of
-            SOME (Refv v) => SOME (s,Rval v)
-          | _ => NONE
-        )
-    | (Op Opref, [v]) =>
-        let (s',n) = (store_alloc (Refv v) s.refs) in
-          SOME (s with refs := s', Rval (Loc n))
-    | (Op (GlobalVarInit idx), [v]) =>
-        if idx < LENGTH s.globals then
-          (case EL idx s.globals of
-              NONE => SOME ((s with globals := LUPDATE (SOME v) idx s.globals), Rval (Conv tuple_tag []))
-            | SOME _ => NONE
-          )
-        else
-          NONE
-    | (Op Aw8alloc, [Litv (IntLit n); Litv (Word8 w)]) =>
-        if n <( 0 : int) then
-          SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-        else
-          let (st,lnum) =
-(store_alloc (W8array (REPLICATE (Num (ABS ( n))) w)) s.refs)
-          in
-            SOME (s with refs := st, Rval (Loc lnum))
-    | (Op Aw8sub, [Loc lnum; Litv (IntLit i)]) =>
-        (case store_lookup lnum s.refs of
-            SOME (W8array ws) =>
-              if i <( 0 : int) then
-                SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-              else
-                let n = (Num (ABS ( i))) in
-                  if n >= LENGTH ws then
-                    SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-                  else
-                    SOME (s, Rval (Litv (Word8 (EL n ws))))
-          | _ => NONE
-        )
-    | (Op Aw8sub_unsafe, [Loc lnum; Litv (IntLit i)]) =>
-        (case store_lookup lnum s.refs of
-            SOME (W8array ws) =>
-              if i <( 0 : int) then
-                NONE
-              else
-                let n = (Num (ABS ( i))) in
-                  if n >= LENGTH ws then
-                    NONE
-                  else
-                    SOME (s, Rval (Litv (Word8 (EL n ws))))
-          | _ => NONE
-        )
-    | (Op Aw8length, [Loc n]) =>
-        (case store_lookup n s.refs of
-            SOME (W8array ws) =>
-              SOME (s,Rval (Litv (IntLit (int_of_num (LENGTH ws)))))
-          | _ => NONE
-        )
-    | (Op Aw8update, [Loc lnum; Litv (IntLit i); Litv (Word8 w)]) =>
-        (case store_lookup lnum s.refs of
-          SOME (W8array ws) =>
-            if i <( 0 : int) then
-              SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-            else
-              let n = (Num (ABS ( i))) in
-                if n >= LENGTH ws then
-                  SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-                else
-                  (case store_assign lnum (W8array (LUPDATE w n ws)) s.refs of
-                      NONE => NONE
-                    | SOME st => SOME (s with refs := st, Rval (Conv tuple_tag []))
-                  )
-        | _ => NONE
-        )
-    | (Op Aw8update_unsafe, [Loc lnum; Litv (IntLit i); Litv (Word8 w)]) =>
-        (case store_lookup lnum s.refs of
-          SOME (W8array ws) =>
-            if i <( 0 : int) then
-              NONE
-            else
-              let n = (Num (ABS ( i))) in
-                if n >= LENGTH ws then
-                  NONE
-                else
-                  (case store_assign lnum (W8array (LUPDATE w n ws)) s.refs of
-                      NONE => NONE
-                    | SOME st => SOME (s with refs := st, Rval (Conv tuple_tag []))
-                  )
-        | _ => NONE
-        )
-    | (Op (WordFromInt wz), [Litv (IntLit i)]) =>
-      SOME (s, Rval (Litv (do_word_from_int wz i)))
-    | (Op (WordToInt wz), [Litv w]) =>
-      (case do_word_to_int wz w of
-        | NONE => NONE
-        | SOME i => SOME (s, Rval (Litv (IntLit i))))
-    | (Op CopyStrStr, [Litv(StrLit str);Litv(IntLit off);Litv(IntLit len)]) =>
-        SOME (s,
-        (case copy_array (str,off) len NONE of
-          NONE => Rerr (Rraise (prim_exn subscript_tag))
-        | SOME cs => Rval (Litv(StrLit(cs)))))
-    | (Op CopyStrAw8, [Litv(StrLit str);Litv(IntLit off);Litv(IntLit len);
-                    Loc dst;Litv(IntLit dstoff)]) =>
-        (case store_lookup dst s.refs of
-          SOME (W8array ws) =>
-            (case copy_array (str,off) len (SOME(ws_to_chars ws,dstoff)) of
-              NONE => SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-            | SOME cs =>
-              (case store_assign dst (W8array (chars_to_ws cs)) s.refs of
-                SOME s' =>  SOME (s with refs := s', Rval (Conv tuple_tag []))
-              | _ => NONE))
-        | _ => NONE)
-    | (Op CopyAw8Str, [Loc src;Litv(IntLit off);Litv(IntLit len)]) =>
-      (case store_lookup src s.refs of
-        SOME (W8array ws) =>
-        SOME (s,
-          (case copy_array (ws,off) len NONE of
-            NONE => Rerr (Rraise (prim_exn subscript_tag))
-          | SOME ws => Rval (Litv(StrLit(ws_to_chars ws)))))
-      | _ => NONE)
-    | (Op CopyAw8Aw8, [Loc src;Litv(IntLit off);Litv(IntLit len);
-                    Loc dst;Litv(IntLit dstoff)]) =>
-      (case (store_lookup src s.refs, store_lookup dst s.refs) of
-        (SOME (W8array ws), SOME (W8array ds)) =>
-          (case copy_array (ws,off) len (SOME(ds,dstoff)) of
-            NONE => SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-          | SOME ws =>
-              (case store_assign dst (W8array ws) s.refs of
-                SOME s' => SOME (s with refs := s', Rval (Conv tuple_tag []))
-              | _ => NONE))
-      | _ => NONE)
-    | (Op Ord, [Litv (Char c)]) =>
-          SOME (s, Rval (Litv(IntLit(int_of_num(ORD c)))))
-    | (Op Chr, [Litv (IntLit i)]) =>
-        SOME (s,
-(if (i <( 0 : int)) \/ (i >( 255 : int)) then
-            Rerr (Rraise (prim_exn chr_tag))
-          else
-            Rval (Litv(Char(CHR(Num (ABS ( i))))))))
-    | (Op (Chopb op), [Litv (Char c1); Litv (Char c2)]) =>
-        SOME (s, Rval (Boolv (opb_lookup op (int_of_num(ORD c1)) (int_of_num(ORD c2)))))
-    | (Op Implode, [v]) =>
-          (case v_to_char_list v of
-            SOME ls =>
-              SOME (s, Rval (Litv (StrLit (IMPLODE ls))))
-          | NONE => NONE
-          )
-    | (Op Explode, [v]) =>
-          (case v of
-            Litv (StrLit str) =>
-              SOME (s, Rval (list_to_v (MAP (\c. Litv (Char c)) str)))
-          | _ => NONE
-          )
-    | (Op Strsub, [Litv (StrLit str); Litv (IntLit i)]) =>
-        if i <( 0 : int) then
-          SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-        else
-          let n = (Num (ABS ( i))) in
-            if n >= LENGTH str then
-              SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-            else
-              SOME (s, Rval (Litv (Char (EL n str))))
-    | (Op Strlen, [Litv (StrLit str)]) =>
-        SOME (s, Rval (Litv(IntLit(int_of_num(STRLEN str)))))
-    | (Op Strcat, [v]) =>
-        (case v_to_list v of
-          SOME vs =>
-            (case vs_to_string vs of
-              SOME str =>
-                SOME (s, Rval (Litv(StrLit str)))
-            | _ => NONE)
-        | _ => NONE)
-    | (Op VfromList, [v]) =>
-          (case v_to_list v of
-              SOME vs =>
-                SOME (s, Rval (Vectorv vs))
-            | NONE => NONE
-          )
-    | (Op Vsub, [Vectorv vs; Litv (IntLit i)]) =>
-        if i <( 0 : int) then
-          SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-        else
-          let n = (Num (ABS ( i))) in
-            if n >= LENGTH vs then
-              SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-            else
-              SOME (s, Rval (EL n vs))
-    | (Op Vlength, [Vectorv vs]) =>
-        SOME (s, Rval (Litv (IntLit (int_of_num (LENGTH vs)))))
-    | (Op Aalloc, [Litv (IntLit n); v]) =>
-        if n <( 0 : int) then
-          SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-        else
-          let (s',lnum) =
-(store_alloc (Varray (REPLICATE (Num (ABS ( n))) v)) s.refs)
-          in
-            SOME (s with refs := s', Rval (Loc lnum))
-    | (Op Asub, [Loc lnum; Litv (IntLit i)]) =>
-        (case store_lookup lnum s.refs of
-            SOME (Varray vs) =>
-              if i <( 0 : int) then
-                SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-              else
-                let n = (Num (ABS ( i))) in
-                  if n >= LENGTH vs then
-                    SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-                  else
-                    SOME (s, Rval (EL n vs))
-          | _ => NONE
-        )
-    | (Op Asub_unsafe, [Loc lnum; Litv (IntLit i)]) =>
-        (case store_lookup lnum s.refs of
-            SOME (Varray vs) =>
-              if i <( 0 : int) then
-                NONE
-              else
-                let n = (Num (ABS ( i))) in
-                  if n >= LENGTH vs then
-                    NONE
-                  else
-                    SOME (s, Rval (EL n vs))
-          | _ => NONE
-        )
-    | (Op Alength, [Loc n]) =>
-        (case store_lookup n s.refs of
-            SOME (Varray ws) =>
-              SOME (s,Rval (Litv (IntLit(int_of_num(LENGTH ws)))))
-          | _ => NONE
-         )
-    | (Op Aupdate, [Loc lnum; Litv (IntLit i); v]) =>
-        (case store_lookup lnum s.refs of
-          SOME (Varray vs) =>
-            if i <( 0 : int) then
-              SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-            else
-              let n = (Num (ABS ( i))) in
-                if n >= LENGTH vs then
-                  SOME (s, Rerr (Rraise (prim_exn subscript_tag)))
-                else
-                  (case store_assign lnum (Varray (LUPDATE v n vs)) s.refs of
-                      NONE => NONE
-                    | SOME s' => SOME (s with refs := s', Rval (Conv tuple_tag []))
-                  )
-        | _ => NONE
-      )
-    | (Op Aupdate_unsafe, [Loc lnum; Litv (IntLit i); v]) =>
-        (case store_lookup lnum s.refs of
-          SOME (Varray vs) =>
-            if i <( 0 : int) then
-              NONE
-            else
-              let n = (Num (ABS ( i))) in
-                if n >= LENGTH vs then
-                  NONE
-                else
-                  (case store_assign lnum (Varray (LUPDATE v n vs)) s.refs of
-                      NONE => NONE
-                    | SOME s' => SOME (s with refs := s', Rval (Conv tuple_tag []))
-                  )
-        | _ => NONE
-      )
-    | (Op ConfigGC, [Litv (IntLit n1); Litv (IntLit n2)]) =>
-         SOME (s, Rval (Conv tuple_tag []))
-    | (Op (FFI n), [Litv (StrLit conf); Loc lnum]) =>
-        (case store_lookup lnum s.refs of
-          SOME (W8array ws) =>
-            (case call_FFI s.ffi n (MAP (λc. n2w(ORD c)) conf) ws of
-             | FFI_return t' ws' =>
-               (case store_assign lnum (W8array ws') s.refs of
-                 SOME s' => SOME (s with <| refs := s'; ffi := t' |>, Rval (Conv tuple_tag []))
-               | NONE => NONE)
-             | FFI_final outcome => SOME (s, Rerr (Rabort (Rffi_error outcome))))
-        | _ => NONE)
-    | (Op (GlobalVarAlloc n), []) =>
-      SOME (s with globals := s.globals ++ REPLICATE n NONE, Rval (Conv tuple_tag []))
-    | (Op (GlobalVarLookup n), []) =>
-      if n < LENGTH s.globals ∧ IS_SOME (EL n s.globals) then
-        SOME (s, Rval (THE (EL n s.globals)))
-      else
-        NONE
-    | (Op ListAppend, [x1;x2]) =>
-        (case (v_to_list x1, v_to_list x2) of
-          (SOME xs, SOME ys) => SOME (s, Rval (list_to_v (xs ++ ys)))
-        | _ => NONE)
-    | (Tag_eq n l, [Conv tag vs]) =>
-        SOME (s, Rval (Boolv (tag = n ∧ LENGTH vs = l)))
-    | (El n, [Conv _ vs]) =>
-        if n < LENGTH vs then
-          SOME (s, Rval (EL n vs))
-        else
-          NONE
-    | _ => NONE
-  )))`;
-
-val do_install_def = Define`
-  do_install vs s =
-    case vs of
-    | [v1;v2] =>
-      (case (v_to_bytes v1, v_to_words v2) of
-       | (SOME bytes, SOME data) =>
-         let (st,exps) = s.compile_oracle 0 in
-         let new_oracle = shift_seq 1 s.compile_oracle in
-         (case s.compile st exps of
-          | SOME (bytes',data',st') =>
-            if bytes = bytes' ∧ data = data' ∧
-               FST(new_oracle 0) = st' ∧ exps <> [] then
-              SOME (exps, s with compile_oracle := new_oracle)
-            else NONE
-          | _ => NONE)
-       | _ => NONE)
-    | _ => NONE`;
-
-val op_thms = { nchotomy = patLangTheory.op_nchotomy, case_def = patLangTheory.op_case_def}
-val flatop_thms = {nchotomy = flatLangTheory.op_nchotomy, case_def = flatLangTheory.op_case_def}
-val astop_thms = {nchotomy = astTheory.op_nchotomy, case_def = astTheory.op_case_def}
-val list_thms = { nchotomy = list_nchotomy, case_def = list_case_def}
-val option_thms = { nchotomy = option_nchotomy, case_def = option_case_def}
-val v_thms = { nchotomy = theorem"v_nchotomy", case_def = definition"v_case_def"}
-val sv_thms = { nchotomy = semanticPrimitivesTheory.store_v_nchotomy, case_def = semanticPrimitivesTheory.store_v_case_def }
-val lit_thms = { nchotomy = astTheory.lit_nchotomy, case_def = astTheory.lit_case_def}
-val result_thms = { nchotomy = semanticPrimitivesTheory.result_nchotomy, case_def = semanticPrimitivesTheory.result_case_def}
-val error_result_thms = { nchotomy = semanticPrimitivesTheory.error_result_nchotomy, case_def = semanticPrimitivesTheory.error_result_case_def}
-val abort_thms = { nchotomy = semanticPrimitivesTheory.abort_nchotomy, case_def = semanticPrimitivesTheory.abort_case_def}
-val ffi_result_thms = { nchotomy = ffiTheory.ffi_result_nchotomy, case_def = ffiTheory.ffi_result_case_def };
-val eq_result_thms = { nchotomy = semanticPrimitivesTheory.eq_result_nchotomy, case_def = semanticPrimitivesTheory.eq_result_case_def}
-val eqs = LIST_CONJ (map prove_case_eq_thm
-  [op_thms, flatop_thms, astop_thms, list_thms, option_thms, v_thms, sv_thms, lit_thms, result_thms, error_result_thms, abort_thms, eq_result_thms, ffi_result_thms])
-
-val case_eq_thms = save_thm("case_eq_thms",eqs);
-
-Theorem do_install_clock:
-   do_install vs s = SOME (e,s') ⇒ s'.clock = s.clock
-Proof
-  rw[do_install_def,UNCURRY,eqs,pair_case_eq] \\ rw[]
-QED
-
-val do_app_cases = save_thm("do_app_cases",
-  ``patSem$do_app s op vs = SOME x`` |>
-  SIMP_CONV(srw_ss()++COND_elim_ss++LET_ss)[PULL_EXISTS, do_app_def, eqs, pair_case_eq]);
-
-val eq_result_CASE_tm = prim_mk_const{Name="eq_result_CASE",Thy="semanticPrimitives"};
-val check =
-  do_app_cases |> concl |> find_terms TypeBase.is_case
-  |> List.map (#1 o strip_comb)
-  |> List.all (fn tm => List.exists (same_const tm) [optionSyntax.option_case_tm, eq_result_CASE_tm])
-val () = if check then () else raise(mk_HOL_ERR"patSemTheory""do_app_cases""check failed")
-
-val do_app_cases_none = save_thm("do_app_cases_none",
-  ``patSem$do_app s op vs = NONE`` |>
-  SIMP_CONV(srw_ss()++COND_elim_ss++LET_ss)[PULL_EXISTS, do_app_def, eqs, pair_case_eq]);
-
-val do_if_def = Define `
-  do_if v e1 e2 =
-    if v = Boolv T then SOME e1 else
-    if v = Boolv F then SOME e2 else NONE`;
-
-Theorem do_if_either_or:
-   do_if v e1 e2 = SOME e ⇒ e = e1 ∨ e = e2
-Proof
-  simp [do_if_def]
-  THEN1 (Cases_on `v = Boolv T`
-  THENL [simp [],
-    Cases_on `v = Boolv F` THEN simp []])
-QED
-
-val dec_clock_def = Define`
-dec_clock s = s with clock := s.clock -1`;
-
-val fix_clock_def = Define `
-  fix_clock s (s1,res) = (s1 with clock := MIN s.clock s1.clock,res)`
-
-val fix_clock_IMP = Q.prove(
-  `fix_clock s x = (s1,res) ==> s1.clock <= s.clock`,
-  Cases_on `x` \\ fs [fix_clock_def] \\ rw [] \\ fs []);
-
-val evaluate_def = tDefine "evaluate"`
-  (evaluate (env:patSem$v list) (s:('c,'ffi) patSem$state) ([]:patLang$exp list) = (s,Rval [])) ∧
-  (evaluate env s (e1::e2::es) =
-    case fix_clock s (evaluate env s [e1]) of
-    | (s, Rval v) =>
-        (case evaluate env s (e2::es) of
-         | (s, Rval vs) => (s, Rval (HD v::vs))
-         | res => res)
-    | res => res) ∧
-  (evaluate env s [Lit _ l] = (s, Rval [Litv l])) ∧
-  (evaluate env s [Raise _ e] =
-   case evaluate env s [e] of
-   | (s, Rval v) => (s, Rerr (Rraise (HD v)))
-   | res => res) ∧
-  (evaluate env s [Handle _ e1 e2] =
-   case fix_clock s (evaluate env s [e1]) of
-   | (s, Rerr (Rraise v)) => evaluate (v::env) s [e2]
-   | res => res) ∧
-  (evaluate env s [Con _ tag es] =
-   case evaluate env s (REVERSE es) of
-   | (s, Rval vs) => (s, Rval [Conv tag (REVERSE vs)])
-   |  res => res) ∧
-  (evaluate env s [Var_local _ n] = (s,
-      if n < LENGTH env
-      then Rval [EL n env]
-      else Rerr (Rabort Rtype_error))) ∧
-  (evaluate env s [Fun _ e] = (s, Rval [Closure env e])) ∧
-  (evaluate env s [App _ op es] =
-   case fix_clock s (evaluate env s (REVERSE es)) of
-   | (s, Rval vs) =>
-       if op = Op Opapp then
-         (case do_opapp (REVERSE vs) of
-          | SOME (env, e) =>
-            if s.clock = 0 then
-              (s, Rerr (Rabort Rtimeout_error))
-            else
-              evaluate env (dec_clock s) [e]
-          | NONE => (s, Rerr (Rabort Rtype_error)))
-       else if op = Run then
-         ((*case do_install (REVERSE vs) s of
-          | SOME (es, s) =>
-            if s.clock = 0 then
-              (s, Rerr (Rabort Rtimeout_error))
-            else
-              (case evaluate [] (dec_clock s) es of
-               | (s, Rval vs) => (s, Rval [LAST vs])
-               | res => res)
-          | NONE => *)(s, Rerr (Rabort Rtype_error)))
-       else
-       (case (do_app s op (REVERSE vs)) of
-        | NONE => (s, Rerr (Rabort Rtype_error))
-        | SOME (s,r) => (s, list_result r))
-   | res => res) ∧
-  (evaluate env s [If _ e1 e2 e3] =
-   case fix_clock s (evaluate env s [e1]) of
-   | (s, Rval vs) =>
-       (case do_if (HD vs) e2 e3 of
-        | SOME e => evaluate env s [e]
-        | NONE => (s, Rerr (Rabort Rtype_error)))
-   | res => res) ∧
-  (evaluate env s [Let _ e1 e2] =
-   case fix_clock s (evaluate env s [e1]) of
-   | (s, Rval vs) => evaluate (HD vs::env) s [e2]
-   | res => res) ∧
-  (evaluate env s [Seq _ e1 e2] =
-   case fix_clock s (evaluate env s [e1]) of
-   | (s, Rval vs) => evaluate env s [e2]
-   | res => res) ∧
-  (evaluate env s [Letrec _ funs e] =
-   evaluate ((build_rec_env funs env)++env) s [e])`
-  (wf_rel_tac`inv_image ($< LEX $<)
-  (λx. case x of (_,s,es) => (s.clock,exp1_size es))`
-  THEN rpt strip_tac
-  THEN imp_res_tac fix_clock_IMP
-  THEN imp_res_tac do_if_either_or
-  THEN imp_res_tac do_install_clock
-  THEN fs [dec_clock_def])
-
-val evaluate_ind = theorem"evaluate_ind"
-
-Theorem do_app_clock:
-   patSem$do_app s op vs = SOME(s',r) ==> s.clock = s'.clock
-Proof
-  rpt strip_tac THEN fs[do_app_cases] >> rw[] \\
-  fs[LET_THM,semanticPrimitivesTheory.store_alloc_def,semanticPrimitivesTheory.store_assign_def]
-  \\ rw[] \\ rfs[]
-QED
-
-Theorem evaluate_clock:
-   (∀env s1 e r s2. evaluate env s1 e = (s2,r) ⇒ s2.clock ≤ s1.clock)
-Proof
-  ho_match_mp_tac evaluate_ind >> rw[evaluate_def,eqs,pair_case_eq,bool_case_eq] >>
-  fs[dec_clock_def] >> rw[] >> rfs[] >>
-  imp_res_tac fix_clock_IMP >>
-  imp_res_tac do_app_clock >>
-  imp_res_tac do_install_clock >>
-  fs[EQ_SYM_EQ] >> res_tac >> rfs[]
-QED
-
-Theorem fix_clock_evaluate:
-   fix_clock s (evaluate env s e) = evaluate env s e
-Proof
-  Cases_on `evaluate env s e` \\ fs [fix_clock_def]
-  \\ imp_res_tac evaluate_clock
-  \\ fs [MIN_DEF,theorem "state_component_equality"]
-QED
-
-val evaluate_def = save_thm("evaluate_def[compute]",
-  REWRITE_RULE [fix_clock_evaluate] evaluate_def);
-
-val evaluate_ind = save_thm("evaluate_ind",
-  REWRITE_RULE [fix_clock_evaluate] evaluate_ind);
-
-val semantics_def = Define`
-  semantics env st es =
-    if ∃k. SND (evaluate env (st with clock := k) es) = Rerr (Rabort Rtype_error)
-      then Fail
-    else
-    case some res.
-      ∃k s r outcome.
-        evaluate env (st with clock := k) es = (s,r) ∧
-        (case r of
-         | Rerr (Rabort (Rffi_error e)) => outcome = FFI_outcome e
-         | Rerr (Rabort _) => F
-         | _ => outcome = Success) ∧
-        res = Terminate outcome s.ffi.io_events
-    of SOME res => res
-     | NONE =>
-       Diverge
-         (build_lprefix_lub
-           (IMAGE (λk. fromList (FST (evaluate env (st with clock := k) es)).ffi.io_events) UNIV))`;
-
-val _ = map delete_const
-  ["do_eq_UNION_aux","do_eq_UNION", "evaluate_tupled_aux"];
-
-val _ = export_theory()
diff --git a/compiler/backend/source_to_flatScript.sml b/compiler/backend/source_to_flatScript.sml
index 8ae33885c2..2a7d75407d 100644
--- a/compiler/backend/source_to_flatScript.sml
+++ b/compiler/backend/source_to_flatScript.sml
@@ -12,8 +12,7 @@
   than Recclosures.
 *)
 open preamble astTheory terminationTheory flatLangTheory;
-open flat_elimTheory flat_exh_matchTheory flat_uncheck_ctorsTheory
-     flat_reorder_matchTheory
+open flat_elimTheory flat_patternTheory;
 
 
 val _ = new_theory"source_to_flat";
@@ -76,7 +75,7 @@ val astOp_to_flatOp_def = Define `
   | Opapp => flatLang$Opapp
   | Opassign => flatLang$Opassign
   | Opref => flatLang$Opref
-  | Opderef => flatLang$Opderef
+  | Opderef => flatLang$El 0
   | Aw8alloc => flatLang$Aw8alloc
   | Aw8sub => flatLang$Aw8sub
   | Aw8length => flatLang$Aw8length
@@ -360,17 +359,18 @@ val compile_decs_def = tDefine "compile_decs" `
 val _ = Datatype`
   config = <| next : next_indices
             ; mod_env : environment
+            ; pattern_cfg : flat_pattern$config
             |>`;
 
 val empty_config_def = Define`
   empty_config =
-    <| next := <| vidx := 0; tidx := 0; eidx := 0 |>; mod_env := empty_env |>`;
+    <| next := <| vidx := 0; tidx := 0; eidx := 0 |>;
+        mod_env := empty_env;
+        pattern_cfg := flat_pattern$init_config (K 0) |>`;
 
 val compile_flat_def = Define `
-  compile_flat = flat_reorder_match$compile_decs
-               o flat_uncheck_ctors$compile_decs
-               o flat_elim$remove_flat_prog
-               o SND o flat_exh_match$compile`;
+  compile_flat pcfg = flat_pattern$compile_decs pcfg
+    o flat_elim$remove_flat_prog`;
 
 val glob_alloc_def = Define `
   glob_alloc next c =
@@ -383,11 +383,13 @@ val glob_alloc_def = Define `
 val compile_prog_def = Define`
   compile_prog c p =
     let (_,next,e,p') = compile_decs 1n c.next c.mod_env p in
-    (<| next := next; mod_env := e |>, glob_alloc next c :: p')`;
+    (c with <| next := next; mod_env := e |>, glob_alloc next c :: p')`;
 
 val compile_def = Define `
   compile c p =
     let (c', p') = compile_prog c p in
-    (c', compile_flat p')`;
+    let (pc', p') = compile_flat c'.pattern_cfg p' in
+    let c'' = c' with <| pattern_cfg := pc' |> in
+    (c'', p')`;
 
 val _ = export_theory();
diff --git a/compiler/bootstrap/translation/README.md b/compiler/bootstrap/translation/README.md
index 14d1d0f3a4..5b68165c4b 100644
--- a/compiler/bootstrap/translation/README.md
+++ b/compiler/bootstrap/translation/README.md
@@ -53,7 +53,7 @@ Translate the backend phase from BVL to BVI.
 Translate the backend phase from closLang to BVL.
 
 [to_closProgScript.sml](to_closProgScript.sml):
-Translate the backend phase from patLang to closLang.
+Translate the backend phase from flatLang to closLang.
 
 [to_dataProgScript.sml](to_dataProgScript.sml):
 Translate the backend phase from BVI to dataLang.
@@ -61,9 +61,6 @@ Translate the backend phase from BVI to dataLang.
 [to_flatProgScript.sml](to_flatProgScript.sml):
 Translate backend phases up to and including flatLang.
 
-[to_patProgScript.sml](to_patProgScript.sml):
-Translate the backend phase from flatLang to patLang.
-
 [to_target32ProgScript.sml](to_target32ProgScript.sml):
 Translate the final part of the compiler backend for 32-bit targets.
 
diff --git a/compiler/bootstrap/translation/compiler32ProgScript.sml b/compiler/bootstrap/translation/compiler32ProgScript.sml
index 26ce394994..8e8b4ffe55 100644
--- a/compiler/bootstrap/translation/compiler32ProgScript.sml
+++ b/compiler/bootstrap/translation/compiler32ProgScript.sml
@@ -205,6 +205,7 @@ val _ = ml_translatorLib.ml_prog_update (ml_progLib.close_module NONE);
 (* Rest of the translation *)
 val res = translate (extend_conf_def |> spec32 |> SIMP_RULE (srw_ss()) [MEMBER_INTRO]);
 val res = translate parse_target_32_def;
+val res = translate Appends_def;
 val res = translate add_tap_output_def;
 
 val res = format_compiler_result_def
diff --git a/compiler/bootstrap/translation/compiler64ProgScript.sml b/compiler/bootstrap/translation/compiler64ProgScript.sml
index c6ba950aed..cb95a35a96 100644
--- a/compiler/bootstrap/translation/compiler64ProgScript.sml
+++ b/compiler/bootstrap/translation/compiler64ProgScript.sml
@@ -224,6 +224,7 @@ val _ = ml_translatorLib.ml_prog_update (ml_progLib.close_module NONE);
 (* Rest of the translation *)
 val res = translate (extend_conf_def |> spec64 |> SIMP_RULE (srw_ss()) [MEMBER_INTRO]);
 val res = translate parse_target_64_def;
+val res = translate Appends_def;
 val res = translate add_tap_output_def;
 
 val res = format_compiler_result_def
diff --git a/compiler/bootstrap/translation/explorerProgScript.sml b/compiler/bootstrap/translation/explorerProgScript.sml
index 42dc99f873..e770223206 100644
--- a/compiler/bootstrap/translation/explorerProgScript.sml
+++ b/compiler/bootstrap/translation/explorerProgScript.sml
@@ -30,36 +30,24 @@ fun def_of_const tm = let
 
 val _ = (find_def_for_const := def_of_const);
 
-val res = translate jsonLangTheory.escape_def;
-val res = translate jsonLangTheory.concat_with_def;
+val res = translate jsonLangTheory.num_to_hex_digit_def;
 
-val mem_to_string_lemma = prove(
-  ``mem_to_string x =
-    Append (Append (Append (List "\"") (List (FST x))) (List "\":"))
-       (json_to_string (SND x))``,
-  Cases_on `x` \\ simp [Once jsonLangTheory.json_to_string_def] \\ fs []);
+val num_to_hex_digit_side = prove(
+  ``num_to_hex_digit_side n = T``,
+  EVAL_TAC \\ fs [])
+  |> update_precondition;
+
+val res = translate jsonLangTheory.encode_str_def;
+val res = translate jsonLangTheory.concat_with_def;
 
-val res = translate_no_ind
-  (jsonLangTheory.json_to_string_def
-   |> CONJUNCT1 |> SPEC_ALL
-   |> (fn th => LIST_CONJ [th,mem_to_string_lemma]));
+val res = translate jsonLangTheory.json_to_mlstring_def;
 
 val ind_lemma = Q.prove(
   `^(first is_forall (hyp res))`,
   rpt gen_tac
   \\ rpt (disch_then strip_assume_tac)
-  \\ match_mp_tac (latest_ind ())
-  \\ rpt strip_tac
-  \\ last_x_assum match_mp_tac
-  \\ rpt strip_tac
-  \\ fs [])
-  |> update_precondition;
-
-val res = translate presLangTheory.num_to_hex_digit_def;
-
-val num_to_hex_digit_side = prove(
-  ``num_to_hex_digit_side n = T``,
-  EVAL_TAC \\ fs [])
+  \\ match_mp_tac jsonLangTheory.json_to_mlstring_ind
+  \\ metis_tac [])
   |> update_precondition;
 
 val res = translate presLangTheory.num_to_hex_def;
@@ -69,21 +57,23 @@ val res = translate
 val res = translate
   (presLangTheory.display_word_to_hex_string_def |> INST_TYPE [``:'a``|->``:64``]);
 
-val res = translate displayLangTheory.num_to_json_def;
 val res = translate displayLangTheory.trace_to_json_def;
 val res = translate displayLangTheory.display_to_json_def;
 
+(* fixme: flat op datatype has been translated with use_string_type, which
+   for compatibility here needs that switch on, and looks like it results
+   in an unnecessary explode/implode pair *)
 val _ = ml_translatorLib.use_string_type true;
-val res = translate (presLangTheory.flat_op_to_display_def |>
-                     REWRITE_RULE [presLangTheory.string_to_display2_def])
-
+val res = translate (presLangTheory.flat_op_to_display_def);
 val _ = ml_translatorLib.use_string_type false;
+
 val _ = translate presLangTheory.lang_to_json_def
 
+(* again *)
 val _ = ml_translatorLib.use_string_type true;
 val r = translate presLangTheory.lit_to_display_def
-
 val _ = ml_translatorLib.use_string_type false;
+
 val r = translate presLangTheory.num_to_varn_def
 val num_to_varn_side = Q.prove(`
   ∀n. num_to_varn_side n ⇔ T`,
@@ -92,34 +82,26 @@ val num_to_varn_side = Q.prove(`
   `n MOD 26 < 26` by simp[] \\ decide_tac)
   |> update_precondition;
 
-val r = translate (presLangTheory.display_num_as_varn_def
-                   |> REWRITE_RULE [presLangTheory.string_to_display2_def])
-
-val _ = ml_translatorLib.use_string_type true;
-val _ = translate (presLangTheory.flat_pat_to_display_def |>
-                   REWRITE_RULE [presLangTheory.string_to_display2_def])
-
-Theorem string_to_display2_lam:
-  string_to_display2 = \s. string_to_display (implode s)
+Theorem string_imp_lam:
+  string_imp = \s. String (implode s)
 Proof
-  fs [FUN_EQ_THM,presLangTheory.string_to_display2_def]
+  fs [FUN_EQ_THM,presLangTheory.string_imp_def]
 QED
 
-val res = translate (presLangTheory.flat_to_display_def |>
-                     SIMP_RULE std_ss [string_to_display2_lam])
-
-val res = translate presLangTheory.tap_flat_def;
+val string_imp = SIMP_RULE bool_ss [string_imp_lam];
 
+val r = translate (presLangTheory.display_num_as_varn_def |> string_imp);
+val _ = ml_translatorLib.use_string_type true;
+val res = translate (presLangTheory.flat_to_display_def)
 val _ = ml_translatorLib.use_string_type false;
-val res = translate presLangTheory.tap_pat_def;
 
-val _ = ml_translatorLib.use_string_type true;
-val r = translate (presLangTheory.clos_op_to_display_def |>
-                   SIMP_RULE std_ss [string_to_display2_lam]);
+val res = translate presLangTheory.tap_flat_def;
 
+val _ = ml_translatorLib.use_string_type true;
+val r = translate (presLangTheory.clos_op_to_display_def |> string_imp);
 val _ = ml_translatorLib.use_string_type false;
-val r = translate (presLangTheory.clos_to_display_def |>
-                   SIMP_RULE std_ss [string_to_display2_lam]);
+
+val r = translate (presLangTheory.clos_to_display_def |> string_imp);
 
 val res = translate presLangTheory.tap_clos_def;
 
@@ -129,7 +111,7 @@ val res = translate presLangTheory.tap_clos_def;
 (* more parts of the external interface *)
 val res = translate presLangTheory.default_tap_config_def;
 val res = translate presLangTheory.mk_tap_config_def;
-val res = translate presLangTheory.tap_data_strings_def;
+val res = translate presLangTheory.tap_data_mlstrings_def;
 
 val () = Feedback.set_trace "TheoryPP.include_docs" 0;
 
diff --git a/compiler/bootstrap/translation/to_closProgScript.sml b/compiler/bootstrap/translation/to_closProgScript.sml
index 5a3a0d4a86..18bbddad28 100644
--- a/compiler/bootstrap/translation/to_closProgScript.sml
+++ b/compiler/bootstrap/translation/to_closProgScript.sml
@@ -1,10 +1,12 @@
 (*
-  Translate the backend phase from patLang to closLang.
+  Translate the backend phase from flatLang to closLang.
 *)
-open preamble ml_translatorLib ml_translatorTheory to_patProgTheory
+open preamble ml_translatorLib ml_translatorTheory to_flatProgTheory
+local open flat_to_closTheory clos_mtiTheory clos_numberTheory
+  clos_knownTheory clos_callTheory clos_annotateTheory in end
 
 val _ = new_theory "to_closProg";
-val _ = translation_extends "to_patProg";
+val _ = translation_extends "to_flatProg";
 
 val _ = ml_translatorLib.ml_prog_update (ml_progLib.open_module "to_closProg");
 val _ = ml_translatorLib.use_string_type true;
@@ -59,17 +61,21 @@ val _ = (find_def_for_const := def_of_const);
 val _ = use_long_names:=true;
 
 (* ------------------------------------------------------------------------- *)
-(* pat_to_clos                                                               *)
+(* flat_to_clos                                                               *)
 (* ------------------------------------------------------------------------- *)
 
-val r = translate pat_to_closTheory.compile_def;
+val r = translate flat_to_closTheory.compile_def;
 
-val pat_to_clos_compile_side = Q.prove(`
-  ∀x. pat_to_clos_compile_side x ⇔ T`,
-  recInduct pat_to_closTheory.compile_ind>>
+val flat_to_clos_compile_side = Q.prove(
+  `∀m xs. flat_to_clos_compile_side m xs ⇔ T`,
+  recInduct flat_to_closTheory.compile_ind>>
   rw[]>>
-  simp[Once (fetch "-" "pat_to_clos_compile_side_def")]>>
-  Cases_on`es`>>fs[])|>update_precondition;
+  simp[Once (fetch "-" "flat_to_clos_compile_side_def")]>>
+  rw[]>>
+  res_tac
+  ) |> update_precondition
+
+val r = translate flat_to_closTheory.compile_decs_def;
 
 (* ------------------------------------------------------------------------- *)
 (* clos_mti                                                                  *)
@@ -121,14 +127,14 @@ val clos_known_known_op_side = Q.prove(`
 
 val r = translate clos_knownTheory.free_def;
 
-Theorem clos_known_free_side = Q.prove(`
-  !x. clos_known_free_side x`,
+Theorem clos_known_free_side = Q.prove(
+  `!x. clos_known_free_side x`,
   ho_match_mp_tac clos_knownTheory.free_ind \\ rw []
-  \\ `!xs ys l. free xs = (ys, l) ==> LENGTH xs = LENGTH ys` by
+  \\ `!xs ys l. clos_known$free xs = (ys, l) ==> LENGTH xs = LENGTH ys` by
    (ho_match_mp_tac clos_knownTheory.free_ind
     \\ rw [] \\ fs [clos_knownTheory.free_def]
     \\ rpt (pairarg_tac \\ fs []) \\ rw [])
-  \\ `!x l. free [x] <> ([], l)` by (CCONTR_TAC \\ fs [] \\ last_x_assum drule \\ fs [])
+  \\ `!x l. clos_known$free [x] <> ([], l)` by (CCONTR_TAC \\ fs [] \\ last_x_assum drule \\ fs [])
   \\ once_rewrite_tac [fetch "-" "clos_known_free_side_def"] \\ fs []
   \\ rw [] \\ fs [] \\ metis_tac []) |> update_precondition;
 
diff --git a/compiler/bootstrap/translation/to_flatProgScript.sml b/compiler/bootstrap/translation/to_flatProgScript.sml
index 622c27a9c6..01f0d03a62 100644
--- a/compiler/bootstrap/translation/to_flatProgScript.sml
+++ b/compiler/bootstrap/translation/to_flatProgScript.sml
@@ -3,6 +3,8 @@
 *)
 open preamble ml_translatorLib ml_translatorTheory basisProgTheory
 
+local open source_to_flatTheory in end;
+
 val _ = new_theory "to_flatProg";
 val _ = translation_extends "basisProg";
 
@@ -89,87 +91,39 @@ val res = translate sumTheory.ISR;
 val res = translate source_to_flatTheory.compile_prog_def;
 
 (* ------------------------------------------------------------------------- *)
-(* flat_reorder_match                                                        *)
+(* flat_elim                                                                 *)
 (* ------------------------------------------------------------------------- *)
 
-val res = translate flat_reorder_matchTheory.compile_def;
-
-val side_def = fetch "-" "flat_reorder_match_compile_side_def";
-
-val flat_reorder_match_compile_side_simp = prove(
-  ``!x. flat_reorder_match_compile_side x = T``,
-  ho_match_mp_tac flat_reorder_matchTheory.compile_ind
-  \\ rw []
-  \\ once_rewrite_tac [side_def]
-  \\ simp [FORALL_PROD]
-  \\ rw [] \\ res_tac \\ fs [])
-  |> update_precondition;
-
-val res = translate flat_reorder_matchTheory.compile_decs_def;
-
-val side_def = fetch "-" "flat_reorder_match_compile_decs_side_def";
-
-val flat_reorder_match_compile_decs_side_simp = prove(
-  ``!x. flat_reorder_match_compile_decs_side x = T``,
-  Induct THEN1 fs [side_def]
-  \\ Cases
-  \\ once_rewrite_tac [side_def]
-  \\ once_rewrite_tac [side_def] \\ fs [])
-  |> update_precondition;
+val res = translate flat_elimTheory.remove_flat_prog_def;
 
 (* ------------------------------------------------------------------------- *)
-(* flat_uncheck_ctors                                                        *)
+(* flat_pattern                                                              *)
 (* ------------------------------------------------------------------------- *)
 
-val res = translate flat_uncheck_ctorsTheory.compile_def;
+val _ = translate pattern_compTheory.is_True_def
+val _ = translate pattern_compTheory.is_Any_def
+val _ = translate pattern_compTheory.take_until_Any_def
+val _ = translate pattern_compTheory.comp_def
 
-val side_def = fetch "-" "flat_uncheck_ctors_compile_side_def";
+val res = translate flat_patternTheory.enc_num_to_name_def;
 
-val flat_uncheck_ctors_compile_side_simp = prove(
-  ``!x. flat_uncheck_ctors_compile_side x = T``,
-  ho_match_mp_tac flat_uncheck_ctorsTheory.compile_ind
-  \\ rw []
-  \\ once_rewrite_tac [side_def]
-  \\ simp [FORALL_PROD]
-  \\ rw [] \\ res_tac \\ fs [])
-  |> update_precondition;
+val enc_side = Q.prove(
+  `!n s. flat_pattern_enc_num_to_name_side n s = T`,
+  gen_tac
+  \\ measureInduct_on `I n`
+  \\ simp [fetch "-" "flat_pattern_enc_num_to_name_side_def"]
+  ) |> update_precondition;
 
-val res = translate flat_uncheck_ctorsTheory.compile_decs_def;
+val res = translate flat_patternTheory.dec_name_to_num_def;
 
-val side_def = fetch "-" "flat_uncheck_ctors_compile_decs_side_def";
+val dec_side = Q.prove(
+  `!s. flat_pattern_dec_name_to_num_side s = T`,
+  simp [fetch "-" "flat_pattern_dec_name_to_num_side_def"]
+  ) |> update_precondition;
 
-val flat_uncheck_ctors_compile_decs_side_simp = prove(
-  ``!x. flat_uncheck_ctors_compile_decs_side x = T``,
-  Induct THEN1 fs [side_def]
-  \\ Cases
-  \\ once_rewrite_tac [side_def]
-  \\ once_rewrite_tac [side_def] \\ fs [])
-  |> update_precondition;
+val res = translate rich_listTheory.COUNT_LIST_compute;
 
-(* ------------------------------------------------------------------------- *)
-(* flat_exh_match                                                            *)
-(* ------------------------------------------------------------------------- *)
-
-val res = translate flat_exh_matchTheory.compile_exps_def;
-
-val side_def = fetch "-" "flat_exh_match_compile_exps_side_def";
-
-val flat_exh_match_compile_exps_side_simp = prove(
-  ``!y x. flat_exh_match_compile_exps_side y x = T``,
-  ho_match_mp_tac flat_exh_matchTheory.compile_exps_ind
-  \\ rw []
-  \\ once_rewrite_tac [side_def]
-  \\ simp [FORALL_PROD,TRUE_def,FALSE_def]
-  \\ rw [] \\ res_tac \\ fs [])
-  |> update_precondition;
-
-val res = translate flat_exh_matchTheory.compile_decs_def;
-
-(* ------------------------------------------------------------------------- *)
-(* flat_elim                                                                 *)
-(* ------------------------------------------------------------------------- *)
-
-val res = translate flat_elimTheory.remove_flat_prog_def;
+val res = translate flat_patternTheory.compile_decs_def;
 
 (* ------------------------------------------------------------------------- *)
 (* source_to_flat                                                            *)
diff --git a/compiler/bootstrap/translation/to_patProgScript.sml b/compiler/bootstrap/translation/to_patProgScript.sml
deleted file mode 100644
index ab4c8ea9d8..0000000000
--- a/compiler/bootstrap/translation/to_patProgScript.sml
+++ /dev/null
@@ -1,73 +0,0 @@
-(*
-  Translate the backend phase from flatLang to patLang.
-*)
-open preamble ml_translatorLib ml_translatorTheory to_flatProgTheory
-
-val _ = new_theory "to_patProg";
-val _ = translation_extends "to_flatProg";
-
-val _ = ml_translatorLib.ml_prog_update (ml_progLib.open_module "to_patProg");
-
-val _ = ml_translatorLib.use_string_type true;
-
-(* ------------------------------------------------------------------------- *)
-(* Setup                                                                     *)
-(* ------------------------------------------------------------------------- *)
-
-val RW = REWRITE_RULE
-val RW1 = ONCE_REWRITE_RULE
-fun list_dest f tm =
-  let val (x,y) = f tm in list_dest f x @ list_dest f y end
-  handle HOL_ERR _ => [tm];
-val dest_fun_type = dom_rng
-val mk_fun_type = curry op -->;
-fun list_mk_fun_type [ty] = ty
-  | list_mk_fun_type (ty1::tys) =
-      mk_fun_type ty1 (list_mk_fun_type tys)
-  | list_mk_fun_type _ = fail()
-
-val _ = add_preferred_thy "-";
-val _ = add_preferred_thy "termination";
-
-val NOT_NIL_AND_LEMMA = Q.prove(
-  `(b <> [] /\ x) = if b = [] then F else x`,
-  Cases_on `b` THEN FULL_SIMP_TAC std_ss []);
-
-val extra_preprocessing = ref [MEMBER_INTRO,MAP];
-
-fun def_of_const tm = let
-  val res = dest_thy_const tm handle HOL_ERR _ =>
-              failwith ("Unable to translate: " ^ term_to_string tm)
-  val name = (#Name res)
-  fun def_from_thy thy name =
-    DB.fetch thy (name ^ "_pmatch") handle HOL_ERR _ =>
-    DB.fetch thy (name ^ "_def") handle HOL_ERR _ =>
-    DB.fetch thy (name ^ "_DEF") handle HOL_ERR _ =>
-    DB.fetch thy name
-  val def = def_from_thy "termination" name handle HOL_ERR _ =>
-            def_from_thy (#Thy res) name handle HOL_ERR _ =>
-            failwith ("Unable to find definition of " ^ name)
-  val def = def |> RW (!extra_preprocessing)
-                |> CONV_RULE (DEPTH_CONV BETA_CONV)
-                (* TODO: This ss messes up defs containing if-then-else
-                with constant branches
-                |> SIMP_RULE bool_ss [IN_INSERT,NOT_IN_EMPTY]*)
-                |> REWRITE_RULE [NOT_NIL_AND_LEMMA]
-  in def end
-
-val _ = (find_def_for_const := def_of_const);
-
-val _ = use_long_names:=true;
-
-(* ------------------------------------------------------------------------- *)
-(* flat_to_pat                                                               *)
-(* ------------------------------------------------------------------------- *)
-
-val res = translate flat_to_patTheory.compile_def;
-
-(* ------------------------------------------------------------------------- *)
-
-val () = Feedback.set_trace "TheoryPP.include_docs" 0;
-val _ = ml_translatorLib.ml_prog_update (ml_progLib.close_module NONE);
-val _ = ml_translatorLib.clean_on_exit := true;
-val _ = export_theory ();
diff --git a/compiler/compilationLib.sml b/compiler/compilationLib.sml
index 651a676e35..4b8144c52d 100644
--- a/compiler/compilationLib.sml
+++ b/compiler/compilationLib.sml
@@ -47,6 +47,7 @@ fun compile_to_data cs conf_def prog_def data_prog_name =
     val prog_tm = lhs(concl prog_def)
 
     val to_flat_thm0 = timez "to_flat" eval ``to_flat ^conf_tm ^prog_tm``;
+
     val (c,p) = to_flat_thm0 |> rconc |> dest_pair
     val flat_conf_def = zDefine`flat_conf = ^c`;
     val flat_prog_def = zDefine`flat_prog = ^p`;
@@ -68,25 +69,10 @@ fun compile_to_data cs conf_def prog_def data_prog_name =
       ``flat_conf.bvl_conf``
       |> (RAND_CONV(REWR_CONV flat_conf_def) THENC eval)
 
-    val to_pat_thm0 =
-      ``to_pat ^conf_tm ^prog_tm``
-      |> (REWR_CONV to_pat_def THENC
-          RAND_CONV (REWR_CONV to_flat_thm) THENC
-          REWR_CONV LET_THM THENC
-          PAIRED_BETA_CONV)
-      |> timez "to_pat" (CONV_RULE(RAND_CONV(RAND_CONV eval)))
-      |> CONV_RULE(RAND_CONV(REWR_CONV_BETA LET_THM))
-    val (_,p) = to_pat_thm0 |> rconc |> dest_pair
-    val pat_prog_def = zDefine`pat_prog = ^p`;
-    val to_pat_thm =
-      to_pat_thm0 |> CONV_RULE(RAND_CONV(
-        RAND_CONV(REWR_CONV(SYM pat_prog_def))));
-    val () = computeLib.extend_compset [computeLib.Defs [pat_prog_def]] cs;
-
     val to_clos_thm0 =
       ``to_clos ^conf_tm ^prog_tm``
       |> (REWR_CONV to_clos_def THENC
-          RAND_CONV (REWR_CONV to_pat_thm) THENC
+          RAND_CONV (REWR_CONV to_flat_thm) THENC
           REWR_CONV LET_THM THENC
           PAIRED_BETA_CONV)
       |> timez "to_clos" (CONV_RULE(RAND_CONV(RAND_CONV eval)))
@@ -162,7 +148,7 @@ fun compile_to_data cs conf_def prog_def data_prog_name =
     val () = computeLib.extend_compset [computeLib.Defs [data_prog_def]] cs;
 
     val () = app delete_const
-      ["flat_prog","pat_prog","clos_prog","bvl_prog","bvi_prog"]
+      ["flat_prog","clos_prog","bvl_prog","bvi_prog"]
   in to_data_thm end
 
 fun compile_to_lab data_prog_def to_data_thm lab_prog_name =
@@ -442,7 +428,7 @@ fun compile_to_lab data_prog_def to_data_thm lab_prog_name =
           String.concat[Int.toString n,if n mod 10 = 0 then "\n" else " "]
         *)
         fun el_conv _ =
-          case !next_thm of th :: rest =>
+          case !next_thm of [] => fail() | th :: rest =>
             let
               val () = next_thm := rest
               (*
diff --git a/compiler/compilerScript.sml b/compiler/compilerScript.sml
index 38b0cd735b..6b748f21b3 100644
--- a/compiler/compilerScript.sml
+++ b/compiler/compilerScript.sml
@@ -460,16 +460,20 @@ val format_compiler_result_def = Define`
     (Success ((bytes:word8 list),(data:'a word list),(c:'a backend$config))) =
     (bytes_export (the [] c.lab_conf.ffi_names) heap stack bytes data, implode "")`;
 
+val Appends_def = Define`
+  Appends [] = List [] /\
+  Appends (x :: xs) = Append x (Appends xs)`;
+
 (* FIXME TODO: this is an awful workaround to avoid implementing a file writer
    right now. *)
 val add_tap_output_def = Define`
   add_tap_output td out = if NULL td then out
-    else Append (List (strlit "compiler output with tap data\n\n"
-      :: FLAT (MAP (\td. let (nm, data) = tap_data_strings td in
-        [strlit "-- "; nm; strlit " --\n\n"; data;
-          strlit "\n\n"]) td)
-      ++ [strlit "-- compiled data --\n\n"]))
-      out`;
+    else Appends (List [strlit "compiler output with tap data\n\n"]
+      :: FLAT (MAP (\td. let (nm, data) = tap_data_mlstrings td in
+          [List [strlit "-- "; nm; strlit " --\n\n"]; data;
+            List [strlit "\n\n"]])
+        td)
+      ++ [List [strlit "-- compiled data --\n\n"]; out])`;
 
 (* The top-level compiler with everything instantiated except it doesn't do exporting *)
 
diff --git a/examples/cost/README.md b/examples/cost/README.md
index a9b2c1d0d9..7e3f4ed33f 100644
--- a/examples/cost/README.md
+++ b/examples/cost/README.md
@@ -10,16 +10,25 @@ Proofs about `size_of` and `size_of_heap`
 A data-cost example of a non-terminating function (cyes)
 that prints a character indefinitely
 
+[cyesProofScript.sml](cyesProofScript.sml):
+Prove that cyes never exits prematurely.
+
 [miniBasisProgScript.sml](miniBasisProgScript.sml):
 Explicit construction of mini-basis, to support CF reasoning.
 
 [pureLoopProgScript.sml](pureLoopProgScript.sml):
 A data-cost example of a non-terminating function (pureLoop)
 
+[pureLoopProofScript.sml](pureLoopProofScript.sml):
+Prove that pureLoop never exits prematurely.
+
 [yesProgScript.sml](yesProgScript.sml):
 A data-cost example of a non-terminating function (cyes)
 that prints a character indefinitely
 
+[yesProofScript.sml](yesProofScript.sml):
+Prove that yes never exits prematurely.
+
 [yes_ffi.c](yes_ffi.c):
 Implements the foreign function interface (FFI) used in the yes program,
 as a thin wrapper around the relevant system calls.
diff --git a/examples/cost/cyesProgScript.sml b/examples/cost/cyesProgScript.sml
index 73ec978fe1..79638b21de 100644
--- a/examples/cost/cyesProgScript.sml
+++ b/examples/cost/cyesProgScript.sml
@@ -1,7 +1,6 @@
 (*
   A data-cost example of a non-terminating function (cyes)
   that prints a character indefinitely
-
 *)
 
 open preamble basis compilationLib;
@@ -451,803 +450,30 @@ val cyes2 =
 
       val _ = printLoop #"a"`
   in (rhs o concl o EVAL) ``^whole_prog ++ ^prog``
-  end
+  end;
 
-val cyes2_thm = compile_to_data (compilation_compset())
+Theorem cyes2_thm = compile_to_data (compilation_compset())
                                x64_backend_config_def
                                (REFL cyes2)
-                               "cyes2_data_prog"
+                               "cyes2_data_prog";
 
-val cyes2_data_code_def       = definition"cyes2_data_prog_def"
+val cyes2_data_code_def       = definition"cyes2_data_prog_def";
 
 
-val _ = intermediate_prog_prefix := "cyes_"
-val cyes_thm = compile_x64 1000 1000 "cyes" (REFL cyes)
-val _ = intermediate_prog_prefix := ""
+val _ = intermediate_prog_prefix := "cyes_";
+Theorem cyes_thm = compile_x64 1000 1000 "cyes" (REFL cyes);
+val _ = intermediate_prog_prefix := "";
 
 val cyes_data_code_def       = definition"cyes_data_prog_def"
 val cyes_to_data_thm         = theorem"cyes_to_data_thm"
 val cyes_config_def          = definition"cyes_config_def"
 val cyes_x64_conf            = (rand o rator o lhs o concl) cyes_thm
-val cyes_to_data_updated_thm =
+Theorem cyes_to_data_updated_thm =
   MATCH_MP (GEN_ALL  to_data_change_config) cyes_to_data_thm
   |> ISPEC ((rand o rator o lhs o concl) cyes_thm)
-  |> SIMP_RULE (srw_ss()) []
-
-
-val f_diff = diff_codes cyes_data_code_def cyes2_data_code_def
-
-val (f11,f12) = hd f_diff
-val (f21,f22) = (hd o tl) f_diff
-
-Theorem data_safe_cyes_code:
-  ∀s ts smax sstack lsize.
-   s.safe_for_space ∧
-   wf s.refs ∧
-   (s.stack_frame_sizes = cyes_config.word_conf.stack_frame_size) ∧
-   (s.stack_max = SOME smax) ∧
-   (size_of_stack s.stack = SOME sstack) ∧
-   (s.locals_size = SOME lsize) ∧
-   (sstack + 103 < s.limits.stack_limit) ∧
-   (sstack + lsize + 100 < s.limits.stack_limit) ∧
-   (smax < s.limits.stack_limit) ∧
-   s.limits.arch_64_bit ∧
-   closed_ptrs (stack_to_vs s) s.refs ∧
-   size_of_heap s + 6 ≤ s.limits.heap_limit ∧
-   2 ≤ s.limits.length_limit ∧
-   (s.tstamps = SOME ts) ∧
-   0 < ts ∧
-   (lookup 0 s.locals = SOME (Number 97)) ∧
-   (s.code = fromAList cyes_data_prog)
-   ⇒ data_safe (evaluate ((SND o SND) ^f21, s))
-Proof
- let
-  val code_lookup   = mk_code_lookup
-                        `fromAList cyes_data_prog`
-                         cyes_data_code_def
-  val frame_lookup   = mk_frame_lookup
-                        `cyes_config.word_conf.stack_frame_size`
-                         cyes_config_def
-  val strip_assign  = mk_strip_assign code_lookup frame_lookup
-  val open_call     = mk_open_call code_lookup frame_lookup
-  val make_call     = mk_make_call open_call
-  val strip_call    = mk_strip_call open_call
-  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
-  val make_tailcall = mk_make_tailcall open_tailcall
-  in
-  measureInduct_on `^s.clock`
-  \\ fs [ to_shallow_thm
-        , to_shallow_def
-        , initial_state_def ]
-  \\ rw []
-  \\ strip_call
-  \\ `small_num s.limits.arch_64_bit 97` by (rw[] >> EVAL_TAC)
-  \\ `1 < 2 ** s.limits.length_limit`
-     by (irule LESS_TRANS \\ qexists_tac `s.limits.length_limit` \\ fs [])
-  (* Make safe_for_space sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe) _`
-  \\ `safe` by (fs [Abbr `safe`, size_of_stack_def,GREATER_DEF] \\ EVAL_TAC)
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 6))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  (* Useful simplification through the proof *)
-  \\ `toListA [] (inter s.locals (LS ())) = [Number 97]`
-     by (Cases_on `s.locals` \\ fs [lookup_def,inter_def,toListA_def])
-  (* strip_makespace *)
-  \\ qmatch_goalsub_abbrev_tac `bind _ rest_mkspc _`
-  \\ REWRITE_TAC [ bind_def, makespace_def, add_space_def]
-  \\ simp []
-  \\ eval_goalsub_tac ``dataSem$cut_env _ _`` \\ simp []
-  \\ Q.UNABBREV_TAC `rest_mkspc`
-  (* strip_assign *)
-  \\ `2 < 2 ** s.limits.length_limit`
-     by (Cases_on `s.limits.length_limit` \\ fs [])
-  \\ ntac 2 strip_assign
-  \\ strip_assign \\ fs []
-  \\ ntac 3 (strip_assign \\ fs [])
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  (* strip_call *)
-  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
-  \\ ONCE_REWRITE_TAC [bind_def]
-  \\ simp [ call_def     , find_code_def  , push_env_def
-          , get_vars_def , call_env_def   , dec_clock_def
-          , cut_env_def  , domain_def     , data_safe_def
-          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
-          , lookup_def   , domain_IS_SOME , frame_lookup
-          , code_lookup  , lookup_def     , domain_IS_SOME
-          , flush_state_def
-          , size_of_stack_frame_def]
-  (* Prove we are safe for space up to this point *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_stack_def]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [MAX_DEF,GREATER_DEF,libTheory.the_def]
-     \\ `n ≤ n'` by
-        (irule size_of_le_APPEND
-        \\ asm_exists_tac \\ fs []
-        \\ asm_exists_tac \\ fs [])
-     \\ irule LESS_EQ_TRANS \\ qexists_tac `n' + 3` \\ rw [])
-  \\ simp []
-  \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  (* strip_assign *)
-  \\ strip_assign
-  \\ make_if
-  \\ ntac 4 strip_assign
-  (* open_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  (* Prove we are safe for space up to this point *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ Cases_on `ts`
-     \\ fs [size_of_def,lookup_def,GREATER_DEF,libTheory.the_def
-           ,size_of_stack_def]
-     \\ `n1''''' ≤ n'` by
-        (irule size_of_le_APPEND
-        \\ asm_exists_tac \\ fs []
-        \\ asm_exists_tac \\ fs [])
-     \\ Cases_on `lookup (SUC n) seen1'''''` \\ fs [] \\ rveq \\ fs [])
-  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ Q.UNABBREV_TAC `rest_call2`
-  (* strip_assign *)
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
-  \\ ONCE_REWRITE_TAC [bind_def]
-  \\ simp [ call_def     , find_code_def  , push_env_def
-          , get_vars_def , call_env_def   , dec_clock_def
-          , cut_env_def  , domain_def     , data_safe_def
-          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
-          , lookup_def   , domain_IS_SOME , frame_lookup
-          , code_lookup  , lookup_def     , domain_IS_SOME
-          , flush_state_def
-          , size_of_stack_frame_def]
-  (* Prove we are safe for space up to this point *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ Cases_on `ts` \\ fs [size_of_def,lookup_def]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_Number_head,GREATER_DEF,libTheory.the_def
-           ,size_of_stack_def]
-     \\ rveq
-     \\ `n1''' ≤ n'` by
-        (irule size_of_le_APPEND
-        \\ asm_exists_tac \\ fs []
-        \\ asm_exists_tac \\ fs [])
-     \\ Cases_on `lookup (SUC n) seen1'''` \\ fs [])
-  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 12))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  (* strip_assign *)
-  \\ strip_assign
-  \\ make_if
-  \\ ntac 3 strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 97 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 97` \\ rw [])
-  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
-  \\ ntac 4 strip_assign
-  (* make_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  \\ fs [insert_shadow]
-  \\ qmatch_goalsub_abbrev_tac `insert p1 _ s.refs`
-  \\ `lookup p1 s.refs = NONE` by
-     (Q.UNABBREV_TAC `p1` \\ fs [least_from_def]
-     \\ EVERY_CASE_TAC \\ fs [] \\ numLib.LEAST_ELIM_TAC
-     >- metis_tac []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-     \\ rw [] \\ pop_assum (qspec_then `domain s.refs` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup]
-     \\ Cases_on `lookup x s.refs` \\ fs []
-     \\ asm_exists_tac \\ fs [])
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  (* Prove we are safe for space up to this point *)
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ rw[small_num_def]
-     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
-     \\ rw[small_num_def]
-     \\ qmatch_asmsub_abbrev_tac `closed_ptrs (a ++ b ++ c)`
-     \\ `closed_ptrs (b ++ c) s.refs` by fs [closed_ptrs_APPEND]
-     (* \\ map_every  Q.UNABBREV_TAC [`a`,`b`,`c`] *)
-     \\ drule size_of_insert \\ disch_then drule
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
-     \\ qmatch_asmsub_abbrev_tac `insert p1 x s.refs`
-     \\ Cases_on `size_of s.limits (b ++ c) s.refs LN` \\ Cases_on `r`
-     \\ disch_then drule \\ fs []
-     \\ disch_then (qspec_then `x` assume_tac)
-     \\ fs [] \\ rveq \\ rfs []
-     \\ Q.UNABBREV_TAC `x`
-     \\ fs [] \\ rveq \\ fs [small_num_def]
-     \\ `n1''' ≤ n'` by
-        (irule size_of_le_APPEND
-        \\ pop_assum kall_tac
-        \\ asm_exists_tac \\ fs []
-        \\ asm_exists_tac \\ fs [])
-     \\ fs [])
-  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 12))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ Q.UNABBREV_TAC `rest_call2`
-  \\ strip_assign
-  \\ strip_assign
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ qmatch_goalsub_abbrev_tac `insert p2 _ (insert p1 _ s.refs)`
-  \\ strip_assign
-  \\ fs [lookup_insert]
-  \\ `p1 ≠ p2` by
-     (rw [Abbr `p2`,least_from_def]
-     >- (CCONTR_TAC \\ fs [])
-     >- (numLib.LEAST_ELIM_TAC \\ rw []
-        \\ Cases_on `ptr = p1` \\ fs []
-        \\ qexists_tac `ptr` \\ fs [])
-     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-     \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
-     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ fs []
-  \\ `lookup p2 (insert p1 (ByteArray T [97w]) s.refs) = NONE` by
-     (fs [lookup_insert]
-     \\ rw [Abbr `p2`, least_from_def]
-     >- (Cases_on `p1 = 0` \\ fs [])
-     >- (numLib.LEAST_ELIM_TAC \\ rw []
-        \\ Cases_on `ptr = p1` \\ fs []
-        \\ qexists_tac `ptr` \\ fs [])
-     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-     \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
-     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `wf (insert p1 (ByteArray T [97w]) s.refs)` by fs [wf_insert]
-  (* Prove we are safe for space up to this point *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
-     \\ qmatch_asmsub_abbrev_tac `closed_ptrs (a ++ b ++ c)`
-     \\ qmatch_asmsub_abbrev_tac `insert p1 x s.refs`
-     \\ qmatch_asmsub_abbrev_tac `insert p2 y (insert p1 x s.refs)`
-     \\ rveq \\ fs []
-     \\ drule size_of_insert
-     \\ disch_then (qspecl_then
-          [`s.limits`,`b ++ c`,`LN`,`p2`,`y`,`n1''`,`refs1''`,`seen1''`] mp_tac)
-     \\ impl_tac
-     >- (fs [closed_ptrs_APPEND] \\ rw []
-        \\ ho_match_mp_tac closed_ptrs_insert \\ fs []
-        \\ Q.UNABBREV_TAC `x` \\ ho_match_mp_tac closed_ptrs_refs_insert
-        \\ fs [closed_ptrs_def])
-     \\ rw [] \\ fs []
-     \\ (qpat_x_assum `wf (insert _ _ _)` kall_tac
-        \\ drule size_of_insert
-        \\ Cases_on `size_of s.limits (b ++ c) s.refs LN` \\ Cases_on `r`
-        \\ qmatch_asmsub_rename_tac `size_of s.limits (b ++ c) s.refs LN = (n8,refs8,seen8)`
-        \\ disch_then (qspecl_then [`s.limits`,`b ++ c`,`LN`,`p1`,`x`,`n8`,`refs8`,`seen8`] mp_tac)
-        \\ impl_tac
-        >- fs [closed_ptrs_APPEND]
-        \\ rw [] \\ Cases_on `lookup ts seen1'` \\ fs [] \\ rveq
-        \\ map_every Q.UNABBREV_TAC [`x`,`y`] \\ fs [] \\ rveq
-        \\ fs [lookup_delete,lookup_insert] \\ rfs [] \\ rveq \\ fs []
-        \\ rw[arch_size_def]
-        \\ `n1' ≤ n''` suffices_by fs []
-        \\ ho_match_mp_tac size_of_le_APPEND
-        \\ map_every qexists_tac [`a`,`b ++ c`] \\ fs []
-        \\ asm_exists_tac \\ fs []))
-  \\ simp[] \\ ntac 2 (pop_assum kall_tac) \\ fs []
-  \\ reverse (Cases_on `call_FFI s.ffi "put_char" [97w] []` \\ fs [])
-  >- (fs [data_safe_def,GREATER_DEF,libTheory.the_def,size_of_stack_def]
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ rw[arch_size_def]
-     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
-     \\ qmatch_asmsub_abbrev_tac `closed_ptrs (a ++ b ++ c)`
-     \\ qmatch_asmsub_abbrev_tac `insert p1 x s.refs`
-     \\ rveq \\ fs []
-     \\ qpat_x_assum `wf (insert _ _ _)` kall_tac
-     \\ drule size_of_insert
-     \\ Cases_on `size_of s.limits (b ++ c) s.refs LN` \\ Cases_on `r`
-     \\ qmatch_asmsub_rename_tac `size_of s.limits (b ++ c) s.refs LN = (n8,refs8,seen8)`
-     \\ disch_then (qspecl_then
-          [`s.limits`,`b ++ c`,`LN`,`p1`,`x`,`n8`,`refs8`,`seen8`] mp_tac)
-     \\ fs [closed_ptrs_APPEND]
-     \\ rw [] \\ fs []
-     \\ Q.UNABBREV_TAC `x` \\ fs [] \\ rveq
-     \\ `n1 ≤ n'` suffices_by fs []
-     \\ ho_match_mp_tac size_of_le_APPEND
-     \\ map_every qexists_tac [`a`,`b ++ c`] \\ fs []
-     \\ asm_exists_tac \\ fs [])
-  \\ strip_assign \\ strip_assign
-  \\ simp [return_def,lookup_def,data_safe_def]
-  \\ rpt (pairarg_tac \\ fs [])
-  \\ rfs [insert_shadow,size_of_Number_head]
-  \\ Q.UNABBREV_TAC `rest_call`
-  \\ rveq \\ fs [flush_state_def]
-  (* strip tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def ]
-  \\ simp [code_lookup,lookup_def,lookup_insert,lookup_inter,frame_lookup]
-  \\ IF_CASES_TAC
-  >- fs [data_safe_def,GREATER_DEF,libTheory.the_def,size_of_stack_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ ho_match_mp_tac data_safe_res
-  \\ reverse conj_tac >- (rw [] \\ pairarg_tac \\ rw [])
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 12))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ qmatch_goalsub_abbrev_tac `data_safe (_ s0)`
-  \\ first_x_assum (qspec_then `s0` assume_tac)
-  \\ `s0.clock < s.clock` by (UNABBREV_ALL_TAC \\ rw [])
-  \\ first_x_assum (drule_then irule) \\ Q.UNABBREV_TAC `s0` \\  fs []
-  \\ simp [ size_of_heap_def,size_of_Number_head,stack_to_vs_def
-          , lookup_def,toList_def,toListA_def
-          , wf_insert, wf_delete ]
-  \\ rw []
-  >- fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
-  >- fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
-  >- (pairarg_tac \\ fs []
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
-     \\ qmatch_asmsub_abbrev_tac `closed_ptrs (a ++ b ++ c)`
-     \\ qmatch_asmsub_abbrev_tac `insert p1 x s.refs`
-     \\ qmatch_asmsub_abbrev_tac `insert p2 y (insert p1 x s.refs)`
-     \\ rveq \\ fs []
-     \\ drule size_of_insert
-     \\ disch_then (qspecl_then
-          [`s.limits`,`b ++ c`,`LN`,`p2`,`y`,`n1''`,`refs1''`,`seen1''`] mp_tac)
-     \\ impl_tac
-     >- (fs [closed_ptrs_APPEND] \\ rw []
-        \\ ho_match_mp_tac closed_ptrs_insert \\ fs []
-        \\ Q.UNABBREV_TAC `x` \\ ho_match_mp_tac closed_ptrs_refs_insert
-        \\ fs [closed_ptrs_def])
-     \\ rw [] \\ fs [size_of_def]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq \\ fs [size_of_Number_head]
-     \\ qpat_x_assum `wf (insert _ _ _)` kall_tac
-     \\ drule size_of_insert
-     \\ qmatch_asmsub_rename_tac `size_of s.limits (b ++ c) s.refs LN = (n8,refs8,seen8)`
-     \\ disch_then (qspecl_then [`s.limits`,`b ++ c`,`LN`,`p1`,`x`,`n8`,`refs8`,`seen8`] mp_tac)
-     \\ impl_tac >- fs [closed_ptrs_APPEND]
-     \\ rveq \\ rw [] \\ Cases_on `lookup ts _` \\ fs [] \\ rveq
-     \\ map_every Q.UNABBREV_TAC [`x`,`y`] \\ fs [] \\ rveq
-     \\ fs [lookup_delete,lookup_insert] \\ rfs [] \\ rveq \\ fs []
-     \\ `n' ≤ n''` suffices_by fs []
-     \\ ho_match_mp_tac size_of_le_APPEND
-     \\ map_every qexists_tac [`a`,`b ++ c`] \\ fs []
-     \\ asm_exists_tac \\ fs [])
-   \\ ho_match_mp_tac closed_ptrs_insert
-   \\ fs [] \\ reverse conj_tac
-   >- (ho_match_mp_tac closed_ptrs_refs_insert \\ fs []
-      \\ ho_match_mp_tac closed_ptrs_refs_insert \\ fs []
-      \\ fs [closed_ptrs_def])
-   \\ ho_match_mp_tac closed_ptrs_insert
-   \\ fs [] \\ reverse conj_tac
-   >- (ho_match_mp_tac closed_ptrs_refs_insert \\ fs [closed_ptrs_def])
-   \\ ONCE_REWRITE_TAC [closed_ptrs_cons]
-   \\ conj_tac >- fs [closed_ptrs_APPEND,stack_to_vs_def]
-   \\ fs [closed_ptrs_def,closed_ptrs_list_def]
-  end
-QED
-
-Theorem data_safe_cyes_code_shallow[local] =
-  data_safe_cyes_code |> simp_rule [to_shallow_thm,to_shallow_def]
-
-Theorem data_safe_cyes_code_abort:
- ∀s ts.
-   (lookup 0 s.locals = SOME (Number 97)) ∧
-   2 ≤ s.limits.length_limit ∧
-   (s.stack_frame_sizes = cyes_config.word_conf.stack_frame_size) ∧
-   s.limits.arch_64_bit ∧
-   (s.tstamps = SOME ts) ∧
-   (s.code = fromAList cyes_data_prog)
-   ⇒ ∃s' e. evaluate ((SND o SND) ^f21, s) =
-       (SOME (Rerr (Rabort e)),s')
-Proof
- let
-  val code_lookup   = mk_code_lookup
-                        `fromAList cyes_data_prog`
-                         cyes_data_code_def
-  val frame_lookup   = mk_frame_lookup
-                        `cyes_config.word_conf.stack_frame_size`
-                         cyes_config_def
-  val strip_assign  = mk_strip_assign code_lookup frame_lookup
-  val open_call     = mk_open_call code_lookup frame_lookup
-  val make_call     = mk_make_call open_call
-  val strip_call    = mk_strip_call open_call
-  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
-  val make_tailcall = mk_make_tailcall open_tailcall
- in
-  measureInduct_on `^s.clock`
-  \\ rw [to_shallow_def,to_shallow_thm]
-  \\ strip_call
-  \\ `(inter s.locals (LS ())) = LS (Number 97)`
-     by (Cases_on `s.locals` \\ fs [lookup_def,inter_def])
-  \\ strip_makespace
-  \\ ntac 6 strip_assign
-  \\ strip_call
-  \\ strip_assign
-  \\ make_if
-  \\ strip_assign
-  \\ strip_assign
-  \\ strip_assign
-  \\ strip_assign
-  (* strip_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  \\ IF_CASES_TAC
-  >- simp []
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ Q.UNABBREV_TAC `rest_call_1`
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
-  (* strip_call *)
-  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call_1 _`)
-  \\ ONCE_REWRITE_TAC [bind_def]
-  (* open_call *)
-  \\ simp [ call_def     , find_code_def  , push_env_def
-          , get_vars_def , call_env_def   , dec_clock_def
-          , cut_env_def  , domain_def     , data_safe_def
-          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
-          , lookup_def   , domain_IS_SOME , frame_lookup
-          , code_lookup  , lookup_def     , domain_IS_SOME
-          , lookup_insert, flush_state_def
-          , size_of_stack_frame_def]
-  \\ IF_CASES_TAC >- simp []
-  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ strip_assign
-  \\ strip_assign
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 97 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 97` \\ rw [])
-  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
-  \\ strip_assign
-  \\ strip_assign
-  \\ strip_assign
-  \\ strip_assign
-  (* strip_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup,lookup_inter]
-  \\ IF_CASES_TAC
-  >- simp []
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp[LET_THM]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ Q.UNABBREV_TAC `rest_call_1`
-  \\ ntac 3 strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
-  \\ fs [insert_shadow]
-  \\ qmatch_goalsub_abbrev_tac `insert p2 _ (insert p1 _ s.refs)`
-  \\ `lookup p1 s.refs = NONE` by
-     (Q.UNABBREV_TAC `p1` \\ fs [least_from_def]
-     \\ IF_CASES_TAC \\ fs []
-     \\ IF_CASES_TAC \\ fs []
-     >- (numLib.LEAST_ELIM_TAC \\ metis_tac [])
-     \\ numLib.LEAST_ELIM_TAC
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-     \\ rw [] \\ pop_assum (qspec_then `domain s.refs` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup]
-     \\ Cases_on `lookup x s.refs` \\ fs []
-     \\ asm_exists_tac \\ fs [])
-  \\ `p1 ≠ p2` by
-     (rw [Abbr `p2`,least_from_def]
-     >- (CCONTR_TAC \\ fs [])
-     >- (numLib.LEAST_ELIM_TAC \\ rw [] >- metis_tac []
-        \\ CCONTR_TAC \\ fs [lookup_insert])
-     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-     >- (mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-        \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
-        \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
-        \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-     \\ CCONTR_TAC \\ fs [lookup_insert])
-  \\ strip_assign \\ fs [lookup_insert]
-  \\ reverse (Cases_on `call_FFI s.ffi "put_char" [97w] []`) >- simp []
-  \\ strip_assign \\ strip_assign
-  \\ rw [return_def,lookup_def]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ Q.UNABBREV_TAC `rest_call`
-  (*  make_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def ]
-  \\ simp [code_lookup,lookup_def,lookup_insert,lookup_inter
-          ,frame_lookup]
-  \\ IF_CASES_TAC
-  >- simp []
-  \\ eval_goalsub_tac ``dataSem$call_env _ _``
-  \\ qmatch_goalsub_abbrev_tac `evaluate (p0,s0)`
-  \\ `s0.clock < s.clock` by fs [Abbr `s0`,dec_clock_def]
-  \\ first_x_assum (drule_then (qspec_then `ts + 1` mp_tac))
-  \\ impl_tac >- (fs [Abbr `s0`] \\ EVAL_TAC \\ fs [])
-  \\ rw [] \\ fs []
-  end
-QED
-
-Theorem data_safe_cyes_code_abort_shallow[local] =
-  data_safe_cyes_code_abort |> simp_rule [to_shallow_thm,to_shallow_def]
-
-Theorem data_safe_cyes:
- ∀ffi.
-  backend_config_ok ^cyes_x64_conf
-  ⇒ is_safe_for_space ffi
-      ^cyes_x64_conf
-      ^cyes
-      (1000,1000)
-Proof
- let
-  val code_lookup   = mk_code_lookup
-                        `fromAList cyes_data_prog`
-                         cyes_data_code_def
-  val frame_lookup   = mk_frame_lookup
-                        `cyes_config.word_conf.stack_frame_size`
-                         cyes_config_def
-  val strip_assign  = mk_strip_assign code_lookup frame_lookup
-  val open_call     = mk_open_call code_lookup frame_lookup
-  val make_call     = mk_make_call open_call
-  val strip_call    = mk_strip_call open_call
-  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
-  val make_tailcall = mk_make_tailcall open_tailcall
- in
- strip_tac \\ strip_tac
- \\ irule IMP_is_safe_for_space_alt \\ fs []
- \\ conj_tac >- EVAL_TAC
- \\ assume_tac cyes_thm
- \\ asm_exists_tac \\ fs []
- \\ assume_tac cyes_to_data_updated_thm
- \\ fs [data_lang_safe_for_space_def]
- \\ strip_tac
- \\ qmatch_goalsub_abbrev_tac `_ v0`
- \\ `data_safe v0` suffices_by
-    (Cases_on `v0` \\ fs [data_safe_def])
- \\ UNABBREV_ALL_TAC
- \\ qmatch_goalsub_abbrev_tac `is_64_bits c0`
- \\ `is_64_bits c0` by (UNABBREV_ALL_TAC \\ EVAL_TAC)
- \\ fs []
- \\ rpt (pop_assum kall_tac)
- (* start data_safe proof *)
- \\ REWRITE_TAC [ to_shallow_thm
-                , to_shallow_def
-                , initial_state_def
-                , bvl_to_bviTheory.InitGlobals_location_eq]
-  (* Make first call *)
- \\ rpt strip_tac
- \\ make_tailcall
- (* Bootcode *)
- \\ ntac 7 strip_assign
- \\ ho_match_mp_tac data_safe_bind_return
- (* Yet another call *)
- \\ make_call
- \\ strip_call
- \\ ntac 9 strip_assign
- \\ make_if
- \\ UNABBREV_ALL_TAC
- (* Continues after call *)
- \\ strip_makespace
- \\ ntac 49 strip_assign
- \\ make_tailcall
- \\ ntac 5
-    (strip_call
-    \\ ntac 9 strip_assign
-    \\ make_if
-    \\ UNABBREV_ALL_TAC)
-  \\ strip_call
-  \\ ntac 9 strip_assign
-  \\ make_if
-  \\ ntac 6 strip_assign
-  \\ ntac 6
-     (open_tailcall
-     \\ ntac 4 strip_assign
-     \\ make_if
-     \\ ntac 2 strip_assign)
-  \\ open_tailcall
-  \\ ntac 4 strip_assign
-  \\ make_if
-  \\ Q.UNABBREV_TAC `rest_call`
-  \\ ntac 3 strip_assign
-  \\ make_tailcall
-  \\ ntac 5
-     (strip_makespace
-     \\ ntac 7 strip_assign
-     \\ make_tailcall)
-  \\ strip_assign
-  \\ ho_match_mp_tac data_safe_bind_some
-  \\ open_call
-  \\ qmatch_goalsub_abbrev_tac `f (state_locals_fupd _ _)`
-  \\ qmatch_goalsub_abbrev_tac `f s`
-  \\ `∃s' e'. f s = (SOME (Rerr (Rabort e')),s')`
-     by (UNABBREV_ALL_TAC
-        \\ ho_match_mp_tac data_safe_cyes_code_abort_shallow
-        \\ fs [] \\ EVAL_TAC)
-  \\ `data_safe (f s)` suffices_by (rw [] \\ rfs [])
-  \\ unabbrev_all_tac
-  \\ ho_match_mp_tac data_safe_cyes_code_shallow
-  \\ rw [lookup_def,lookup_fromList,code_lookup]
-  \\ EVAL_TAC
-  \\ qexists_tac `10` \\ fs []
-  end
-QED
-
-Theorem cyes_x64_conf_def = mk_abbrev "cyes_x64_conf" cyes_x64_conf;
-Theorem cyes_s_def = mk_abbrev"cyes_s"
-                      ((rand o rand o rhs o concl) primSemEnvTheory.prim_sem_env_eq)
-
-Definition cyes_env_def:
-  cyes_env ffi = FST (THE (prim_sem_env sio_ffi_state))
-End
-
-Theorem prim_sem_env_cyes:
-  THE (prim_sem_env sio_ffi_state) = (cyes_env ffi,cyes_s)
-Proof
-EVAL_TAC \\ rw [cyes_s_def]
-QED
-
-Theorem backend_config_ok_cyes:
-  backend_config_ok cyes_x64_conf
-Proof
- assume_tac x64_backend_config_ok
- \\ fs [backend_config_ok_def,cyes_x64_conf_def,x64_backend_config_def]
-QED
-
-Theorem cyes_semantics_prog_not_Fail:
-  let (s,env) = THE (prim_sem_env sio_ffi_state)
-  in ¬semantics_prog s env cyes_prog Fail
-Proof
-  assume_tac cyes_semantics_prog_Diverge
-  \\ fs [] \\ pairarg_tac \\  fs []
-  \\ CCONTR_TAC \\ fs []
-  \\ drule semanticsPropsTheory.semantics_prog_deterministic
-  \\ pop_assum kall_tac
-  \\ disch_then drule
-  \\ fs []
-QED
-
-Theorem IMP_IMP_TRANS_THM:
-  ∀W P R Q. (W ⇒ Q) ⇒ (P ⇒ R ⇒ W) ⇒ P ⇒ R ⇒ Q
-Proof
- rw []
-QED
-
-Theorem machine_sem_eq_semantics_prog:
-semantics_prog s env prog (Diverge io_trace) ⇒
-  (machine_sem mc (ffi:'ffi ffi_state) ms = semantics_prog s env prog) ⇒
-     machine_sem mc ffi ms (Diverge io_trace)
-Proof
-  rw []
-QED
-
-Theorem machine_sem_eq_semantics_prog_ex:
-(∃io_trace. semantics_prog s env prog (Diverge io_trace)) ⇒
-  (machine_sem mc (ffi:'ffi ffi_state) ms = semantics_prog s env prog) ⇒
-     (∃io_trace. machine_sem mc ffi ms (Diverge io_trace))
-Proof
-  rw []
-QED
-
-val cyes_safe_thm =
-    let
-      val ffi = ``sio_ffi_state``
-      val is_safe = data_safe_cyes
-                    |> REWRITE_RULE [GSYM cyes_prog_def
-                                    ,GSYM cyes_x64_conf_def]
-                    |> ISPEC ffi
-      val not_fail = cyes_semantics_prog_not_Fail
-                     |> SIMP_RULE std_ss [LET_DEF,prim_sem_env_cyes
-                                         ,ELIM_UNCURRY]
-      val is_corr = MATCH_MP compile_correct_is_safe_for_space cyes_thm
-                    |> REWRITE_RULE [GSYM cyes_prog_def
-                                    ,GSYM cyes_x64_conf_def]
-                    |> Q.INST [`stack_limit` |-> `1000`
-                              ,`heap_limit` |-> `1000`]
-                    |> INST_TYPE [``:'ffi`` |-> ``:unit``]
-                    |> Q.INST [`ffi` |-> `sio_ffi_state`]
-                    |> SIMP_RULE std_ss [prim_sem_env_cyes,LET_DEF,not_fail,ELIM_UNCURRY]
-      val machine_eq = MATCH_MP (machine_sem_eq_semantics_prog |> INST_TYPE [``:'ffi`` |-> ``:unit``])
-                                (cyes_semantics_prog_Diverge
-                                   |> SIMP_RULE std_ss [LET_DEF,prim_sem_env_cyes,ELIM_UNCURRY])
-      val safe_thm_aux = MATCH_MP (IMP_TRANS is_safe is_corr) backend_config_ok_cyes
-    in MATCH_MP (MATCH_MP IMP_IMP_TRANS_THM machine_eq)
-                (safe_thm_aux |> SIMP_RULE std_ss [prim_sem_env_cyes,LET_DEF,ELIM_UNCURRY])
-    end
+  |> SIMP_RULE (srw_ss()) [];
 
-Theorem cyes_safe = cyes_safe_thm |> check_thm;
+Theorem cyes_data_code_def = cyes_data_code_def;
+Theorem cyes2_data_code_def = cyes2_data_code_def;
 
 val _ = export_theory();
diff --git a/examples/cost/cyesProofScript.sml b/examples/cost/cyesProofScript.sml
new file mode 100644
index 0000000000..99d617de6a
--- /dev/null
+++ b/examples/cost/cyesProofScript.sml
@@ -0,0 +1,797 @@
+(*
+  Prove that cyes never exits prematurely.
+*)
+
+open preamble basis compilationLib;
+open backendProofTheory backendPropsTheory
+open costLib costPropsTheory
+open dataSemTheory data_monadTheory dataLangTheory;
+open miniBasisProgTheory;
+open x64_configProofTheory;
+open cyesProgTheory;
+
+val _ = new_theory "cyesProof"
+
+Overload monad_unitbind[local] = ``data_monad$bind``
+Overload return[local] = ``data_monad$return``
+val _ = monadsyntax.temp_add_monadsyntax()
+
+val cyes_x64_conf = (rand o rator o lhs o concl) cyes_thm
+val cyes = cyes_prog_def |> concl |> rand
+
+val f_diff = diff_codes cyes_data_code_def cyes2_data_code_def;
+
+val (f11,f12) = hd f_diff;
+val (f21,f22) = (hd o tl) f_diff;
+
+Theorem data_safe_cyes_code:
+  ∀s ts smax sstack lsize.
+   s.safe_for_space ∧
+   wf s.refs ∧
+   (s.stack_frame_sizes = cyes_config.word_conf.stack_frame_size) ∧
+   (s.stack_max = SOME smax) ∧
+   (size_of_stack s.stack = SOME sstack) ∧
+   (s.locals_size = SOME lsize) ∧
+   (sstack + 103 < s.limits.stack_limit) ∧
+   (sstack + lsize + 100 < s.limits.stack_limit) ∧
+   (smax < s.limits.stack_limit) ∧
+   s.limits.arch_64_bit ∧
+   closed_ptrs (stack_to_vs s) s.refs ∧
+   size_of_heap s + 6 ≤ s.limits.heap_limit ∧
+   2 ≤ s.limits.length_limit ∧
+   (s.tstamps = SOME ts) ∧
+   0 < ts ∧
+   (lookup 0 s.locals = SOME (Number 97)) ∧
+   (s.code = fromAList cyes_data_prog)
+   ⇒ data_safe (evaluate ((SND o SND) ^f21, s))
+Proof
+ let
+  val code_lookup   = mk_code_lookup
+                        `fromAList cyes_data_prog`
+                         cyes_data_code_def
+  val frame_lookup   = mk_frame_lookup
+                        `cyes_config.word_conf.stack_frame_size`
+                         cyes_config_def
+  val strip_assign  = mk_strip_assign code_lookup frame_lookup
+  val open_call     = mk_open_call code_lookup frame_lookup
+  val make_call     = mk_make_call open_call
+  val strip_call    = mk_strip_call open_call
+  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
+  val make_tailcall = mk_make_tailcall open_tailcall
+  in
+  measureInduct_on `^s.clock`
+  \\ fs [ to_shallow_thm
+        , to_shallow_def
+        , initial_state_def ]
+  \\ rw []
+  \\ strip_call
+  \\ `small_num s.limits.arch_64_bit 97` by (rw[] >> EVAL_TAC)
+  \\ `1 < 2 ** s.limits.length_limit`
+     by (irule LESS_TRANS \\ qexists_tac `s.limits.length_limit` \\ fs [])
+  (* Make safe_for_space sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe) _`
+  \\ `safe` by (fs [Abbr `safe`, size_of_stack_def,GREATER_DEF] \\ EVAL_TAC)
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 6))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  (* Useful simplification through the proof *)
+  \\ `toListA [] (inter s.locals (LS ())) = [Number 97]`
+     by (Cases_on `s.locals` \\ fs [lookup_def,inter_def,toListA_def])
+  (* strip_makespace *)
+  \\ qmatch_goalsub_abbrev_tac `bind _ rest_mkspc _`
+  \\ REWRITE_TAC [ bind_def, makespace_def, add_space_def]
+  \\ simp []
+  \\ eval_goalsub_tac ``dataSem$cut_env _ _`` \\ simp []
+  \\ Q.UNABBREV_TAC `rest_mkspc`
+  (* strip_assign *)
+  \\ `2 < 2 ** s.limits.length_limit`
+     by (Cases_on `s.limits.length_limit` \\ fs [])
+  \\ ntac 2 strip_assign
+  \\ strip_assign \\ fs []
+  \\ ntac 3 (strip_assign \\ fs [])
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  (* strip_call *)
+  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
+  \\ ONCE_REWRITE_TAC [bind_def]
+  \\ simp [ call_def     , find_code_def  , push_env_def
+          , get_vars_def , call_env_def   , dec_clock_def
+          , cut_env_def  , domain_def     , data_safe_def
+          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
+          , lookup_def   , domain_IS_SOME , frame_lookup
+          , code_lookup  , lookup_def     , domain_IS_SOME
+          , flush_state_def
+          , size_of_stack_frame_def]
+  (* Prove we are safe for space up to this point *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_stack_def]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [MAX_DEF,GREATER_DEF,libTheory.the_def]
+     \\ `n ≤ n'` by
+        (irule size_of_le_APPEND
+        \\ asm_exists_tac \\ fs []
+        \\ asm_exists_tac \\ fs [])
+     \\ irule LESS_EQ_TRANS \\ qexists_tac `n' + 3` \\ rw [])
+  \\ simp []
+  \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  (* strip_assign *)
+  \\ strip_assign
+  \\ make_if
+  \\ ntac 4 strip_assign
+  (* open_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  (* Prove we are safe for space up to this point *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ Cases_on `ts`
+     \\ fs [size_of_def,lookup_def,GREATER_DEF,libTheory.the_def
+           ,size_of_stack_def]
+     \\ `n1''''' ≤ n'` by
+        (irule size_of_le_APPEND
+        \\ asm_exists_tac \\ fs []
+        \\ asm_exists_tac \\ fs [])
+     \\ Cases_on `lookup (SUC n) seen1'''''` \\ fs [] \\ rveq \\ fs [])
+  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ Q.UNABBREV_TAC `rest_call2`
+  (* strip_assign *)
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
+  \\ ONCE_REWRITE_TAC [bind_def]
+  \\ simp [ call_def     , find_code_def  , push_env_def
+          , get_vars_def , call_env_def   , dec_clock_def
+          , cut_env_def  , domain_def     , data_safe_def
+          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
+          , lookup_def   , domain_IS_SOME , frame_lookup
+          , code_lookup  , lookup_def     , domain_IS_SOME
+          , flush_state_def
+          , size_of_stack_frame_def]
+  (* Prove we are safe for space up to this point *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ Cases_on `ts` \\ fs [size_of_def,lookup_def]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_Number_head,GREATER_DEF,libTheory.the_def
+           ,size_of_stack_def]
+     \\ rveq
+     \\ `n1''' ≤ n'` by
+        (irule size_of_le_APPEND
+        \\ asm_exists_tac \\ fs []
+        \\ asm_exists_tac \\ fs [])
+     \\ Cases_on `lookup (SUC n) seen1'''` \\ fs [])
+  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 12))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  (* strip_assign *)
+  \\ strip_assign
+  \\ make_if
+  \\ ntac 3 strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 97 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 97` \\ rw [])
+  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
+  \\ ntac 4 strip_assign
+  (* make_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  \\ fs [insert_shadow]
+  \\ qmatch_goalsub_abbrev_tac `insert p1 _ s.refs`
+  \\ `lookup p1 s.refs = NONE` by
+     (Q.UNABBREV_TAC `p1` \\ fs [least_from_def]
+     \\ EVERY_CASE_TAC \\ fs [] \\ numLib.LEAST_ELIM_TAC
+     >- metis_tac []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+     \\ rw [] \\ pop_assum (qspec_then `domain s.refs` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup]
+     \\ Cases_on `lookup x s.refs` \\ fs []
+     \\ asm_exists_tac \\ fs [])
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  (* Prove we are safe for space up to this point *)
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ rw[small_num_def]
+     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
+     \\ rw[small_num_def]
+     \\ qmatch_asmsub_abbrev_tac `closed_ptrs (a ++ b ++ c)`
+     \\ `closed_ptrs (b ++ c) s.refs` by fs [closed_ptrs_APPEND]
+     (* \\ map_every  Q.UNABBREV_TAC [`a`,`b`,`c`] *)
+     \\ drule size_of_insert \\ disch_then drule
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
+     \\ qmatch_asmsub_abbrev_tac `insert p1 x s.refs`
+     \\ Cases_on `size_of s.limits (b ++ c) s.refs LN` \\ Cases_on `r`
+     \\ disch_then drule \\ fs []
+     \\ disch_then (qspec_then `x` assume_tac)
+     \\ fs [] \\ rveq \\ rfs []
+     \\ Q.UNABBREV_TAC `x`
+     \\ fs [] \\ rveq \\ fs [small_num_def]
+     \\ `n1''' ≤ n'` by
+        (irule size_of_le_APPEND
+        \\ pop_assum kall_tac
+        \\ asm_exists_tac \\ fs []
+        \\ asm_exists_tac \\ fs [])
+     \\ fs [])
+  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 12))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ Q.UNABBREV_TAC `rest_call2`
+  \\ strip_assign
+  \\ strip_assign
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ qmatch_goalsub_abbrev_tac `insert p2 _ (insert p1 _ s.refs)`
+  \\ strip_assign
+  \\ fs [lookup_insert]
+  \\ `p1 ≠ p2` by
+     (rw [Abbr `p2`,least_from_def]
+     >- (CCONTR_TAC \\ fs [])
+     >- (numLib.LEAST_ELIM_TAC \\ rw []
+        \\ Cases_on `ptr = p1` \\ fs []
+        \\ qexists_tac `ptr` \\ fs [])
+     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+     \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
+     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ fs []
+  \\ `lookup p2 (insert p1 (ByteArray T [97w]) s.refs) = NONE` by
+     (fs [lookup_insert]
+     \\ rw [Abbr `p2`, least_from_def]
+     >- (Cases_on `p1 = 0` \\ fs [])
+     >- (numLib.LEAST_ELIM_TAC \\ rw []
+        \\ Cases_on `ptr = p1` \\ fs []
+        \\ qexists_tac `ptr` \\ fs [])
+     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+     \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
+     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `wf (insert p1 (ByteArray T [97w]) s.refs)` by fs [wf_insert]
+  (* Prove we are safe for space up to this point *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
+     \\ qmatch_asmsub_abbrev_tac `closed_ptrs (a ++ b ++ c)`
+     \\ qmatch_asmsub_abbrev_tac `insert p1 x s.refs`
+     \\ qmatch_asmsub_abbrev_tac `insert p2 y (insert p1 x s.refs)`
+     \\ rveq \\ fs []
+     \\ drule size_of_insert
+     \\ disch_then (qspecl_then
+          [`s.limits`,`b ++ c`,`LN`,`p2`,`y`,`n1''`,`refs1''`,`seen1''`] mp_tac)
+     \\ impl_tac
+     >- (fs [closed_ptrs_APPEND] \\ rw []
+        \\ ho_match_mp_tac closed_ptrs_insert \\ fs []
+        \\ Q.UNABBREV_TAC `x` \\ ho_match_mp_tac closed_ptrs_refs_insert
+        \\ fs [closed_ptrs_def])
+     \\ rw [] \\ fs []
+     \\ (qpat_x_assum `wf (insert _ _ _)` kall_tac
+        \\ drule size_of_insert
+        \\ Cases_on `size_of s.limits (b ++ c) s.refs LN` \\ Cases_on `r`
+        \\ qmatch_asmsub_rename_tac `size_of s.limits (b ++ c) s.refs LN = (n8,refs8,seen8)`
+        \\ disch_then (qspecl_then [`s.limits`,`b ++ c`,`LN`,`p1`,`x`,`n8`,`refs8`,`seen8`] mp_tac)
+        \\ impl_tac
+        >- fs [closed_ptrs_APPEND]
+        \\ rw [] \\ Cases_on `lookup ts seen1'` \\ fs [] \\ rveq
+        \\ map_every Q.UNABBREV_TAC [`x`,`y`] \\ fs [] \\ rveq
+        \\ fs [lookup_delete,lookup_insert] \\ rfs [] \\ rveq \\ fs []
+        \\ rw[arch_size_def]
+        \\ `n1' ≤ n''` suffices_by fs []
+        \\ ho_match_mp_tac size_of_le_APPEND
+        \\ map_every qexists_tac [`a`,`b ++ c`] \\ fs []
+        \\ asm_exists_tac \\ fs []))
+  \\ simp[] \\ ntac 2 (pop_assum kall_tac) \\ fs []
+  \\ reverse (Cases_on `call_FFI s.ffi "put_char" [97w] []` \\ fs [])
+  >- (fs [data_safe_def,GREATER_DEF,libTheory.the_def,size_of_stack_def]
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ rw[arch_size_def]
+     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
+     \\ qmatch_asmsub_abbrev_tac `closed_ptrs (a ++ b ++ c)`
+     \\ qmatch_asmsub_abbrev_tac `insert p1 x s.refs`
+     \\ rveq \\ fs []
+     \\ qpat_x_assum `wf (insert _ _ _)` kall_tac
+     \\ drule size_of_insert
+     \\ Cases_on `size_of s.limits (b ++ c) s.refs LN` \\ Cases_on `r`
+     \\ qmatch_asmsub_rename_tac `size_of s.limits (b ++ c) s.refs LN = (n8,refs8,seen8)`
+     \\ disch_then (qspecl_then
+          [`s.limits`,`b ++ c`,`LN`,`p1`,`x`,`n8`,`refs8`,`seen8`] mp_tac)
+     \\ fs [closed_ptrs_APPEND]
+     \\ rw [] \\ fs []
+     \\ Q.UNABBREV_TAC `x` \\ fs [] \\ rveq
+     \\ `n1 ≤ n'` suffices_by fs []
+     \\ ho_match_mp_tac size_of_le_APPEND
+     \\ map_every qexists_tac [`a`,`b ++ c`] \\ fs []
+     \\ asm_exists_tac \\ fs [])
+  \\ strip_assign
+  \\ simp [return_def,lookup_def,data_safe_def]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rfs [insert_shadow,size_of_Number_head]
+  \\ Q.UNABBREV_TAC `rest_call`
+  \\ rveq \\ fs [flush_state_def]
+  (* strip tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def ]
+  \\ simp [code_lookup,lookup_def,lookup_insert,lookup_inter,frame_lookup]
+  \\ IF_CASES_TAC
+  >- fs [data_safe_def,GREATER_DEF,libTheory.the_def,size_of_stack_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ ho_match_mp_tac data_safe_res
+  \\ reverse conj_tac >- (rw [] \\ pairarg_tac \\ rw [])
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 12))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ qmatch_goalsub_abbrev_tac `data_safe (_ s0)`
+  \\ first_x_assum (qspec_then `s0` assume_tac)
+  \\ `s0.clock < s.clock` by (UNABBREV_ALL_TAC \\ rw [])
+  \\ first_x_assum (drule_then irule) \\ Q.UNABBREV_TAC `s0` \\  fs []
+  \\ simp [ size_of_heap_def,size_of_Number_head,stack_to_vs_def
+          , lookup_def,toList_def,toListA_def
+          , wf_insert, wf_delete ]
+  \\ rw []
+  >- fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
+  >- fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
+  >- (pairarg_tac \\ fs []
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
+     \\ qmatch_asmsub_abbrev_tac `closed_ptrs (a ++ b ++ c)`
+     \\ qmatch_asmsub_abbrev_tac `insert p1 x s.refs`
+     \\ qmatch_asmsub_abbrev_tac `insert p2 y (insert p1 x s.refs)`
+     \\ rveq \\ fs []
+     \\ drule size_of_insert
+     \\ disch_then (qspecl_then
+          [`s.limits`,`b ++ c`,`LN`,`p2`,`y`,`n1''`,`refs1''`,`seen1''`] mp_tac)
+     \\ impl_tac
+     >- (fs [closed_ptrs_APPEND] \\ rw []
+        \\ ho_match_mp_tac closed_ptrs_insert \\ fs []
+        \\ Q.UNABBREV_TAC `x` \\ ho_match_mp_tac closed_ptrs_refs_insert
+        \\ fs [closed_ptrs_def])
+     \\ rw [] \\ fs [size_of_def]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq \\ fs [size_of_Number_head]
+     \\ qpat_x_assum `wf (insert _ _ _)` kall_tac
+     \\ drule size_of_insert
+     \\ qmatch_asmsub_rename_tac `size_of s.limits (b ++ c) s.refs LN = (n8,refs8,seen8)`
+     \\ disch_then (qspecl_then [`s.limits`,`b ++ c`,`LN`,`p1`,`x`,`n8`,`refs8`,`seen8`] mp_tac)
+     \\ impl_tac >- fs [closed_ptrs_APPEND]
+     \\ rveq \\ rw [] \\ Cases_on `lookup ts _` \\ fs [] \\ rveq
+     \\ map_every Q.UNABBREV_TAC [`x`,`y`] \\ fs [] \\ rveq
+     \\ fs [lookup_delete,lookup_insert] \\ rfs [] \\ rveq \\ fs []
+     \\ `n' ≤ n''` suffices_by fs []
+     \\ ho_match_mp_tac size_of_le_APPEND
+     \\ map_every qexists_tac [`a`,`b ++ c`] \\ fs []
+     \\ asm_exists_tac \\ fs [])
+   \\ ho_match_mp_tac closed_ptrs_insert
+   \\ fs [] \\ reverse conj_tac
+   >- (ho_match_mp_tac closed_ptrs_refs_insert \\ fs []
+      \\ ho_match_mp_tac closed_ptrs_refs_insert \\ fs []
+      \\ fs [closed_ptrs_def])
+   \\ ho_match_mp_tac closed_ptrs_insert
+   \\ fs [] \\ reverse conj_tac
+   >- (ho_match_mp_tac closed_ptrs_refs_insert \\ fs [closed_ptrs_def])
+   \\ ONCE_REWRITE_TAC [closed_ptrs_cons]
+   \\ conj_tac >- fs [closed_ptrs_APPEND,stack_to_vs_def]
+   \\ fs [closed_ptrs_def,closed_ptrs_list_def]
+  end
+QED
+
+Theorem data_safe_cyes_code_shallow[local] =
+  data_safe_cyes_code |> simp_rule [to_shallow_thm,to_shallow_def];
+
+Theorem data_safe_cyes_code_abort:
+ ∀s ts.
+   (lookup 0 s.locals = SOME (Number 97)) ∧
+   2 ≤ s.limits.length_limit ∧
+   (s.stack_frame_sizes = cyes_config.word_conf.stack_frame_size) ∧
+   s.limits.arch_64_bit ∧
+   (s.tstamps = SOME ts) ∧
+   (s.code = fromAList cyes_data_prog)
+   ⇒ ∃s' e. evaluate ((SND o SND) ^f21, s) =
+       (SOME (Rerr (Rabort e)),s')
+Proof
+ let
+  val code_lookup   = mk_code_lookup
+                        `fromAList cyes_data_prog`
+                         cyes_data_code_def
+  val frame_lookup   = mk_frame_lookup
+                        `cyes_config.word_conf.stack_frame_size`
+                         cyes_config_def
+  val strip_assign  = mk_strip_assign code_lookup frame_lookup
+  val open_call     = mk_open_call code_lookup frame_lookup
+  val make_call     = mk_make_call open_call
+  val strip_call    = mk_strip_call open_call
+  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
+  val make_tailcall = mk_make_tailcall open_tailcall
+ in
+  measureInduct_on `^s.clock`
+  \\ rw [to_shallow_def,to_shallow_thm]
+  \\ strip_call
+  \\ `(inter s.locals (LS ())) = LS (Number 97)`
+     by (Cases_on `s.locals` \\ fs [lookup_def,inter_def])
+  \\ strip_makespace
+  \\ ntac 6 strip_assign
+  \\ strip_call
+  \\ strip_assign
+  \\ make_if
+  \\ strip_assign
+  \\ strip_assign
+  \\ strip_assign
+  \\ strip_assign
+  (* strip_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  \\ IF_CASES_TAC
+  >- simp []
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ Q.UNABBREV_TAC `rest_call_1`
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
+  (* strip_call *)
+  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call_1 _`)
+  \\ ONCE_REWRITE_TAC [bind_def]
+  (* open_call *)
+  \\ simp [ call_def     , find_code_def  , push_env_def
+          , get_vars_def , call_env_def   , dec_clock_def
+          , cut_env_def  , domain_def     , data_safe_def
+          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
+          , lookup_def   , domain_IS_SOME , frame_lookup
+          , code_lookup  , lookup_def     , domain_IS_SOME
+          , lookup_insert, flush_state_def
+          , size_of_stack_frame_def]
+  \\ IF_CASES_TAC >- simp []
+  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ strip_assign
+  \\ strip_assign
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 97 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 97` \\ rw [])
+  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
+  \\ strip_assign
+  \\ strip_assign
+  \\ strip_assign
+  \\ strip_assign
+  (* strip_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup,lookup_inter]
+  \\ IF_CASES_TAC
+  >- simp []
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp[LET_THM]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ Q.UNABBREV_TAC `rest_call_1`
+  \\ ntac 3 strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
+  \\ fs [insert_shadow]
+  \\ qmatch_goalsub_abbrev_tac `insert p2 _ (insert p1 _ s.refs)`
+  \\ `lookup p1 s.refs = NONE` by
+     (Q.UNABBREV_TAC `p1` \\ fs [least_from_def]
+     \\ IF_CASES_TAC \\ fs []
+     \\ IF_CASES_TAC \\ fs []
+     >- (numLib.LEAST_ELIM_TAC \\ metis_tac [])
+     \\ numLib.LEAST_ELIM_TAC
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+     \\ rw [] \\ pop_assum (qspec_then `domain s.refs` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup]
+     \\ Cases_on `lookup x s.refs` \\ fs []
+     \\ asm_exists_tac \\ fs [])
+  \\ `p1 ≠ p2` by
+     (rw [Abbr `p2`,least_from_def]
+     >- (CCONTR_TAC \\ fs [])
+     >- (numLib.LEAST_ELIM_TAC \\ rw [] >- metis_tac []
+        \\ CCONTR_TAC \\ fs [lookup_insert])
+     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+     >- (mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+        \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
+        \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
+        \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+     \\ CCONTR_TAC \\ fs [lookup_insert])
+  \\ strip_assign \\ fs [lookup_insert]
+  \\ reverse (Cases_on `call_FFI s.ffi "put_char" [97w] []`) >- simp []
+  \\ strip_assign (* \\ strip_assign *)
+  \\ rw [return_def,lookup_def]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ Q.UNABBREV_TAC `rest_call`
+  (*  make_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def ]
+  \\ simp [code_lookup,lookup_def,lookup_insert,lookup_inter
+          ,frame_lookup]
+  \\ IF_CASES_TAC
+  >- simp []
+  \\ eval_goalsub_tac ``dataSem$call_env _ _``
+  \\ qmatch_goalsub_abbrev_tac `evaluate (p0,s0)`
+  \\ `s0.clock < s.clock` by fs [Abbr `s0`,dec_clock_def]
+  \\ first_x_assum (drule_then (qspec_then `ts + 1` mp_tac))
+  \\ impl_tac >- (fs [Abbr `s0`] \\ EVAL_TAC \\ fs [])
+  \\ rw [] \\ fs []
+  end
+QED
+
+Theorem data_safe_cyes_code_abort_shallow[local] =
+  data_safe_cyes_code_abort |> simp_rule [to_shallow_thm,to_shallow_def]
+
+Theorem data_safe_cyes:
+ ∀ffi.
+  backend_config_ok ^cyes_x64_conf
+  ⇒ is_safe_for_space ffi
+      ^cyes_x64_conf
+      ^cyes
+      (1000,1000)
+Proof
+ let
+  val code_lookup   = mk_code_lookup
+                        `fromAList cyes_data_prog`
+                         cyes_data_code_def
+  val frame_lookup   = mk_frame_lookup
+                        `cyes_config.word_conf.stack_frame_size`
+                         cyes_config_def
+  val strip_assign  = mk_strip_assign code_lookup frame_lookup
+  val open_call     = mk_open_call code_lookup frame_lookup
+  val make_call     = mk_make_call open_call
+  val strip_call    = mk_strip_call open_call
+  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
+  val make_tailcall = mk_make_tailcall open_tailcall
+ in
+ strip_tac \\ strip_tac
+ \\ irule IMP_is_safe_for_space_alt \\ fs []
+ \\ conj_tac >- EVAL_TAC
+ \\ assume_tac cyes_thm
+ \\ asm_exists_tac \\ fs []
+ \\ assume_tac cyes_to_data_updated_thm
+ \\ fs [data_lang_safe_for_space_def]
+ \\ strip_tac
+ \\ qmatch_goalsub_abbrev_tac `_ v0`
+ \\ `data_safe v0` suffices_by
+    (Cases_on `v0` \\ fs [data_safe_def])
+ \\ UNABBREV_ALL_TAC
+ \\ qmatch_goalsub_abbrev_tac `is_64_bits c0`
+ \\ `is_64_bits c0` by (UNABBREV_ALL_TAC \\ EVAL_TAC)
+ \\ fs []
+ \\ rpt (pop_assum kall_tac)
+ (* start data_safe proof *)
+ \\ REWRITE_TAC [ to_shallow_thm
+                , to_shallow_def
+                , initial_state_def
+                , bvl_to_bviTheory.InitGlobals_location_eq]
+  (* Make first call *)
+ \\ rpt strip_tac
+ \\ make_tailcall
+ (* Bootcode *)
+ \\ ntac 7 strip_assign
+ \\ ho_match_mp_tac data_safe_bind_return
+ (* Yet another call *)
+ \\ make_call
+ \\ strip_call
+ \\ ntac 9 strip_assign
+ \\ make_if
+ \\ UNABBREV_ALL_TAC
+ (* Continues after call *)
+ \\ strip_makespace
+ \\ ntac 49 strip_assign
+ \\ make_tailcall
+ \\ ntac 5
+    (strip_call
+    \\ ntac 9 strip_assign
+    \\ make_if
+    \\ UNABBREV_ALL_TAC)
+  \\ strip_call
+  \\ ntac 9 strip_assign
+  \\ make_if
+  \\ ntac 6 strip_assign
+  \\ ntac 6
+     (open_tailcall
+     \\ ntac 4 strip_assign
+     \\ make_if
+     \\ ntac 2 strip_assign)
+  \\ open_tailcall
+  \\ ntac 4 strip_assign
+  \\ make_if
+  \\ Q.UNABBREV_TAC `rest_call`
+  \\ strip_assign
+  \\ make_tailcall
+  \\ ntac 5
+     (strip_makespace
+     \\ ntac 6 strip_assign
+     \\ make_tailcall)
+  \\ strip_assign
+  \\ ho_match_mp_tac data_safe_bind_some
+  \\ open_call
+  \\ qmatch_goalsub_abbrev_tac `f (state_locals_fupd _ _)`
+  \\ qmatch_goalsub_abbrev_tac `f s`
+  \\ `∃s' e'. f s = (SOME (Rerr (Rabort e')),s')`
+     by (UNABBREV_ALL_TAC
+        \\ ho_match_mp_tac data_safe_cyes_code_abort_shallow
+        \\ fs [] \\ EVAL_TAC)
+  \\ `data_safe (f s)` suffices_by (rw [] \\ rfs [])
+  \\ unabbrev_all_tac
+  \\ ho_match_mp_tac data_safe_cyes_code_shallow
+  \\ rw [lookup_def,lookup_fromList,code_lookup]
+  \\ EVAL_TAC
+  \\ qexists_tac `10` \\ fs []
+  end
+QED
+
+Theorem cyes_x64_conf_def = mk_abbrev "cyes_x64_conf" cyes_x64_conf;
+Theorem cyes_s_def = mk_abbrev"cyes_s"
+                      ((rand o rand o rhs o concl) primSemEnvTheory.prim_sem_env_eq)
+
+Definition cyes_env_def:
+  cyes_env ffi = FST (THE (prim_sem_env sio_ffi_state))
+End
+
+Theorem prim_sem_env_cyes:
+  THE (prim_sem_env sio_ffi_state) = (cyes_env ffi,cyes_s)
+Proof
+EVAL_TAC \\ rw [cyes_s_def]
+QED
+
+Theorem backend_config_ok_cyes:
+  backend_config_ok cyes_x64_conf
+Proof
+ assume_tac x64_backend_config_ok
+ \\ fs [backend_config_ok_def,cyes_x64_conf_def,x64_backend_config_def]
+QED
+
+Theorem cyes_semantics_prog_not_Fail:
+  let (s,env) = THE (prim_sem_env sio_ffi_state)
+  in ¬semantics_prog s env cyes_prog Fail
+Proof
+  assume_tac cyes_semantics_prog_Diverge
+  \\ fs [] \\ pairarg_tac \\  fs []
+  \\ CCONTR_TAC \\ fs []
+  \\ drule semanticsPropsTheory.semantics_prog_deterministic
+  \\ pop_assum kall_tac
+  \\ disch_then drule
+  \\ fs []
+QED
+
+Theorem IMP_IMP_TRANS_THM:
+  ∀W P R Q. (W ⇒ Q) ⇒ (P ⇒ R ⇒ W) ⇒ P ⇒ R ⇒ Q
+Proof
+ rw []
+QED
+
+Theorem machine_sem_eq_semantics_prog:
+semantics_prog s env prog (Diverge io_trace) ⇒
+  (machine_sem mc (ffi:'ffi ffi_state) ms = semantics_prog s env prog) ⇒
+     machine_sem mc ffi ms (Diverge io_trace)
+Proof
+  rw []
+QED
+
+Theorem machine_sem_eq_semantics_prog_ex:
+(∃io_trace. semantics_prog s env prog (Diverge io_trace)) ⇒
+  (machine_sem mc (ffi:'ffi ffi_state) ms = semantics_prog s env prog) ⇒
+     (∃io_trace. machine_sem mc ffi ms (Diverge io_trace))
+Proof
+  rw []
+QED
+
+val cyes_safe_thm =
+    let
+      val ffi = ``sio_ffi_state``
+      val is_safe = data_safe_cyes
+                    |> REWRITE_RULE [GSYM cyes_prog_def
+                                    ,GSYM cyes_x64_conf_def]
+                    |> ISPEC ffi
+      val not_fail = cyes_semantics_prog_not_Fail
+                     |> SIMP_RULE std_ss [LET_DEF,prim_sem_env_cyes
+                                         ,ELIM_UNCURRY]
+      val is_corr = MATCH_MP compile_correct_is_safe_for_space cyes_thm
+                    |> REWRITE_RULE [GSYM cyes_prog_def
+                                    ,GSYM cyes_x64_conf_def]
+                    |> Q.INST [`stack_limit` |-> `1000`
+                              ,`heap_limit` |-> `1000`]
+                    |> INST_TYPE [``:'ffi`` |-> ``:unit``]
+                    |> Q.INST [`ffi` |-> `sio_ffi_state`]
+                    |> SIMP_RULE std_ss [prim_sem_env_cyes,LET_DEF,not_fail,ELIM_UNCURRY]
+      val machine_eq = MATCH_MP (machine_sem_eq_semantics_prog |> INST_TYPE [``:'ffi`` |-> ``:unit``])
+                                (cyes_semantics_prog_Diverge
+                                   |> SIMP_RULE std_ss [LET_DEF,prim_sem_env_cyes,ELIM_UNCURRY])
+      val safe_thm_aux = MATCH_MP (IMP_TRANS is_safe is_corr) backend_config_ok_cyes
+    in MATCH_MP (MATCH_MP IMP_IMP_TRANS_THM machine_eq)
+                (safe_thm_aux |> SIMP_RULE std_ss [prim_sem_env_cyes,LET_DEF,ELIM_UNCURRY])
+    end
+
+Theorem cyes_safe = cyes_safe_thm |> check_thm;
+
+val _ = export_theory();
diff --git a/examples/cost/pureLoopProgScript.sml b/examples/cost/pureLoopProgScript.sml
index 239ebc4f2f..a1f3f50165 100644
--- a/examples/cost/pureLoopProgScript.sml
+++ b/examples/cost/pureLoopProgScript.sml
@@ -25,6 +25,10 @@ val pureLoop2 = process_topdecs
   `fun pureLoop x = pureLoop (x+1);
    val _ = pureLoop 1`
 
+Definition pureLoop2_ast_def:
+  pureLoop2_ast = ^pureLoop2
+End
+
 val _ = intermediate_prog_prefix := "pureLoop2_"
 val pureLoop2_thm = compile_x64 1000 1000 "pureLoop2" (REFL pureLoop2)
 val _ = intermediate_prog_prefix := ""
@@ -35,15 +39,19 @@ val pureLoop2_config_def          = definition"pureLoop2_config_def"
 val pureLoop2_to_data_updated_thm =
   MATCH_MP (GEN_ALL  to_data_change_config) pureLoop2_to_data_thm
   |> ISPEC ((rand o rator o lhs o concl) pureLoop2_thm)
-  |> SIMP_RULE (srw_ss()) []
+  |> SIMP_RULE (srw_ss()) [];
 
 val pureLoop = process_topdecs
   `fun pureLoop x = pureLoop x;
-   val _ = pureLoop 1`
+   val _ = pureLoop 1`;
 
-val _ = intermediate_prog_prefix := "pureLoop_"
-val pureLoop_thm = compile_x64 1000 1000 "pureLoop" (REFL pureLoop)
-val _ = intermediate_prog_prefix := ""
+Definition pureLoop_ast_def:
+  pureLoop_ast = ^pureLoop
+End
+
+val _ = intermediate_prog_prefix := "pureLoop_";
+Theorem pureLoop_thm = compile_x64 1000 1000 "pureLoop" (REFL pureLoop);
+val _ = intermediate_prog_prefix := "";
 
 val pureLoop_data_code_def       = definition"pureLoop_data_prog_def"
 val pureLoop_to_data_thm         = theorem"pureLoop_to_data_thm"
@@ -51,174 +59,16 @@ val pureLoop_config_def          = definition"pureLoop_config_def"
 val pureLoop_to_data_updated_thm =
   MATCH_MP (GEN_ALL  to_data_change_config) pureLoop_to_data_thm
   |> ISPEC ((rand o rator o lhs o concl) pureLoop_thm)
-  |> SIMP_RULE (srw_ss()) []
-
-val (p1,p2) = diff_code pureLoop_data_code_def pureLoop2_data_code_def
-
-Theorem data_safe_pureLoop_code[local]:
-  ∀s sstack smax.
-   s.safe_for_space ∧
-   (s.stack_frame_sizes = pureLoop_config.word_conf.stack_frame_size) ∧
-   (s.stack_max = SOME smax) ∧
-   (size_of_stack s.stack = SOME sstack) ∧
-   (sstack < s.limits.stack_limit) ∧
-   (smax < s.limits.stack_limit) ∧
-   (∃x. lookup 0 s.locals = SOME x) ∧
-   (lookup 249 s.code =
-      ^((``lookup 249 (fromAList pureLoop_data_prog)``
-        |> (REWRITE_CONV [pureLoop_data_code_def]
-            THENC EVAL)
-        |> rhs o concl)))
-   ⇒ data_safe (evaluate ((SND o SND) ^p1, s))
-Proof
-  measureInduct_on `^s.clock`
-  \\ rw [ evaluate_def,get_var_def
-        , lookup_fromAList,get_vars_def
-        , find_code_def,call_env_def,data_safe_def
-        , flush_state_def ]
-  \\ rw [lookup_fromList,dec_clock_def,lookup_fromAList,data_safe_def]
-  \\ qmatch_goalsub_abbrev_tac `evaluate (_,s')`
-  \\ `s'.clock < s.clock` by rw [Abbr `s'`]
-  \\ first_x_assum (drule_then
-       (qspecl_then [`THE (size_of_stack s'.stack)`
-                    ,`THE s'.stack_max`] mp_tac))
-  \\ impl_tac
-  >- (rw [Abbr `s'`,lookup_fromList,pureLoop_config_def,lookup_def]
-     \\ fs [lookup_def,libTheory.the_def,MAX_DEF])
-  \\ rw []
-  \\ qmatch_asmsub_abbrev_tac `evaluate (_,s'')`
-  \\ `s' = s''`
-     by (UNABBREV_ALL_TAC
-        \\ rw [state_component_equality]
-        \\ EVAL_TAC)
-  \\ fs [] \\ EVERY_CASE_TAC \\ fs [data_safe_def]
-QED
-
-Theorem data_safe_pureLoop_code_shallow[local] =
-  data_safe_pureLoop_code |> simp_rule [to_shallow_thm,to_shallow_def]
-
-Theorem data_safe_pureLoop_code_timeout[local]:
-  ∀s. (∃x. lookup 0 s.locals = SOME x) ∧
-      (lookup 249 s.code =
-         ^((``lookup 249 (fromAList pureLoop_data_prog)``
-           |> (REWRITE_CONV [pureLoop_data_code_def]
-               THENC EVAL)
-           |> rhs o concl)))
-      ⇒ ∃s'. evaluate ((SND o SND) ^p1, s) =
-               (SOME (Rerr(Rabort Rtimeout_error)),s')
-Proof
-  measureInduct_on `^s.clock`
-  \\ rw [ evaluate_def,get_var_def
-        , lookup_fromAList,get_vars_def
-        , find_code_def,call_env_def,data_safe_def]
-  \\ rw [lookup_fromList,dec_clock_def,lookup_fromAList,data_safe_def]
-  \\ qmatch_goalsub_abbrev_tac `evaluate (_,s')`
-  \\ `s'.clock < s.clock` by rw [Abbr `s'`]
-  \\ first_x_assum drule
-  \\ impl_tac
-  >- rw [Abbr `s'`,lookup_fromList]
-  \\ rw [] \\ rw []
-QED
-
-Theorem data_safe_pureLoop_code_timeout_shallow[local] =
-  data_safe_pureLoop_code_timeout |> simp_rule [to_shallow_thm,to_shallow_def]
-
-Theorem data_safe_pureLoop:
- ∀ffi.
-   backend_config_ok (^((rand o rator o lhs o concl) pureLoop_thm))
-   ⇒ is_safe_for_space ffi
-       (^((rand o rator o lhs o concl) pureLoop_thm))
-       ^pureLoop
-       (1000,1000)
-Proof
- let
-  val code_lookup   = mk_code_lookup
-                        `fromAList pureLoop_data_prog`
-                        pureLoop_data_code_def
-  val frame_lookup   = mk_frame_lookup
-                        `pureLoop_config.word_conf.stack_frame_size`
-                        pureLoop_config_def
-  val strip_assign  = mk_strip_assign code_lookup frame_lookup
-  val open_call     = mk_open_call code_lookup frame_lookup
-  val make_call     = mk_make_call open_call
-  val strip_call    = mk_strip_call open_call
-  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
-  val make_tailcall = mk_make_tailcall open_tailcall
- in
- strip_tac \\ strip_tac
- \\ irule IMP_is_safe_for_space_alt \\ fs []
- \\ conj_tac >- EVAL_TAC
- \\ assume_tac pureLoop_thm
- \\ asm_exists_tac \\ fs []
- \\ assume_tac pureLoop_to_data_updated_thm
- \\ fs [data_lang_safe_for_space_def]
- \\ strip_tac
- \\ qmatch_goalsub_abbrev_tac `_ v0`
- \\ `data_safe v0` suffices_by
-    (Cases_on `v0` \\ fs [data_safe_def])
- \\ UNABBREV_ALL_TAC
- \\ qmatch_goalsub_abbrev_tac `is_64_bits c0`
- \\ `is_64_bits c0` by (UNABBREV_ALL_TAC \\ EVAL_TAC)
- \\ fs []
- \\ rpt (pop_assum kall_tac)
- (* Some tactics *)
- \\ REWRITE_TAC [ to_shallow_thm
-                , to_shallow_def
-                , initial_state_def
-                , bvl_to_bviTheory.InitGlobals_location_eq]
- \\ rpt strip_tac
-  (* Make first call *)
- \\ make_tailcall
- (* Bootcode *)
- \\ ntac 7 strip_assign
- (* Another call *)
- \\ ho_match_mp_tac data_safe_bind_return
- (* Yet another call *)
- \\ make_call
- \\ strip_call
- \\ ntac 9 strip_assign
- \\ make_if
- \\ UNABBREV_ALL_TAC
- (* Continues after call *)
- \\ strip_makespace
- \\ ntac 49 strip_assign
- (* Another tailcall *)
- \\ make_tailcall
- \\ strip_call
- \\ ntac 9 strip_assign
- \\ make_if
- \\ ntac 6 strip_assign
- \\ open_tailcall
- \\ ntac 4 strip_assign
- \\ make_if
- \\ ntac 2 strip_assign
- \\ open_tailcall
- \\ ntac 4 strip_assign
- \\ make_if
- \\ UNABBREV_ALL_TAC
- \\ ntac 3 strip_assign
- \\ make_tailcall
- \\ strip_makespace
- \\ ntac 7 strip_assign
- \\ make_tailcall
- \\ strip_assign
- (* Finally we reach our function call *)
- \\ ho_match_mp_tac data_safe_bind_error
- \\ open_call
- \\ qmatch_goalsub_abbrev_tac `f (state_locals_fupd _ _)`
- \\ qmatch_goalsub_abbrev_tac `f s`
- \\ `∃s'. f s = (SOME (Rerr(Rabort Rtimeout_error)),s')`
-    by (unabbrev_all_tac
-       \\ ho_match_mp_tac data_safe_pureLoop_code_timeout_shallow
-       \\ rw [lookup_def,lookup_fromList,code_lookup])
- \\ `data_safe (f s)` suffices_by (rw [] \\ rfs [])
- \\ unabbrev_all_tac
- \\ ho_match_mp_tac data_safe_pureLoop_code_shallow
- \\ rw [lookup_def,lookup_fromList,code_lookup,size_of_stack_def
-       ,size_of_stack_frame_def]
- end
-QED
-
-val _ = check_thm data_safe_pureLoop;
+  |> SIMP_RULE (srw_ss()) [];
+
+val (p1,p2) = diff_code pureLoop_data_code_def pureLoop2_data_code_def;
+
+Definition pureLoop_fun_def:
+  pureLoop_fun = ^p1
+End
+
+Theorem pureLoop_data_code_def = pureLoop_data_code_def;
+Theorem pureLoop2_data_code_def = pureLoop2_data_code_def;
+Theorem pureLoop_to_data_updated_thm = pureLoop_to_data_updated_thm;
 
 val _ = export_theory();
diff --git a/examples/cost/pureLoopProofScript.sml b/examples/cost/pureLoopProofScript.sml
new file mode 100644
index 0000000000..7503fc37ce
--- /dev/null
+++ b/examples/cost/pureLoopProofScript.sml
@@ -0,0 +1,187 @@
+(*
+  Prove that pureLoop never exits prematurely.
+*)
+
+open preamble basis compilationLib;
+open backendProofTheory backendPropsTheory;
+open costLib costPropsTheory;
+open dataSemTheory data_monadTheory dataLangTheory;
+open pureLoopProgTheory;
+
+val _ = new_theory "pureLoopProof"
+
+Overload monad_unitbind[local] = ``data_monad$bind``
+Overload return[local] = ``data_monad$return``
+val _ = monadsyntax.temp_add_monadsyntax()
+
+val p1 = pureLoop_fun_def |> concl |> rand
+val pureLoop = pureLoop_ast_def |> concl |> rand
+val pureLoop2 = pureLoop2_ast_def |> concl |> rand
+
+Theorem data_safe_pureLoop_code[local]:
+  ∀s sstack smax.
+   s.safe_for_space ∧
+   (s.stack_frame_sizes = pureLoop_config.word_conf.stack_frame_size) ∧
+   (s.stack_max = SOME smax) ∧
+   (size_of_stack s.stack = SOME sstack) ∧
+   (sstack < s.limits.stack_limit) ∧
+   (smax < s.limits.stack_limit) ∧
+   (∃x. lookup 0 s.locals = SOME x) ∧
+   (lookup 249 s.code =
+      ^((``lookup 249 (fromAList pureLoop_data_prog)``
+        |> (REWRITE_CONV [pureLoop_data_code_def]
+            THENC EVAL)
+        |> rhs o concl)))
+   ⇒ data_safe (evaluate ((SND o SND) ^p1, s))
+Proof
+  measureInduct_on `^s.clock`
+  \\ rw [ evaluate_def,get_var_def
+        , lookup_fromAList,get_vars_def
+        , find_code_def,call_env_def,data_safe_def
+        , flush_state_def ]
+  \\ rw [lookup_fromList,dec_clock_def,lookup_fromAList,data_safe_def]
+  \\ qmatch_goalsub_abbrev_tac `evaluate (_,s')`
+  \\ `s'.clock < s.clock` by rw [Abbr `s'`]
+  \\ first_x_assum (drule_then
+       (qspecl_then [`THE (size_of_stack s'.stack)`
+                    ,`THE s'.stack_max`] mp_tac))
+  \\ impl_tac
+  >- (rw [Abbr `s'`,lookup_fromList,pureLoop_config_def,lookup_def]
+     \\ fs [lookup_def,libTheory.the_def,MAX_DEF])
+  \\ rw []
+  \\ qmatch_asmsub_abbrev_tac `evaluate (_,s'')`
+  \\ `s' = s''`
+     by (UNABBREV_ALL_TAC
+        \\ rw [state_component_equality]
+        \\ EVAL_TAC)
+  \\ fs [] \\ EVERY_CASE_TAC \\ fs [data_safe_def]
+QED
+
+Theorem data_safe_pureLoop_code_shallow[local] =
+  data_safe_pureLoop_code |> simp_rule [to_shallow_thm,to_shallow_def]
+
+Theorem data_safe_pureLoop_code_timeout[local]:
+  ∀s. (∃x. lookup 0 s.locals = SOME x) ∧
+      (lookup 249 s.code =
+         ^((``lookup 249 (fromAList pureLoop_data_prog)``
+           |> (REWRITE_CONV [pureLoop_data_code_def]
+               THENC EVAL)
+           |> rhs o concl)))
+      ⇒ ∃s'. evaluate ((SND o SND) ^p1, s) =
+               (SOME (Rerr(Rabort Rtimeout_error)),s')
+Proof
+  measureInduct_on `^s.clock`
+  \\ rw [ evaluate_def,get_var_def
+        , lookup_fromAList,get_vars_def
+        , find_code_def,call_env_def,data_safe_def]
+  \\ rw [lookup_fromList,dec_clock_def,lookup_fromAList,data_safe_def]
+  \\ qmatch_goalsub_abbrev_tac `evaluate (_,s')`
+  \\ `s'.clock < s.clock` by rw [Abbr `s'`]
+  \\ first_x_assum drule
+  \\ impl_tac
+  >- rw [Abbr `s'`,lookup_fromList]
+  \\ rw [] \\ rw []
+QED
+
+Theorem data_safe_pureLoop_code_timeout_shallow[local] =
+  data_safe_pureLoop_code_timeout |> simp_rule [to_shallow_thm,to_shallow_def]
+
+Theorem data_safe_pureLoop:
+ ∀ffi.
+   backend_config_ok (^((rand o rator o lhs o concl) pureLoop_thm))
+   ⇒ is_safe_for_space ffi
+       (^((rand o rator o lhs o concl) pureLoop_thm))
+       ^pureLoop
+       (1000,1000)
+Proof
+ let
+  val code_lookup   = mk_code_lookup
+                        `fromAList pureLoop_data_prog`
+                        pureLoop_data_code_def
+  val frame_lookup   = mk_frame_lookup
+                        `pureLoop_config.word_conf.stack_frame_size`
+                        pureLoop_config_def
+  val strip_assign  = mk_strip_assign code_lookup frame_lookup
+  val open_call     = mk_open_call code_lookup frame_lookup
+  val make_call     = mk_make_call open_call
+  val strip_call    = mk_strip_call open_call
+  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
+  val make_tailcall = mk_make_tailcall open_tailcall
+ in
+ strip_tac \\ strip_tac
+ \\ irule IMP_is_safe_for_space_alt \\ fs []
+ \\ conj_tac >- EVAL_TAC
+ \\ assume_tac pureLoop_thm
+ \\ asm_exists_tac \\ fs []
+ \\ assume_tac pureLoop_to_data_updated_thm
+ \\ fs [data_lang_safe_for_space_def]
+ \\ strip_tac
+ \\ qmatch_goalsub_abbrev_tac `_ v0`
+ \\ `data_safe v0` suffices_by
+    (Cases_on `v0` \\ fs [data_safe_def])
+ \\ UNABBREV_ALL_TAC
+ \\ qmatch_goalsub_abbrev_tac `is_64_bits c0`
+ \\ `is_64_bits c0` by (UNABBREV_ALL_TAC \\ EVAL_TAC)
+ \\ fs []
+ \\ rpt (pop_assum kall_tac)
+ (* Some tactics *)
+ \\ REWRITE_TAC [ to_shallow_thm
+                , to_shallow_def
+                , initial_state_def
+                , bvl_to_bviTheory.InitGlobals_location_eq]
+ \\ rpt strip_tac
+  (* Make first call *)
+ \\ make_tailcall
+ (* Bootcode *)
+ \\ ntac 7 strip_assign
+ (* Another call *)
+ \\ ho_match_mp_tac data_safe_bind_return
+ (* Yet another call *)
+ \\ make_call
+ \\ strip_call
+ \\ ntac 9 strip_assign
+ \\ make_if
+ \\ UNABBREV_ALL_TAC
+ (* Continues after call *)
+ \\ strip_makespace
+ \\ ntac 49 strip_assign
+ (* Another tailcall *)
+ \\ make_tailcall
+ \\ strip_call
+ \\ ntac 9 strip_assign
+ \\ make_if
+ \\ ntac 6 strip_assign
+ \\ open_tailcall
+ \\ ntac 4 strip_assign
+ \\ make_if
+ \\ ntac 2 strip_assign
+ \\ open_tailcall
+ \\ ntac 4 strip_assign
+ \\ make_if
+ \\ UNABBREV_ALL_TAC
+ \\ strip_assign
+ \\ make_tailcall
+ \\ strip_makespace
+ \\ ntac 6 strip_assign
+ \\ make_tailcall
+ \\ strip_assign
+ (* Finally we reach our function call *)
+ \\ ho_match_mp_tac data_safe_bind_error
+ \\ open_call
+ \\ qmatch_goalsub_abbrev_tac `f (state_locals_fupd _ _)`
+ \\ qmatch_goalsub_abbrev_tac `f s`
+ \\ `∃s'. f s = (SOME (Rerr(Rabort Rtimeout_error)),s')`
+    by (unabbrev_all_tac
+       \\ ho_match_mp_tac data_safe_pureLoop_code_timeout_shallow
+       \\ rw [lookup_def,lookup_fromList,code_lookup])
+ \\ `data_safe (f s)` suffices_by (rw [] \\ rfs [])
+ \\ unabbrev_all_tac
+ \\ ho_match_mp_tac data_safe_pureLoop_code_shallow
+ \\ rw [lookup_def,lookup_fromList,code_lookup,size_of_stack_def
+       ,size_of_stack_frame_def]
+ end
+QED
+
+val _ = check_thm data_safe_pureLoop;
+
+val _ = export_theory();
diff --git a/examples/cost/yesProgScript.sml b/examples/cost/yesProgScript.sml
index 2d9c66bb79..e118b5b69e 100644
--- a/examples/cost/yesProgScript.sml
+++ b/examples/cost/yesProgScript.sml
@@ -1,7 +1,6 @@
 (*
   A data-cost example of a non-terminating function (cyes)
   that prints a character indefinitely
-
 *)
 
 open preamble basis compilationLib;
@@ -454,1267 +453,25 @@ QED
 val yes2_thm = compile_to_data (compilation_compset())
                                x64_backend_config_def
                                (REFL yes2)
-                               "yes2_data_prog"
+                               "yes2_data_prog";
 
-val yes2_data_code_def       = definition"yes2_data_prog_def"
+val yes2_data_code_def       = definition"yes2_data_prog_def";
 
-val _ = intermediate_prog_prefix := "yes_"
-val yes_thm = compile_x64 1000 1000 "yes" (REFL yes)
-val _ = intermediate_prog_prefix := ""
+val _ = intermediate_prog_prefix := "yes_";
+Theorem yes_thm = compile_x64 1000 1000 "yes" (REFL yes);
+val _ = intermediate_prog_prefix := "";
 
 val yes_data_code_def       = definition"yes_data_prog_def"
 val yes_to_data_thm         = theorem"yes_to_data_thm"
 val yes_config_def          = definition"yes_config_def"
 val yes_x64_conf            = (rand o rator o lhs o concl) yes_thm
 val yes_x64_conf_def        = mk_abbrev"yes_x64_conf" yes_x64_conf
-val yes_to_data_updated_thm =
+Theorem yes_to_data_updated_thm =
   MATCH_MP (GEN_ALL  to_data_change_config) yes_to_data_thm
   |> ISPEC ((rand o rator o lhs o concl) yes_thm)
-  |> SIMP_RULE (srw_ss()) []
-
-val f_diff = diff_codes yes_data_code_def yes2_data_code_def
-
-(* val (f11,f12) = hd f_diff *)
-val (f21,f22) = hd f_diff
-
-Theorem data_safe_yes_code:
-  ∀s ts smax sstack lsize.
-   s.safe_for_space ∧
-   wf s.refs ∧
-   (s.stack_frame_sizes = yes_config.word_conf.stack_frame_size) ∧
-   (s.stack_max = SOME smax) ∧
-   (size_of_stack s.stack = SOME sstack) ∧
-   (s.locals_size = SOME lsize) ∧
-   (sstack + 17 < s.limits.stack_limit) ∧
-   (sstack + lsize + 14 < s.limits.stack_limit) ∧
-   (smax < s.limits.stack_limit) ∧
-   s.limits.arch_64_bit ∧
-   closed_ptrs (stack_to_vs s) s.refs ∧
-   size_of_heap s + 11 ≤ s.limits.heap_limit ∧
-   2 ≤ s.limits.length_limit ∧
-   (s.tstamps = SOME ts) ∧
-   0 < ts ∧
-   (s.locals = fromList [RefPtr 2]) ∧
-   (lookup 2 s.refs = SOME (ByteArray T [121w])) ∧
-   (s.code = fromAList yes_data_prog)
-   ⇒ data_safe (evaluate ((SND o SND) ^f21, s))
-Proof
- let
-  val code_lookup   = mk_code_lookup
-                        `fromAList yes_data_prog`
-                         yes_data_code_def
-  val frame_lookup   = mk_frame_lookup
-                        `yes_config.word_conf.stack_frame_size`
-                         yes_config_def
-  val strip_assign  = mk_strip_assign code_lookup frame_lookup
-  val open_call     = mk_open_call code_lookup frame_lookup
-  val make_call     = mk_make_call open_call
-  val strip_call    = mk_strip_call open_call
-  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
-  val make_tailcall = mk_make_tailcall open_tailcall
-  in
-  measureInduct_on `^s.clock`
-  \\ fs [ to_shallow_thm
-        , to_shallow_def
-        , initial_state_def ]
-  \\ rw [] \\ fs [fromList_def]
-  \\ strip_call
-  \\ `1 < 2 ** s.limits.length_limit`
-     by (irule LESS_TRANS \\ qexists_tac `s.limits.length_limit` \\ fs [])
-  (* Make safe_for_space sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe) _`
-  \\ `safe` by (fs [Abbr `safe`, size_of_stack_def,GREATER_DEF] \\ EVAL_TAC)
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `dataSem$state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 6))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  (* strip_assign *)
-  \\ `2 < 2 ** s.limits.length_limit`
-     by (Cases_on `s.limits.length_limit` \\ fs [])
-  \\ ntac 2 strip_assign
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
-  \\ qmatch_goalsub_abbrev_tac `insert p1 _ s.refs`
-  \\ qmatch_goalsub_abbrev_tac `insert _ (RefPtr pp1) _`
-  \\ `pp1 = p1`  by
-     (UNABBREV_ALL_TAC \\ fs [least_from_def]
-     \\ Cases_on `lookup 0 s.refs` \\ fs []
-     >- (numLib.LEAST_ELIM_TAC
-        \\ conj_tac >- (asm_exists_tac \\ fs [])
-        \\ rw [] \\ Cases_on `n` \\ fs [])
-     \\ rw [] \\ numLib.LEAST_ELIM_TAC
-     \\ conj_tac >- (asm_exists_tac \\ fs [])
-     \\ rw [] \\ numLib.LEAST_ELIM_TAC
-     \\ conj_tac >- (qexists_tac `ptr` \\ fs [])
-     \\ rw [] \\ CCONTR_TAC
-     \\ Cases_on `n' < n`
-     >- (first_x_assum drule \\ rw [])
-     \\ fs [NOT_LESS] \\ `n < n'` by rw []
-     \\ first_x_assum drule \\ rw[]
-     \\ Cases_on `n` \\ fs [])
-  \\ rveq \\ pop_assum kall_tac
-  (* Make safe_for_space sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_stack_def]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [MAX_DEF,GREATER_DEF,libTheory.the_def,small_num_def]
-     \\ fs [Once insert_def,toList_def,toListA_def]
-     \\ rveq \\ fs []
-     \\ qmatch_asmsub_rename_tac `size_of _ _ _ _ = (_,refs'',seen'')`
-     \\ drule size_of_RefPtr_head
-     \\ eval_goalsub_tac ``sptree$lookup _ _``
-     \\ rw [] \\ fs [])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `dataSem$state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  (* strip_makespace *)
-  \\ qmatch_goalsub_abbrev_tac `bind _ rest_mkspc _`
-  \\ REWRITE_TAC [ bind_def, makespace_def, add_space_def]
-  \\ simp []
-  \\ eval_goalsub_tac ``dataSem$cut_env _ _`` \\ simp []
-  \\ Q.UNABBREV_TAC `rest_mkspc`
-  \\ ntac 2 strip_assign
-  \\ strip_assign \\ fs []
-  \\ Q.ABBREV_TAC `pred = ∃w. 10 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 10` \\ rw [])
-  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
-  \\ ntac 6 (strip_assign \\ fs [])
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  (* strip_call *)
-  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
-  \\ ONCE_REWRITE_TAC [bind_def]
-  \\ simp [ call_def     , find_code_def  , push_env_def
-          , get_vars_def , call_env_def   , dec_clock_def
-          , cut_env_def  , domain_def     , data_safe_def
-          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
-          , lookup_def   , domain_IS_SOME , frame_lookup
-          , code_lookup  , lookup_def     , domain_IS_SOME
-          , flush_state_def
-          , size_of_stack_frame_def]
-  \\ `lookup p1 s.refs = NONE`  by
-     (Q.UNABBREV_TAC `p1` \\ fs [least_from_def]
-     \\ EVERY_CASE_TAC \\ fs [] \\ numLib.LEAST_ELIM_TAC
-     >- metis_tac []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-     \\ rw [] \\ pop_assum (qspec_then `domain s.refs` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup]
-     \\ Cases_on `lookup x s.refs` \\ fs []
-     \\ asm_exists_tac \\ fs [])
-  \\ `p1 ≠ 2` by (CCONTR_TAC  \\ fs [])
-  (* Prove we are safe for space up to this point *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_stack_def]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [MAX_DEF,GREATER_DEF,libTheory.the_def]
-     \\ fs [Once insert_def,toList_def,toListA_def]
-     \\ drule size_of_insert
-     \\ rpt (disch_then drule)
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert] \\ rveq
-     \\ drule_then drule wf_size_of
-     \\ strip_tac
-     \\ drule_then (qspecl_then [`p1`,`ByteArray T [0w]`] mp_tac) delete_insert_eq
-     \\ impl_tac
-     >- (drule_then drule size_of_lookup_NONE \\ fs [])
-     \\ drule size_of_RefPtr_head
-     \\ eval_goalsub_tac ``sptree$lookup _ _``
-     \\ rw [] \\ fs [])
-  \\ simp []
-  \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  (* strip_assign *)
-  \\ strip_assign
-  \\ make_if
-  \\ ntac 6 strip_assign
-  (* open_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  (* Prove we are safe for space up to this point *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     (* \\ Cases_on `ts` *)
-     \\ fs [size_of_def,lookup_def,GREATER_DEF,libTheory.the_def
-           ,size_of_stack_def,insert_shadow]
-     \\ fs [Once insert_def,toList_def,toListA_def]
-     \\ drule size_of_insert
-     \\ rpt (disch_then drule)
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert] \\ rveq \\ fs []
-     \\ qmatch_asmsub_rename_tac `size_of _ _ s.refs LN = (_,_,seen0)`
-     \\ Cases_on `IS_SOME (lookup (ts + 1) seen0)` \\ fs []
-     >- (rveq \\ fs [] \\ rveq \\ fs []
-        \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs []
-        \\ rveq \\ rw[arch_size_def])
-     \\ rveq \\ fs []
-     \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs []
-     >- (fs [] \\ rveq
-        \\ Cases_on `IS_SOME (lookup ts seen')` \\ fs []
-        \\ rveq \\ fs [lookup_insert] \\ rfs []
-        \\ drule size_of_RefPtr_head
-        \\ strip_tac \\ fs []
-        \\ rveq \\ fs []
-        \\ rveq \\ fs []
-        \\ rw[arch_size_def])
-     \\ rveq \\ fs [lookup_delete,lookup_insert] \\ rfs []
-     \\ drule size_of_RefPtr_head
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_delete]
-     \\ rw[arch_size_def])
-  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  (* Prove we are safe for space up to this point *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_def,lookup_def,GREATER_DEF,libTheory.the_def
-           ,size_of_stack_def,insert_shadow])
-  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ strip_assign
-  \\ make_if
-  \\ ntac 6 strip_assign
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  (* Prove we are safe for space up to this point *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     (* \\ Cases_on `ts` *)
-     \\ fs [size_of_def,lookup_def,GREATER_DEF,libTheory.the_def
-           ,size_of_stack_def,insert_shadow]
-     \\ fs [Once insert_def,toList_def,toListA_def]
-     \\ drule size_of_insert
-     \\ rpt (disch_then drule)
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert] \\ rveq \\ fs []
-     \\ qmatch_asmsub_rename_tac `size_of _ _ s.refs LN = (_,_,seen0)`
-     \\ Cases_on `IS_SOME (lookup (ts + 1) seen0)` \\ fs []
-     \\ rveq \\ fs []
-     \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs [lookup_delete]
-     >- (rveq \\ fs [lookup_insert] \\ rfs []
-        \\ drule size_of_RefPtr_head
-        \\ strip_tac \\ fs [])
-     \\ rveq \\ fs [lookup_delete,lookup_insert] \\ rfs []
-     \\ drule size_of_RefPtr_head
-     \\ strip_tac \\ fs []
-     \\ rw[arch_size_def]
-     )
-  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ Q.UNABBREV_TAC `rest_call2`
-  (* strip_assign *)
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
-  \\ ONCE_REWRITE_TAC [bind_def]
-  \\ simp [ call_def     , find_code_def  , push_env_def
-          , get_vars_def , call_env_def   , dec_clock_def
-          , cut_env_def  , domain_def     , data_safe_def
-          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
-          , lookup_def   , domain_IS_SOME , frame_lookup
-          , code_lookup  , lookup_def     , domain_IS_SOME
-          , flush_state_def
-          , size_of_stack_frame_def]
-  (* Prove we are safe for space up to this point *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_def,lookup_def]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_Number_head,GREATER_DEF,libTheory.the_def
-           ,size_of_stack_def,insert_shadow]
-     \\ fs [Once insert_def,toList_def,toListA_def]
-     \\ drule size_of_insert
-     \\ rpt (disch_then drule)
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert] \\ rveq \\ fs []
-     \\ qmatch_asmsub_rename_tac `size_of _ _ s.refs LN = (_,_,seen0)`
-     \\ Cases_on `IS_SOME (lookup (ts + 1) seen0)` \\ fs []
-     \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs [lookup_delete]
-     >- (rveq \\ fs [lookup_insert] \\ rfs []
-        \\ drule size_of_RefPtr_head
-        \\ strip_tac \\ fs [])
-     \\ rveq \\ fs [lookup_delete,lookup_insert] \\ rfs []
-     \\ drule size_of_RefPtr_head
-     \\ strip_tac \\ fs []
-     \\ rw[arch_size_def])
-  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 14))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  (* strip_assign *)
-  \\ strip_assign
-  \\ make_if
-  \\ qmatch_goalsub_abbrev_tac `dataSem$state_refs_fupd (K (insert p2 _ _)) _`
-  \\ fs [insert_shadow]
-  \\ `lookup p2 s.refs = NONE` by
-  (Q.UNABBREV_TAC `p2`
-  \\ rw [least_from_def]
-  >- (Cases_on `0 = p1` \\ fs [])
-  >- (numLib.LEAST_ELIM_TAC \\ rw []
-     \\ Cases_on `ptr = p1` \\ fs []
-     \\ qexists_tac `ptr` \\ fs [])
-  \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-  \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-  \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
-  \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
-  \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `2 ≠ p2` by (CCONTR_TAC  \\ fs [])
-  \\ ntac 8 strip_assign
-  (* make_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  \\ fs [insert_shadow]
-  \\ `p1 ≠ p2` by
-  (Q.UNABBREV_TAC `p2`
-  \\ rw [least_from_def]
-  >- (Cases_on `0 = p1` \\ fs [])
-  >- (numLib.LEAST_ELIM_TAC \\ rw []
-     \\ Cases_on `ptr = p1` \\ fs []
-     \\ qexists_tac `ptr` \\ fs [])
-  \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-  \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-  \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
-  \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
-  \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `2 ≠ p2` by (CCONTR_TAC  \\ fs [])
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  (* Prove we are safe for space up to this point *)
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
-     \\ fs [Once insert_def,toList_def,toListA_def]
-     (* insert p1 *)
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
-     \\ rpt (disch_then drule)
-     \\ disch_then (qspec_then `ByteArray T [10w]` assume_tac)
-     \\ `wf (insert p1 (ByteArray T [10w]) s.refs)` by fs [wf_insert]
-     \\ drule closed_ptrs_insert
-     \\ disch_then (qspec_then `p1` mp_tac) \\ fs []
-     \\ disch_then (qspec_then `ByteArray T [10w]` mp_tac)
-     \\ impl_tac >- fs [closed_ptrs_def,closed_ptrs_refs_insert]
-     \\ strip_tac
-     (* insert p2 *)
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p2`] mp_tac)
-     \\ fs [lookup_insert]
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert] \\ rfs [] \\ rveq
-     \\ qmatch_asmsub_rename_tac `size_of _ _ _ LN = (n'',_,seen0)`
-     \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs [] \\ rveq
-     \\ fs [lookup_insert,lookup_delete] \\ rfs []
-     \\ rw [arch_size_def])
-  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 14))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ ntac 8 strip_assign
-  (* make_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  \\ fs [insert_shadow]
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  (* Prove we are safe for space up to this point *)
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
-     \\ fs [Once insert_def,toList_def,toListA_def]
-     (* insert p1 *)
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
-     \\ rpt (disch_then drule)
-     \\ disch_then (qspec_then `ByteArray T [10w]` assume_tac)
-     \\ `wf (insert p1 (ByteArray T [10w]) s.refs)` by fs [wf_insert]
-     \\ drule closed_ptrs_insert
-     \\ disch_then (qspec_then `p1` mp_tac) \\ fs []
-     \\ disch_then (qspec_then `ByteArray T [10w]` mp_tac)
-     \\ impl_tac >- fs [closed_ptrs_def,closed_ptrs_refs_insert]
-     \\ strip_tac
-     (* insert p2 *)
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p2`] mp_tac)
-     \\ fs [lookup_insert]
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert] \\ rfs [] \\ rveq
-     \\ qmatch_asmsub_rename_tac `size_of _ _ _ LN = (n'',_,seen0)`
-     \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs [] \\ rveq
-     \\ fs [lookup_insert,lookup_delete] \\ rfs [])
-  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 14))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ Q.UNABBREV_TAC `rest_call2`
-  \\ strip_assign
-  \\ strip_assign
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
-  \\ qmatch_goalsub_abbrev_tac `dataSem$state_refs_fupd (K (insert p3 _ _)) _`
-  \\ qmatch_goalsub_abbrev_tac `insert _ (RefPtr pp3) _`
-  \\ `pp3 = p3` by
-     (rw [Abbr`pp3`,Abbr`p3`,least_from_def]
-     >- (Cases_on `0 = p2` \\ fs []
-        \\ Cases_on `0 = p1` \\ fs []
-        \\ numLib.LEAST_ELIM_TAC
-        \\ rw []
-        >- (mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-           \\ rw [] \\ pop_assum (qspec_then `domain ((insert p2 ARB (insert p1 ARB s.refs)))` assume_tac)
-           \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
-           \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ Cases_on `x = p2` \\ fs [lookup_insert])
-        \\ CCONTR_TAC \\ `0 < n` by rw []
-        \\ first_x_assum drule \\ rw [])
-     \\ fs [] \\ numLib.LEAST_ELIM_TAC
-     \\ conj_tac >- (asm_exists_tac \\ fs [])
-     \\ numLib.LEAST_ELIM_TAC
-     \\ conj_tac >- (asm_exists_tac \\ fs [])
-     \\ rw [] \\ Cases_on `n' < n`
-     >- (first_x_assum drule \\ rw [] \\ Cases_on `n'` \\ fs [])
-     \\ fs [NOT_LESS]
-     \\ CCONTR_TAC
-     \\ `n < n'` by rw []
-     \\ first_x_assum drule \\ rw[]
-     \\ Cases_on `n` \\ fs [])
-  \\ rveq \\ pop_assum kall_tac
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ `p3 ≠ p2` by
-     (rw [Abbr `p3`,least_from_def]
-     >- (CCONTR_TAC \\ fs [])
-     >- (numLib.LEAST_ELIM_TAC \\ rw []
-        \\ asm_exists_tac \\ fs [])
-     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV \\ rw []
-     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup]
-     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
-     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `p3 ≠ p1` by
-     (rw [Abbr `p3`,least_from_def]
-     >- (CCONTR_TAC \\ fs [] \\ rfs [])
-     >- (numLib.LEAST_ELIM_TAC \\ rw []
-        \\ asm_exists_tac \\ fs [])
-     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV \\ rw []
-     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup]
-     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
-     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `lookup p3 s.refs = NONE` by
-     (Q.UNABBREV_TAC `p3`
-     \\ rw [least_from_def]
-     >- (Cases_on `0 = p2` \\ Cases_on `0 = p1` \\ fs [])
-     >- (numLib.LEAST_ELIM_TAC \\ rw []
-        \\ Cases_on `ptr = p2`
-        \\ Cases_on `ptr = p1`
-        \\ fs []
-        \\ qexists_tac `ptr` \\ fs [])
-     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup]
-     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
-     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `2 ≠ p3` by (CCONTR_TAC  \\ fs [])
-  \\ strip_assign
-  \\ fs [lookup_insert]
-  (* Prove we are safe for space up to this point *)
-  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
-  \\ `safe` by
-     (Q.UNABBREV_TAC `safe`
-     \\ fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
-     \\ fs [Once insert_def,toList_def,toListA_def]
-     (* insert p1 *)
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
-     \\ rpt (disch_then drule)
-     \\ disch_then (qspec_then `ByteArray T [10w]` assume_tac)
-     \\ `wf (insert p1 (ByteArray T [10w]) s.refs)` by fs [wf_insert]
-     \\ drule closed_ptrs_insert
-     \\ disch_then (qspec_then `p1` mp_tac) \\ fs []
-     \\ disch_then (qspec_then `ByteArray T [10w]` mp_tac)
-     \\ impl_tac >- fs [closed_ptrs_def,closed_ptrs_refs_insert]
-     \\ strip_tac
-     (* insert p2 *)
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p2`] mp_tac)
-     \\ fs [lookup_insert]
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert] \\ rfs [] \\ rveq
-     \\ pop_assum (qspec_then `ByteArray T [121w; 10w]` assume_tac)
-     \\ `wf (insert p2 (ByteArray T [121w; 10w])
-              (insert p1 (ByteArray T [10w]) s.refs))` by fs [wf_insert]
-     \\ drule closed_ptrs_insert
-     \\ disch_then (qspec_then `p2` mp_tac) \\ fs []
-     \\ disch_then (qspec_then `ByteArray T [121w; 10w]` mp_tac)
-     \\ fs [lookup_insert]
-     \\ impl_tac
-     >- (irule closed_ptrs_refs_insert \\ fs [closed_ptrs_def,lookup_insert])
-     \\ strip_tac
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p3`] mp_tac)
-     \\ fs [lookup_insert]
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert]
-     \\ rfs [] \\ rveq \\ fs [] \\ rveq
-     \\ fs [lookup_delete]
-     \\ rfs [] \\ rveq \\ fs [] \\ rveq)
-  \\ simp[] \\ ntac 2 (pop_assum kall_tac) \\ fs []
-  \\ reverse (Cases_on `call_FFI s.ffi "put_char" [121w; 10w] []`
-             \\ fs [])
-  >- (fs [data_safe_def,GREATER_DEF,libTheory.the_def,size_of_stack_def]
-     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
-     \\ fs [Once insert_def,toList_def,toListA_def]
-     (* insert p1 *)
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
-     \\ rpt (disch_then drule)
-     \\ disch_then (qspec_then `ByteArray T [10w]` assume_tac)
-     \\ `wf (insert p1 (ByteArray T [10w]) s.refs)` by fs [wf_insert]
-     \\ drule closed_ptrs_insert
-     \\ disch_then (qspec_then `p1` mp_tac) \\ fs []
-     \\ disch_then (qspec_then `ByteArray T [10w]` mp_tac)
-     \\ impl_tac >- fs [closed_ptrs_def,closed_ptrs_refs_insert]
-     \\ strip_tac
-     (* insert p2 *)
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p2`] mp_tac)
-     \\ fs [lookup_insert]
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert] \\ rfs [] \\ rveq
-     \\ simp [])
-  \\ strip_assign \\ strip_assign
-  \\ simp [return_def,lookup_def,data_safe_def]
-  \\ rpt (pairarg_tac \\ fs [])
-  \\ rfs [insert_shadow,size_of_Number_head]
-  \\ rveq \\ fs [flush_state_def]
-  \\ Q.UNABBREV_TAC `rest_call`
-  (* strip tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def ]
-  \\ simp [code_lookup,lookup_def,lookup_insert,lookup_inter,frame_lookup]
-  \\ IF_CASES_TAC
-  >- fs [data_safe_def,GREATER_DEF,libTheory.the_def,size_of_stack_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ ho_match_mp_tac data_safe_res
-  \\ reverse conj_tac >- (rw [] \\ pairarg_tac \\ rw [])
-  (* Make stack_max sane to look at *)
-  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
-  \\ `max0 = SOME (MAX smax (lsize + sstack + 14))` by
-     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
-  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
-  \\ qmatch_goalsub_abbrev_tac `data_safe (_ s0)`
-  \\ first_x_assum (qspec_then `s0` assume_tac)
-  \\ `s0.clock < s.clock` by (UNABBREV_ALL_TAC \\ rw [])
-  \\ first_x_assum (drule_then irule) \\ Q.UNABBREV_TAC `s0` \\  fs []
-  \\ simp [ size_of_heap_def,size_of_Number_head,stack_to_vs_def
-          , lookup_def,toList_def,toListA_def
-          , wf_insert, wf_delete ]
-  \\ rw []
-  >- fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
-  >- fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
-  >- (pairarg_tac \\ fs []
-     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
-     \\ rpt (pairarg_tac \\ fs []) \\ rveq
-     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
-     \\ fs [Once insert_def,toList_def,toListA_def]
-     \\ rveq \\ fs []
-     (* insert p1 *)
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
-     \\ rpt (disch_then drule)
-     \\ disch_then (qspec_then `ByteArray T [10w]` assume_tac)
-     \\ `wf (insert p1 (ByteArray T [10w]) s.refs)` by fs [wf_insert]
-     \\ drule closed_ptrs_insert
-     \\ disch_then (qspec_then `p1` mp_tac) \\ fs []
-     \\ disch_then (qspec_then `ByteArray T [10w]` mp_tac)
-     \\ impl_tac >- fs [closed_ptrs_def,closed_ptrs_refs_insert]
-     \\ strip_tac
-     (* insert p2 *)
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p2`] mp_tac)
-     \\ fs [lookup_insert]
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert] \\ rfs [] \\ rveq
-     \\ pop_assum (qspec_then `ByteArray T [121w; 10w]` assume_tac)
-     \\ `wf (insert p2 (ByteArray T [121w; 10w])
-              (insert p1 (ByteArray T [10w]) s.refs))` by fs [wf_insert]
-     \\ drule closed_ptrs_insert
-     \\ disch_then (qspec_then `p2` mp_tac) \\ fs []
-     \\ disch_then (qspec_then `ByteArray T [121w; 10w]` mp_tac)
-     \\ fs [lookup_insert]
-     \\ impl_tac
-     >- (irule closed_ptrs_refs_insert \\ fs [closed_ptrs_def,lookup_insert])
-     \\ strip_tac
-     \\ drule_then drule size_of_insert
-     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p3`] mp_tac)
-     \\ fs [lookup_insert]
-     \\ strip_tac \\ fs [] \\ rveq
-     \\ fs [lookup_insert]
-     \\ rfs [] \\ rveq \\ fs [] \\ rveq
-     \\ fs [lookup_delete]
-     \\ rfs [] \\ rveq \\ fs [] \\ rveq)
-  >- fs [lookup_insert]
-  >- rw [Once insert_def]
-  \\ ho_match_mp_tac closed_ptrs_insert
-  \\ fs [lookup_insert] \\ reverse conj_tac
-  >- (ho_match_mp_tac closed_ptrs_refs_insert \\ fs [lookup_insert]
-     \\ ho_match_mp_tac closed_ptrs_refs_insert \\ fs [lookup_insert]
-     \\ ho_match_mp_tac closed_ptrs_refs_insert \\ fs [lookup_insert]
-     \\ fs [closed_ptrs_def])
-  \\ ho_match_mp_tac closed_ptrs_insert
-  \\ fs [lookup_insert] \\ reverse conj_tac
-  >- (ho_match_mp_tac closed_ptrs_refs_insert \\ fs [lookup_insert]
-     \\ ho_match_mp_tac closed_ptrs_refs_insert \\ fs [lookup_insert]
-     \\ fs [closed_ptrs_def])
-  \\ ho_match_mp_tac closed_ptrs_insert
-  \\ fs [lookup_insert] \\ reverse conj_tac
-  >- (ho_match_mp_tac closed_ptrs_refs_insert \\ fs [closed_ptrs_def])
-  \\ ONCE_REWRITE_TAC [closed_ptrs_cons]
-  \\ conj_tac >- fs [closed_ptrs_APPEND,stack_to_vs_def]
-  \\ fs [closed_ptrs_def,closed_ptrs_list_def]
-  end
-QED
-
-Theorem data_safe_yes_code_shallow[local] =
-  data_safe_yes_code |> simp_rule [to_shallow_thm,to_shallow_def]
-
-Theorem data_safe_yes_code_abort:
- ∀s ts.
-   (s.locals = fromList [RefPtr 2]) ∧
-   (lookup 2 s.refs = SOME (ByteArray T [121w])) ∧
-   2 ≤ s.limits.length_limit ∧
-   (s.stack_frame_sizes = yes_config.word_conf.stack_frame_size) ∧
-   s.limits.arch_64_bit ∧
-   (s.tstamps = SOME ts) ∧
-   (s.code = fromAList yes_data_prog)
-   ⇒ ∃s' e. evaluate ((SND o SND) ^f21, s) =
-       (SOME (Rerr (Rabort e)),s')
-Proof
- let
-  val code_lookup   = mk_code_lookup
-                        `fromAList yes_data_prog`
-                         yes_data_code_def
-  val frame_lookup   = mk_frame_lookup
-                        `yes_config.word_conf.stack_frame_size`
-                         yes_config_def
-  val strip_assign  = mk_strip_assign code_lookup frame_lookup
-  val open_call     = mk_open_call code_lookup frame_lookup
-  val make_call     = mk_make_call open_call
-  val strip_call    = mk_strip_call open_call
-  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
-  val make_tailcall = mk_make_tailcall open_tailcall
-  in
-  measureInduct_on `^s.clock`
-  \\ fs [ to_shallow_thm
-        , to_shallow_def
-        , initial_state_def ]
-  \\ rw [] \\ fs [fromList_def]
-  \\ strip_call
-  \\ `1 < 2 ** s.limits.length_limit`
-     by (irule LESS_TRANS \\ qexists_tac `s.limits.length_limit` \\ fs [])
-  \\ `2 < 2 ** s.limits.length_limit`
-     by (Cases_on `s.limits.length_limit` \\ fs [])
-  \\ ntac 2 strip_assign
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
-  \\ qmatch_goalsub_abbrev_tac `insert p1 _ s.refs`
-  \\ qmatch_goalsub_abbrev_tac `insert _ (RefPtr pp1) _`
-  \\ `pp1 = p1`  by
-     (UNABBREV_ALL_TAC \\ fs [least_from_def]
-     \\ Cases_on `lookup 0 s.refs` \\ fs []
-     >- (numLib.LEAST_ELIM_TAC
-        \\ conj_tac >- (asm_exists_tac \\ fs [])
-        \\ rw [] \\ Cases_on `n` \\ fs [])
-     \\ rw [] \\ numLib.LEAST_ELIM_TAC
-     \\ conj_tac >- (asm_exists_tac \\ fs [])
-     \\ rw [] \\ numLib.LEAST_ELIM_TAC
-     \\ conj_tac >- (qexists_tac `ptr` \\ fs [])
-     \\ rw [] \\ CCONTR_TAC
-     \\ Cases_on `n' < n`
-     >- (first_x_assum drule \\ rw [])
-     \\ fs [NOT_LESS] \\ `n < n'` by rw []
-     \\ first_x_assum drule \\ rw[]
-     \\ Cases_on `n` \\ fs [])
-  \\ rveq \\ pop_assum kall_tac
-  (* strip_makespace *)
-  \\ qmatch_goalsub_abbrev_tac `bind _ rest_mkspc _`
-  \\ REWRITE_TAC [ bind_def, makespace_def, add_space_def]
-  \\ simp []
-  \\ eval_goalsub_tac ``dataSem$cut_env _ _`` \\ simp []
-  \\ Q.UNABBREV_TAC `rest_mkspc`
-  \\ ntac 2 strip_assign
-  \\ strip_assign \\ fs []
-  \\ Q.ABBREV_TAC `pred = ∃w. 10 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 10` \\ rw [])
-  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
-  \\ ntac 6 (strip_assign \\ fs [])
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  (* strip_call *)
-  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
-  \\ ONCE_REWRITE_TAC [bind_def]
-  \\ simp [ call_def     , find_code_def  , push_env_def
-          , get_vars_def , call_env_def   , dec_clock_def
-          , cut_env_def  , domain_def     , data_safe_def
-          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
-          , lookup_def   , domain_IS_SOME , frame_lookup
-          , code_lookup  , lookup_def     , domain_IS_SOME
-          , flush_state_def
-          , size_of_stack_frame_def]
-  \\ `lookup p1 s.refs = NONE`  by
-     (Q.UNABBREV_TAC `p1` \\ fs [least_from_def]
-     \\ EVERY_CASE_TAC \\ fs [] \\ numLib.LEAST_ELIM_TAC
-     >- metis_tac []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-     \\ rw [] \\ pop_assum (qspec_then `domain s.refs` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup]
-     \\ Cases_on `lookup x s.refs` \\ fs []
-     \\ asm_exists_tac \\ fs [])
-  \\ `p1 ≠ 2` by (CCONTR_TAC  \\ fs [])
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  (* strip_assign *)
-  \\ strip_assign
-  \\ make_if
-  \\ ntac 6 strip_assign
-  (* open_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ ntac 6 strip_assign
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ Q.UNABBREV_TAC `rest_call2`
-  (* strip_assign *)
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
-  \\ ONCE_REWRITE_TAC [bind_def]
-  \\ simp [ call_def     , find_code_def  , push_env_def
-          , get_vars_def , call_env_def   , dec_clock_def
-          , cut_env_def  , domain_def     , data_safe_def
-          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
-          , lookup_def   , domain_IS_SOME , frame_lookup
-          , code_lookup  , lookup_def     , domain_IS_SOME
-          , flush_state_def
-          , size_of_stack_frame_def]
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  (* strip_assign *)
-  \\ strip_assign
-  \\ make_if
-  \\ qmatch_goalsub_abbrev_tac `dataSem$state_refs_fupd (K (insert p2 _ _)) _`
-  \\ fs [insert_shadow]
-  \\ `lookup p2 s.refs = NONE` by
-  (Q.UNABBREV_TAC `p2`
-  \\ rw [least_from_def]
-  >- (Cases_on `0 = p1` \\ fs [])
-  >- (numLib.LEAST_ELIM_TAC \\ rw []
-     \\ Cases_on `ptr = p1` \\ fs []
-     \\ qexists_tac `ptr` \\ fs [])
-  \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-  \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-  \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
-  \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
-  \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `2 ≠ p2` by (CCONTR_TAC  \\ fs [])
-  \\ ntac 8 strip_assign
-  (* make_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  \\ fs [insert_shadow]
-  \\ `p1 ≠ p2` by
-  (Q.UNABBREV_TAC `p2`
-  \\ rw [least_from_def]
-  >- (Cases_on `0 = p1` \\ fs [])
-  >- (numLib.LEAST_ELIM_TAC \\ rw []
-     \\ Cases_on `ptr = p1` \\ fs []
-     \\ qexists_tac `ptr` \\ fs [])
-  \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-  \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-  \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
-  \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
-  \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `2 ≠ p2` by (CCONTR_TAC  \\ fs [])
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ ntac 8 strip_assign
-  (* make_tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def]
-  \\ simp [code_lookup,lookup_def,frame_lookup]
-  \\ fs [insert_shadow]
-  \\ IF_CASES_TAC >- simp [data_safe_def]
-  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
-                 , to_shallow_thm , to_shallow_def ]
-  \\ simp [LET_DEF]
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ strip_assign
-  \\ make_if
-  \\ Q.UNABBREV_TAC `rest_call2`
-  \\ strip_assign
-  \\ strip_assign
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
-  \\ qmatch_goalsub_abbrev_tac `dataSem$state_refs_fupd (K (insert p3 _ _)) _`
-  \\ qmatch_goalsub_abbrev_tac `insert _ (RefPtr pp3) _`
-  \\ `pp3 = p3` by
-     (rw [Abbr`pp3`,Abbr`p3`,least_from_def]
-     >- (Cases_on `0 = p2` \\ fs []
-        \\ Cases_on `0 = p1` \\ fs []
-        \\ numLib.LEAST_ELIM_TAC
-        \\ rw []
-        >- (mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-           \\ rw [] \\ pop_assum (qspec_then `domain ((insert p2 ARB (insert p1 ARB s.refs)))` assume_tac)
-           \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
-           \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ Cases_on `x = p2` \\ fs [lookup_insert])
-        \\ CCONTR_TAC \\ `0 < n` by rw []
-        \\ first_x_assum drule \\ rw [])
-     \\ fs [] \\ numLib.LEAST_ELIM_TAC
-     \\ conj_tac >- (asm_exists_tac \\ fs [])
-     \\ numLib.LEAST_ELIM_TAC
-     \\ conj_tac >- (asm_exists_tac \\ fs [])
-     \\ rw [] \\ Cases_on `n' < n`
-     >- (first_x_assum drule \\ rw [] \\ Cases_on `n'` \\ fs [])
-     \\ fs [NOT_LESS]
-     \\ CCONTR_TAC
-     \\ `n < n'` by rw []
-     \\ first_x_assum drule \\ rw[]
-     \\ Cases_on `n` \\ fs [])
-  \\ rveq \\ pop_assum kall_tac
-  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
-  \\ `p3 ≠ p2` by
-     (rw [Abbr `p3`,least_from_def]
-     >- (CCONTR_TAC \\ fs [])
-     >- (numLib.LEAST_ELIM_TAC \\ rw []
-        \\ asm_exists_tac \\ fs [])
-     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV \\ rw []
-     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup]
-     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
-     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `p3 ≠ p1` by
-     (rw [Abbr `p3`,least_from_def]
-     >- (CCONTR_TAC \\ fs [] \\ rfs [])
-     >- (numLib.LEAST_ELIM_TAC \\ rw []
-        \\ asm_exists_tac \\ fs [])
-     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV \\ rw []
-     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup]
-     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
-     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `lookup p3 s.refs = NONE` by
-     (Q.UNABBREV_TAC `p3`
-     \\ rw [least_from_def]
-     >- (Cases_on `0 = p2` \\ Cases_on `0 = p1` \\ fs [])
-     >- (numLib.LEAST_ELIM_TAC \\ rw []
-        \\ Cases_on `ptr = p2`
-        \\ Cases_on `ptr = p1`
-        \\ fs []
-        \\ qexists_tac `ptr` \\ fs [])
-     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
-     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
-     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
-     \\ fs [FINITE_domain,domain_lookup]
-     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
-     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
-  \\ `2 ≠ p3` by (CCONTR_TAC  \\ fs [])
-  \\ strip_assign
-  \\ fs [lookup_insert]
-  \\ reverse (Cases_on `call_FFI s.ffi "put_char" [121w; 10w] []`
-             \\ fs [])
-  \\ strip_assign \\ strip_assign
-  \\ simp [return_def,lookup_def,data_safe_def]
-  \\ rpt (pairarg_tac \\ fs [])
-  \\ rfs [insert_shadow,size_of_Number_head]
-  \\ rveq \\ fs [flush_state_def]
-  \\ Q.UNABBREV_TAC `rest_call`
-  (* strip tailcall *)
-  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
-                     , get_vars_def , get_var_def
-                     , lookup_def   , timeout_def
-                     , flush_state_def ]
-  \\ simp [code_lookup,lookup_def,lookup_insert,lookup_inter,frame_lookup]
-  \\ IF_CASES_TAC
-  >- fs [data_safe_def,GREATER_DEF,libTheory.the_def,size_of_stack_def]
-  \\ simp[dec_clock_def]
-  \\ eval_goalsub_tac ``dataSem$call_env _ _``
-  \\ qmatch_goalsub_abbrev_tac `f0 (evaluate _)`
-  \\ qmatch_goalsub_abbrev_tac `f0 e0`
-  \\ reverse (sg `∃s' e. e0 = (SOME (Rerr (Rabort e)),s')`)
-  \\ fs [Abbr`f0`,Abbr`e0`]
-  \\ qmatch_goalsub_abbrev_tac `evaluate (p0,s0)`
-  \\ `s0.clock < s.clock` by fs [Abbr `s0`,dec_clock_def]
-  \\ first_x_assum (drule_then (qspec_then `ts + 2` mp_tac))
-  \\ impl_tac >- (fs [Abbr `s0`,lookup_insert,call_env_def] \\ EVAL_TAC)
-  \\ rw [Abbr`p0`,to_shallow_def,to_shallow_thm] \\ fs []
-  end
-QED
-
-Theorem data_safe_yes_code_abort_shallow[local] =
-  data_safe_yes_code_abort |> simp_rule [to_shallow_thm,to_shallow_def]
-
-Theorem data_safe_yes:
- ∀ffi.
-  backend_config_ok ^yes_x64_conf
-  ⇒ is_safe_for_space ffi
-       yes_x64_conf
-       yes_prog
-       (56,89)
-Proof
- let
-  val code_lookup   = mk_code_lookup
-                        `fromAList yes_data_prog`
-                         yes_data_code_def
-  val frame_lookup   = mk_frame_lookup
-                        `yes_config.word_conf.stack_frame_size`
-                         yes_config_def
-  val strip_assign  = mk_strip_assign code_lookup frame_lookup
-  val open_call     = mk_open_call code_lookup frame_lookup
-  val make_call     = mk_make_call open_call
-  val strip_call    = mk_strip_call open_call
-  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
-  val make_tailcall = mk_make_tailcall open_tailcall
- in
- REWRITE_TAC [yes_prog_def,yes_x64_conf_def]
- \\ strip_tac \\ strip_tac
- \\ irule IMP_is_safe_for_space_alt \\ fs []
- \\ conj_tac >- EVAL_TAC
- \\ assume_tac yes_thm
- \\ asm_exists_tac \\ fs []
- \\ assume_tac yes_to_data_updated_thm
- \\ fs [data_lang_safe_for_space_def]
- \\ strip_tac
- \\ qmatch_goalsub_abbrev_tac `_ v0`
- \\ `data_safe v0` suffices_by
-    (Cases_on `v0` \\ fs [data_safe_def])
- \\ UNABBREV_ALL_TAC
- \\ qmatch_goalsub_abbrev_tac `is_64_bits c0`
- \\ `is_64_bits c0` by (UNABBREV_ALL_TAC \\ EVAL_TAC)
- \\ fs []
- \\ rpt (pop_assum kall_tac)
- (* start data_safe proof *)
- \\ REWRITE_TAC [ to_shallow_thm
-                , to_shallow_def
-                , initial_state_def
-                , bvl_to_bviTheory.InitGlobals_location_eq]
-  (* Make first call *)
- \\ rpt strip_tac
- \\ make_tailcall
- (* Bootcode *)
- \\ ntac 7 strip_assign
- \\ ho_match_mp_tac data_safe_bind_return
- (* Yet another call *)
- \\ make_call
- \\ strip_call
- \\ ntac 9 strip_assign
- \\ make_if
- \\ UNABBREV_ALL_TAC
- (* Continues after call *)
- \\ strip_makespace
- \\ ntac 49 strip_assign
- \\ make_tailcall
- \\ ntac 5
-    (strip_call
-    \\ ntac 9 strip_assign
-    \\ make_if
-    \\ UNABBREV_ALL_TAC)
-  \\ strip_call
-  \\ ntac 9 strip_assign
-  \\ make_if
-  \\ ntac 6 strip_assign
-  \\ ntac 6
-     (open_tailcall
-     \\ ntac 4 strip_assign
-     \\ make_if
-     \\ ntac 2 strip_assign)
-  \\ open_tailcall
-  \\ ntac 4 strip_assign
-  \\ make_if
-  \\ Q.UNABBREV_TAC `rest_call`
-  \\ ntac 3 strip_assign
-  \\ make_tailcall
-  \\ ntac 5
-     (strip_makespace
-     \\ ntac 7 strip_assign
-     \\ make_tailcall)
-  \\ ntac 2 strip_assign
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
-  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
-  \\ ntac 2 strip_assign
-  \\ strip_assign
-  \\ Q.ABBREV_TAC `pred = ∃w. 121 = w2n (w:word8)`
-  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 121` \\ rw [])
-  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
-  \\ ho_match_mp_tac data_safe_bind_some
-  \\ open_call
-  \\ qmatch_goalsub_abbrev_tac `f (state_locals_fupd _ _)`
-  \\ qmatch_goalsub_abbrev_tac `f s`
-  \\ `∃s' e'. f s = (SOME (Rerr (Rabort e')),s')`
-     by (UNABBREV_ALL_TAC
-        \\ ho_match_mp_tac data_safe_yes_code_abort_shallow
-        \\ fs [] \\ EVAL_TAC)
-  \\ `data_safe (f s)` suffices_by (rw [] \\ rfs [])
-  \\ unabbrev_all_tac
-  \\ ho_match_mp_tac data_safe_yes_code_shallow
-  \\ rw [lookup_def,lookup_fromList,code_lookup]
-  \\ EVAL_TAC
-  \\ qexists_tac `12` \\ fs []
-  end
-QED
-
-Theorem yes_s_def = mk_abbrev"yes_s"
-                      ((rand o rand o rhs o concl) primSemEnvTheory.prim_sem_env_eq)
-
-Definition yes_env_def:
-  yes_env ffi = FST (THE (prim_sem_env sio_ffi_state))
-End
-
-Theorem prim_sem_env_yes:
-  THE (prim_sem_env sio_ffi_state) = (yes_env ffi,yes_s)
-Proof
-EVAL_TAC \\ rw [yes_s_def]
-QED
-
-Theorem backend_config_ok_yes:
-  backend_config_ok yes_x64_conf
-Proof
- assume_tac x64_backend_config_ok
- \\ fs [backend_config_ok_def,yes_x64_conf_def,x64_backend_config_def]
-QED
-
-Theorem yes_semantics_prog_not_Fail:
-  let (s,env) = THE (prim_sem_env sio_ffi_state)
-  in ¬semantics_prog s env yes_prog Fail
-Proof
-  assume_tac yes_semantics_prog_Diverge
-  \\ fs [] \\ pairarg_tac \\  fs []
-  \\ CCONTR_TAC \\ fs []
-  \\ drule semanticsPropsTheory.semantics_prog_deterministic
-  \\ pop_assum kall_tac
-  \\ disch_then drule
-  \\ fs []
-QED
-
-Theorem IMP_IMP_TRANS_THM:
-  ∀W P R Q. (W ⇒ Q) ⇒ (P ⇒ R ⇒ W) ⇒ P ⇒ R ⇒ Q
-Proof
- rw []
-QED
-
-Theorem machine_sem_eq_semantics_prog:
-semantics_prog s env prog (Diverge io_trace) ⇒
-  (machine_sem mc (ffi:'ffi ffi_state) ms = semantics_prog s env prog) ⇒
-     machine_sem mc ffi ms (Diverge io_trace)
-Proof
-  rw []
-QED
-
-Theorem machine_sem_eq_semantics_prog_ex:
-(∃io_trace. semantics_prog s env prog (Diverge io_trace)) ⇒
-  (machine_sem mc (ffi:'ffi ffi_state) ms = semantics_prog s env prog) ⇒
-     (∃io_trace. machine_sem mc ffi ms (Diverge io_trace))
-Proof
-  rw []
-QED
-
-val yes_safe_thm =
-    let
-      val ffi = ``sio_ffi_state``
-      val is_safe = data_safe_yes
-                    |> REWRITE_RULE [GSYM yes_prog_def
-                                    ,GSYM yes_x64_conf_def]
-                    |> ISPEC ffi
-      val not_fail = yes_semantics_prog_not_Fail
-                     |> SIMP_RULE std_ss [LET_DEF,prim_sem_env_yes
-                                         ,ELIM_UNCURRY]
-      val is_corr = MATCH_MP compile_correct_is_safe_for_space yes_thm
-                    |> REWRITE_RULE [GSYM yes_prog_def
-                                    ,GSYM yes_x64_conf_def]
-                    |> Q.INST [`stack_limit` |-> `56`
-                              ,`heap_limit` |-> `89`]
-                    |> INST_TYPE [``:'ffi`` |-> ``:unit``]
-                    |> Q.INST [`ffi` |-> `sio_ffi_state`]
-                    |> SIMP_RULE std_ss [prim_sem_env_yes,LET_DEF,not_fail,ELIM_UNCURRY]
-      val machine_eq = MATCH_MP (machine_sem_eq_semantics_prog |> INST_TYPE [``:'ffi`` |-> ``:unit``])
-                                (yes_semantics_prog_Diverge
-                                   |> SIMP_RULE std_ss [LET_DEF,prim_sem_env_yes,ELIM_UNCURRY])
-      val safe_thm_aux = MATCH_MP (IMP_TRANS is_safe is_corr) backend_config_ok_yes
-    in MATCH_MP (MATCH_MP IMP_IMP_TRANS_THM machine_eq)
-                (safe_thm_aux |> SIMP_RULE std_ss [prim_sem_env_yes,LET_DEF,ELIM_UNCURRY,backend_config_ok_yes])
-    end
-
-Theorem yes_has_space_for_dessert:
- (read_limits yes_x64_conf mc ms = (56,89)) ⇒
-      mc_conf_ok mc ∧ mc_init_ok yes_x64_conf mc ∧
-      installed yes_code cbspace yes_data data_sp
-        yes_config.lab_conf.ffi_names sio_ffi_state
-        (heap_regs yes_x64_conf.stack_conf.reg_names) mc ms ⇒
-      machine_sem mc sio_ffi_state ms
-        (Diverge (LREPEAT [put_str_event «y\n» ]))
-Proof
-  rw [] \\ drule yes_safe_thm
-  \\ rpt (disch_then drule)
-  \\ simp []
-QED
+  |> SIMP_RULE (srw_ss()) [];
 
-val _ = check_thm yes_has_space_for_dessert;
+Theorem yes_data_code_def = yes_data_code_def;
+Theorem yes2_data_code_def = yes2_data_code_def;
 
 val _ = export_theory();
diff --git a/examples/cost/yesProofScript.sml b/examples/cost/yesProofScript.sml
new file mode 100644
index 0000000000..577e796c1d
--- /dev/null
+++ b/examples/cost/yesProofScript.sml
@@ -0,0 +1,1266 @@
+(*
+  Prove that yes never exits prematurely.
+*)
+
+open preamble basis compilationLib;
+open backendProofTheory backendPropsTheory
+open costLib costPropsTheory
+open dataSemTheory data_monadTheory dataLangTheory;
+open miniBasisProgTheory;
+open x64_configProofTheory;
+open yesProgTheory;
+
+val _ = new_theory "yesProof"
+
+Overload monad_unitbind[local] = ``data_monad$bind``
+Overload return[local] = ``data_monad$return``
+val _ = monadsyntax.temp_add_monadsyntax()
+
+val yes_x64_conf = (rand o rator o lhs o concl) yes_thm
+
+val f_diff = diff_codes yes_data_code_def yes2_data_code_def;
+
+(* val (f11,f12) = hd f_diff *)
+val (f21,f22) = hd f_diff;
+
+Theorem data_safe_yes_code:
+  ∀s ts smax sstack lsize.
+   s.safe_for_space ∧
+   wf s.refs ∧
+   (s.stack_frame_sizes = yes_config.word_conf.stack_frame_size) ∧
+   (s.stack_max = SOME smax) ∧
+   (size_of_stack s.stack = SOME sstack) ∧
+   (s.locals_size = SOME lsize) ∧
+   (sstack + 17 < s.limits.stack_limit) ∧
+   (sstack + lsize + 14 < s.limits.stack_limit) ∧
+   (smax < s.limits.stack_limit) ∧
+   s.limits.arch_64_bit ∧
+   closed_ptrs (stack_to_vs s) s.refs ∧
+   size_of_heap s + 11 ≤ s.limits.heap_limit ∧
+   2 ≤ s.limits.length_limit ∧
+   (s.tstamps = SOME ts) ∧
+   0 < ts ∧
+   (s.locals = fromList [RefPtr 2]) ∧
+   (lookup 2 s.refs = SOME (ByteArray T [121w])) ∧
+   (s.code = fromAList yes_data_prog)
+   ⇒ data_safe (evaluate ((SND o SND) ^f21, s))
+Proof
+ let
+  val code_lookup   = mk_code_lookup
+                        `fromAList yes_data_prog`
+                         yes_data_code_def
+  val frame_lookup   = mk_frame_lookup
+                        `yes_config.word_conf.stack_frame_size`
+                         yes_config_def
+  val strip_assign  = mk_strip_assign code_lookup frame_lookup
+  val open_call     = mk_open_call code_lookup frame_lookup
+  val make_call     = mk_make_call open_call
+  val strip_call    = mk_strip_call open_call
+  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
+  val make_tailcall = mk_make_tailcall open_tailcall
+  in
+  measureInduct_on `^s.clock`
+  \\ fs [ to_shallow_thm
+        , to_shallow_def
+        , initial_state_def ]
+  \\ rw [] \\ fs [fromList_def]
+  \\ strip_call
+  \\ `1 < 2 ** s.limits.length_limit`
+     by (irule LESS_TRANS \\ qexists_tac `s.limits.length_limit` \\ fs [])
+  (* Make safe_for_space sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe) _`
+  \\ `safe` by (fs [Abbr `safe`, size_of_stack_def,GREATER_DEF] \\ EVAL_TAC)
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `dataSem$state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 6))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  (* strip_assign *)
+  \\ `2 < 2 ** s.limits.length_limit`
+     by (Cases_on `s.limits.length_limit` \\ fs [])
+  \\ ntac 2 strip_assign
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
+  \\ qmatch_goalsub_abbrev_tac `insert p1 _ s.refs`
+  \\ qmatch_goalsub_abbrev_tac `insert _ (RefPtr pp1) _`
+  \\ `pp1 = p1`  by
+     (UNABBREV_ALL_TAC \\ fs [least_from_def]
+     \\ Cases_on `lookup 0 s.refs` \\ fs []
+     >- (numLib.LEAST_ELIM_TAC
+        \\ conj_tac >- (asm_exists_tac \\ fs [])
+        \\ rw [] \\ Cases_on `n` \\ fs [])
+     \\ rw [] \\ numLib.LEAST_ELIM_TAC
+     \\ conj_tac >- (asm_exists_tac \\ fs [])
+     \\ rw [] \\ numLib.LEAST_ELIM_TAC
+     \\ conj_tac >- (qexists_tac `ptr` \\ fs [])
+     \\ rw [] \\ CCONTR_TAC
+     \\ Cases_on `n' < n`
+     >- (first_x_assum drule \\ rw [])
+     \\ fs [NOT_LESS] \\ `n < n'` by rw []
+     \\ first_x_assum drule \\ rw[]
+     \\ Cases_on `n` \\ fs [])
+  \\ rveq \\ pop_assum kall_tac
+  (* Make safe_for_space sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_stack_def]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [MAX_DEF,GREATER_DEF,libTheory.the_def,small_num_def]
+     \\ fs [Once insert_def,toList_def,toListA_def]
+     \\ rveq \\ fs []
+     \\ qmatch_asmsub_rename_tac `size_of _ _ _ _ = (_,refs'',seen'')`
+     \\ drule size_of_RefPtr_head
+     \\ eval_goalsub_tac ``sptree$lookup _ _``
+     \\ rw [] \\ fs [])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `dataSem$state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  (* strip_makespace *)
+  \\ qmatch_goalsub_abbrev_tac `bind _ rest_mkspc _`
+  \\ REWRITE_TAC [ bind_def, makespace_def, add_space_def]
+  \\ simp []
+  \\ eval_goalsub_tac ``dataSem$cut_env _ _`` \\ simp []
+  \\ Q.UNABBREV_TAC `rest_mkspc`
+  \\ ntac 2 strip_assign
+  \\ strip_assign \\ fs []
+  \\ Q.ABBREV_TAC `pred = ∃w. 10 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 10` \\ rw [])
+  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
+  \\ ntac 6 (strip_assign \\ fs [])
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  (* strip_call *)
+  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
+  \\ ONCE_REWRITE_TAC [bind_def]
+  \\ simp [ call_def     , find_code_def  , push_env_def
+          , get_vars_def , call_env_def   , dec_clock_def
+          , cut_env_def  , domain_def     , data_safe_def
+          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
+          , lookup_def   , domain_IS_SOME , frame_lookup
+          , code_lookup  , lookup_def     , domain_IS_SOME
+          , flush_state_def
+          , size_of_stack_frame_def]
+  \\ `lookup p1 s.refs = NONE`  by
+     (Q.UNABBREV_TAC `p1` \\ fs [least_from_def]
+     \\ EVERY_CASE_TAC \\ fs [] \\ numLib.LEAST_ELIM_TAC
+     >- metis_tac []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+     \\ rw [] \\ pop_assum (qspec_then `domain s.refs` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup]
+     \\ Cases_on `lookup x s.refs` \\ fs []
+     \\ asm_exists_tac \\ fs [])
+  \\ `p1 ≠ 2` by (CCONTR_TAC  \\ fs [])
+  (* Prove we are safe for space up to this point *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_stack_def]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [MAX_DEF,GREATER_DEF,libTheory.the_def]
+     \\ fs [Once insert_def,toList_def,toListA_def]
+     \\ drule size_of_insert
+     \\ rpt (disch_then drule)
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert] \\ rveq
+     \\ drule_then drule wf_size_of
+     \\ strip_tac
+     \\ drule_then (qspecl_then [`p1`,`ByteArray T [0w]`] mp_tac) delete_insert_eq
+     \\ impl_tac
+     >- (drule_then drule size_of_lookup_NONE \\ fs [])
+     \\ drule size_of_RefPtr_head
+     \\ eval_goalsub_tac ``sptree$lookup _ _``
+     \\ rw [] \\ fs [])
+  \\ simp []
+  \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  (* strip_assign *)
+  \\ strip_assign
+  \\ make_if
+  \\ ntac 6 strip_assign
+  (* open_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  (* Prove we are safe for space up to this point *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     (* \\ Cases_on `ts` *)
+     \\ fs [size_of_def,lookup_def,GREATER_DEF,libTheory.the_def
+           ,size_of_stack_def,insert_shadow]
+     \\ fs [Once insert_def,toList_def,toListA_def]
+     \\ drule size_of_insert
+     \\ rpt (disch_then drule)
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert] \\ rveq \\ fs []
+     \\ qmatch_asmsub_rename_tac `size_of _ _ s.refs LN = (_,_,seen0)`
+     \\ Cases_on `IS_SOME (lookup (ts + 1) seen0)` \\ fs []
+     >- (rveq \\ fs [] \\ rveq \\ fs []
+        \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs []
+        \\ rveq \\ rw[arch_size_def])
+     \\ rveq \\ fs []
+     \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs []
+     >- (fs [] \\ rveq
+        \\ Cases_on `IS_SOME (lookup ts seen')` \\ fs []
+        \\ rveq \\ fs [lookup_insert] \\ rfs []
+        \\ drule size_of_RefPtr_head
+        \\ strip_tac \\ fs []
+        \\ rveq \\ fs []
+        \\ rveq \\ fs []
+        \\ rw[arch_size_def])
+     \\ rveq \\ fs [lookup_delete,lookup_insert] \\ rfs []
+     \\ drule size_of_RefPtr_head
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_delete]
+     \\ rw[arch_size_def])
+  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  (* Prove we are safe for space up to this point *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_def,lookup_def,GREATER_DEF,libTheory.the_def
+           ,size_of_stack_def,insert_shadow])
+  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ strip_assign
+  \\ make_if
+  \\ ntac 6 strip_assign
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  (* Prove we are safe for space up to this point *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     (* \\ Cases_on `ts` *)
+     \\ fs [size_of_def,lookup_def,GREATER_DEF,libTheory.the_def
+           ,size_of_stack_def,insert_shadow]
+     \\ fs [Once insert_def,toList_def,toListA_def]
+     \\ drule size_of_insert
+     \\ rpt (disch_then drule)
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert] \\ rveq \\ fs []
+     \\ qmatch_asmsub_rename_tac `size_of _ _ s.refs LN = (_,_,seen0)`
+     \\ Cases_on `IS_SOME (lookup (ts + 1) seen0)` \\ fs []
+     \\ rveq \\ fs []
+     \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs [lookup_delete]
+     >- (rveq \\ fs [lookup_insert] \\ rfs []
+        \\ drule size_of_RefPtr_head
+        \\ strip_tac \\ fs [])
+     \\ rveq \\ fs [lookup_delete,lookup_insert] \\ rfs []
+     \\ drule size_of_RefPtr_head
+     \\ strip_tac \\ fs []
+     \\ rw[arch_size_def]
+     )
+  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 11))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ Q.UNABBREV_TAC `rest_call2`
+  (* strip_assign *)
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
+  \\ ONCE_REWRITE_TAC [bind_def]
+  \\ simp [ call_def     , find_code_def  , push_env_def
+          , get_vars_def , call_env_def   , dec_clock_def
+          , cut_env_def  , domain_def     , data_safe_def
+          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
+          , lookup_def   , domain_IS_SOME , frame_lookup
+          , code_lookup  , lookup_def     , domain_IS_SOME
+          , flush_state_def
+          , size_of_stack_frame_def]
+  (* Prove we are safe for space up to this point *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_def,lookup_def]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_Number_head,GREATER_DEF,libTheory.the_def
+           ,size_of_stack_def,insert_shadow]
+     \\ fs [Once insert_def,toList_def,toListA_def]
+     \\ drule size_of_insert
+     \\ rpt (disch_then drule)
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert] \\ rveq \\ fs []
+     \\ qmatch_asmsub_rename_tac `size_of _ _ s.refs LN = (_,_,seen0)`
+     \\ Cases_on `IS_SOME (lookup (ts + 1) seen0)` \\ fs []
+     \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs [lookup_delete]
+     >- (rveq \\ fs [lookup_insert] \\ rfs []
+        \\ drule size_of_RefPtr_head
+        \\ strip_tac \\ fs [])
+     \\ rveq \\ fs [lookup_delete,lookup_insert] \\ rfs []
+     \\ drule size_of_RefPtr_head
+     \\ strip_tac \\ fs []
+     \\ rw[arch_size_def])
+  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 14))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  (* strip_assign *)
+  \\ strip_assign
+  \\ make_if
+  \\ qmatch_goalsub_abbrev_tac `dataSem$state_refs_fupd (K (insert p2 _ _)) _`
+  \\ fs [insert_shadow]
+  \\ `lookup p2 s.refs = NONE` by
+  (Q.UNABBREV_TAC `p2`
+  \\ rw [least_from_def]
+  >- (Cases_on `0 = p1` \\ fs [])
+  >- (numLib.LEAST_ELIM_TAC \\ rw []
+     \\ Cases_on `ptr = p1` \\ fs []
+     \\ qexists_tac `ptr` \\ fs [])
+  \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+  \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+  \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
+  \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
+  \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `2 ≠ p2` by (CCONTR_TAC  \\ fs [])
+  \\ ntac 8 strip_assign
+  (* make_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  \\ fs [insert_shadow]
+  \\ `p1 ≠ p2` by
+  (Q.UNABBREV_TAC `p2`
+  \\ rw [least_from_def]
+  >- (Cases_on `0 = p1` \\ fs [])
+  >- (numLib.LEAST_ELIM_TAC \\ rw []
+     \\ Cases_on `ptr = p1` \\ fs []
+     \\ qexists_tac `ptr` \\ fs [])
+  \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+  \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+  \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
+  \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
+  \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `2 ≠ p2` by (CCONTR_TAC  \\ fs [])
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  (* Prove we are safe for space up to this point *)
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
+     \\ fs [Once insert_def,toList_def,toListA_def]
+     (* insert p1 *)
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
+     \\ rpt (disch_then drule)
+     \\ disch_then (qspec_then `ByteArray T [10w]` assume_tac)
+     \\ `wf (insert p1 (ByteArray T [10w]) s.refs)` by fs [wf_insert]
+     \\ drule closed_ptrs_insert
+     \\ disch_then (qspec_then `p1` mp_tac) \\ fs []
+     \\ disch_then (qspec_then `ByteArray T [10w]` mp_tac)
+     \\ impl_tac >- fs [closed_ptrs_def,closed_ptrs_refs_insert]
+     \\ strip_tac
+     (* insert p2 *)
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p2`] mp_tac)
+     \\ fs [lookup_insert]
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert] \\ rfs [] \\ rveq
+     \\ qmatch_asmsub_rename_tac `size_of _ _ _ LN = (n'',_,seen0)`
+     \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs [] \\ rveq
+     \\ fs [lookup_insert,lookup_delete] \\ rfs []
+     \\ rw [arch_size_def])
+  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 14))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ ntac 8 strip_assign
+  (* make_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  \\ fs [insert_shadow]
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  (* Prove we are safe for space up to this point *)
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
+     \\ fs [Once insert_def,toList_def,toListA_def]
+     (* insert p1 *)
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
+     \\ rpt (disch_then drule)
+     \\ disch_then (qspec_then `ByteArray T [10w]` assume_tac)
+     \\ `wf (insert p1 (ByteArray T [10w]) s.refs)` by fs [wf_insert]
+     \\ drule closed_ptrs_insert
+     \\ disch_then (qspec_then `p1` mp_tac) \\ fs []
+     \\ disch_then (qspec_then `ByteArray T [10w]` mp_tac)
+     \\ impl_tac >- fs [closed_ptrs_def,closed_ptrs_refs_insert]
+     \\ strip_tac
+     (* insert p2 *)
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p2`] mp_tac)
+     \\ fs [lookup_insert]
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert] \\ rfs [] \\ rveq
+     \\ qmatch_asmsub_rename_tac `size_of _ _ _ LN = (n'',_,seen0)`
+     \\ Cases_on `IS_SOME (lookup ts seen0)` \\ fs [] \\ rveq
+     \\ fs [lookup_insert,lookup_delete] \\ rfs [])
+  \\ simp [] \\ ntac 2 (pop_assum kall_tac)
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 14))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ Q.UNABBREV_TAC `rest_call2`
+  \\ strip_assign
+  \\ strip_assign
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
+  \\ qmatch_goalsub_abbrev_tac `dataSem$state_refs_fupd (K (insert p3 _ _)) _`
+  \\ qmatch_goalsub_abbrev_tac `insert _ (RefPtr pp3) _`
+  \\ `pp3 = p3` by
+     (rw [Abbr`pp3`,Abbr`p3`,least_from_def]
+     >- (Cases_on `0 = p2` \\ fs []
+        \\ Cases_on `0 = p1` \\ fs []
+        \\ numLib.LEAST_ELIM_TAC
+        \\ rw []
+        >- (mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+           \\ rw [] \\ pop_assum (qspec_then `domain ((insert p2 ARB (insert p1 ARB s.refs)))` assume_tac)
+           \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
+           \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ Cases_on `x = p2` \\ fs [lookup_insert])
+        \\ CCONTR_TAC \\ `0 < n` by rw []
+        \\ first_x_assum drule \\ rw [])
+     \\ fs [] \\ numLib.LEAST_ELIM_TAC
+     \\ conj_tac >- (asm_exists_tac \\ fs [])
+     \\ numLib.LEAST_ELIM_TAC
+     \\ conj_tac >- (asm_exists_tac \\ fs [])
+     \\ rw [] \\ Cases_on `n' < n`
+     >- (first_x_assum drule \\ rw [] \\ Cases_on `n'` \\ fs [])
+     \\ fs [NOT_LESS]
+     \\ CCONTR_TAC
+     \\ `n < n'` by rw []
+     \\ first_x_assum drule \\ rw[]
+     \\ Cases_on `n` \\ fs [])
+  \\ rveq \\ pop_assum kall_tac
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ `p3 ≠ p2` by
+     (rw [Abbr `p3`,least_from_def]
+     >- (CCONTR_TAC \\ fs [])
+     >- (numLib.LEAST_ELIM_TAC \\ rw []
+        \\ asm_exists_tac \\ fs [])
+     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV \\ rw []
+     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup]
+     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
+     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `p3 ≠ p1` by
+     (rw [Abbr `p3`,least_from_def]
+     >- (CCONTR_TAC \\ fs [] \\ rfs [])
+     >- (numLib.LEAST_ELIM_TAC \\ rw []
+        \\ asm_exists_tac \\ fs [])
+     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV \\ rw []
+     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup]
+     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
+     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `lookup p3 s.refs = NONE` by
+     (Q.UNABBREV_TAC `p3`
+     \\ rw [least_from_def]
+     >- (Cases_on `0 = p2` \\ Cases_on `0 = p1` \\ fs [])
+     >- (numLib.LEAST_ELIM_TAC \\ rw []
+        \\ Cases_on `ptr = p2`
+        \\ Cases_on `ptr = p1`
+        \\ fs []
+        \\ qexists_tac `ptr` \\ fs [])
+     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup]
+     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
+     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `2 ≠ p3` by (CCONTR_TAC  \\ fs [])
+  \\ strip_assign
+  \\ fs [lookup_insert]
+  (* Prove we are safe for space up to this point *)
+  \\ qmatch_goalsub_abbrev_tac `state_safe_for_space_fupd (K safe)  _`
+  \\ `safe` by
+     (Q.UNABBREV_TAC `safe`
+     \\ fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
+     \\ fs [Once insert_def,toList_def,toListA_def]
+     (* insert p1 *)
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
+     \\ rpt (disch_then drule)
+     \\ disch_then (qspec_then `ByteArray T [10w]` assume_tac)
+     \\ `wf (insert p1 (ByteArray T [10w]) s.refs)` by fs [wf_insert]
+     \\ drule closed_ptrs_insert
+     \\ disch_then (qspec_then `p1` mp_tac) \\ fs []
+     \\ disch_then (qspec_then `ByteArray T [10w]` mp_tac)
+     \\ impl_tac >- fs [closed_ptrs_def,closed_ptrs_refs_insert]
+     \\ strip_tac
+     (* insert p2 *)
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p2`] mp_tac)
+     \\ fs [lookup_insert]
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert] \\ rfs [] \\ rveq
+     \\ pop_assum (qspec_then `ByteArray T [121w; 10w]` assume_tac)
+     \\ `wf (insert p2 (ByteArray T [121w; 10w])
+              (insert p1 (ByteArray T [10w]) s.refs))` by fs [wf_insert]
+     \\ drule closed_ptrs_insert
+     \\ disch_then (qspec_then `p2` mp_tac) \\ fs []
+     \\ disch_then (qspec_then `ByteArray T [121w; 10w]` mp_tac)
+     \\ fs [lookup_insert]
+     \\ impl_tac
+     >- (irule closed_ptrs_refs_insert \\ fs [closed_ptrs_def,lookup_insert])
+     \\ strip_tac
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p3`] mp_tac)
+     \\ fs [lookup_insert]
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert]
+     \\ rfs [] \\ rveq \\ fs [] \\ rveq
+     \\ fs [lookup_delete]
+     \\ rfs [] \\ rveq \\ fs [] \\ rveq)
+  \\ simp[] \\ ntac 2 (pop_assum kall_tac) \\ fs []
+  \\ reverse (Cases_on `call_FFI s.ffi "put_char" [121w; 10w] []`
+             \\ fs [])
+  >- (fs [data_safe_def,GREATER_DEF,libTheory.the_def,size_of_stack_def]
+     \\ simp [data_safe_def,size_of_def,size_of_Number_head]
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
+     \\ fs [Once insert_def,toList_def,toListA_def]
+     (* insert p1 *)
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
+     \\ rpt (disch_then drule)
+     \\ disch_then (qspec_then `ByteArray T [10w]` assume_tac)
+     \\ `wf (insert p1 (ByteArray T [10w]) s.refs)` by fs [wf_insert]
+     \\ drule closed_ptrs_insert
+     \\ disch_then (qspec_then `p1` mp_tac) \\ fs []
+     \\ disch_then (qspec_then `ByteArray T [10w]` mp_tac)
+     \\ impl_tac >- fs [closed_ptrs_def,closed_ptrs_refs_insert]
+     \\ strip_tac
+     (* insert p2 *)
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p2`] mp_tac)
+     \\ fs [lookup_insert]
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert] \\ rfs [] \\ rveq
+     \\ simp [])
+  \\ strip_assign (* \\ strip_assign *)
+  \\ simp [return_def,lookup_def,data_safe_def]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rfs [insert_shadow,size_of_Number_head]
+  \\ rveq \\ fs [flush_state_def]
+  \\ Q.UNABBREV_TAC `rest_call`
+  (* strip tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def ]
+  \\ simp [code_lookup,lookup_def,lookup_insert,lookup_inter,frame_lookup]
+  \\ IF_CASES_TAC
+  >- fs [data_safe_def,GREATER_DEF,libTheory.the_def,size_of_stack_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ ho_match_mp_tac data_safe_res
+  \\ reverse conj_tac >- (rw [] \\ pairarg_tac \\ rw [])
+  (* Make stack_max sane to look at *)
+  \\ qmatch_goalsub_abbrev_tac `state_stack_max_fupd (K max0) _`
+  \\ `max0 = SOME (MAX smax (lsize + sstack + 14))` by
+     (fs [Abbr `max0`,size_of_stack_def,GREATER_DEF,MAX_DEF])
+  \\ ASM_REWRITE_TAC [] \\ ntac 2 (pop_assum kall_tac)
+  \\ qmatch_goalsub_abbrev_tac `data_safe (_ s0)`
+  \\ first_x_assum (qspec_then `s0` assume_tac)
+  \\ `s0.clock < s.clock` by (UNABBREV_ALL_TAC \\ rw [])
+  \\ first_x_assum (drule_then irule) \\ Q.UNABBREV_TAC `s0` \\  fs []
+  \\ simp [ size_of_heap_def,size_of_Number_head,stack_to_vs_def
+          , lookup_def,toList_def,toListA_def
+          , wf_insert, wf_delete ]
+  \\ rw []
+  >- fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
+  >- fs [GREATER_DEF,libTheory.the_def,size_of_stack_def]
+  >- (pairarg_tac \\ fs []
+     \\ fs [size_of_heap_def,stack_to_vs_def,size_of_Number_head]
+     \\ rpt (pairarg_tac \\ fs []) \\ rveq
+     \\ fs [size_of_Number_head,insert_shadow] \\ rveq
+     \\ fs [Once insert_def,toList_def,toListA_def]
+     \\ rveq \\ fs []
+     (* insert p1 *)
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p1`] mp_tac)
+     \\ rpt (disch_then drule)
+     \\ disch_then (qspec_then `ByteArray T [10w]` assume_tac)
+     \\ `wf (insert p1 (ByteArray T [10w]) s.refs)` by fs [wf_insert]
+     \\ drule closed_ptrs_insert
+     \\ disch_then (qspec_then `p1` mp_tac) \\ fs []
+     \\ disch_then (qspec_then `ByteArray T [10w]` mp_tac)
+     \\ impl_tac >- fs [closed_ptrs_def,closed_ptrs_refs_insert]
+     \\ strip_tac
+     (* insert p2 *)
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p2`] mp_tac)
+     \\ fs [lookup_insert]
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert] \\ rfs [] \\ rveq
+     \\ pop_assum (qspec_then `ByteArray T [121w; 10w]` assume_tac)
+     \\ `wf (insert p2 (ByteArray T [121w; 10w])
+              (insert p1 (ByteArray T [10w]) s.refs))` by fs [wf_insert]
+     \\ drule closed_ptrs_insert
+     \\ disch_then (qspec_then `p2` mp_tac) \\ fs []
+     \\ disch_then (qspec_then `ByteArray T [121w; 10w]` mp_tac)
+     \\ fs [lookup_insert]
+     \\ impl_tac
+     >- (irule closed_ptrs_refs_insert \\ fs [closed_ptrs_def,lookup_insert])
+     \\ strip_tac
+     \\ drule_then drule size_of_insert
+     \\ disch_then (qspecl_then [`s.limits`,`LN`,`p3`] mp_tac)
+     \\ fs [lookup_insert]
+     \\ strip_tac \\ fs [] \\ rveq
+     \\ fs [lookup_insert]
+     \\ rfs [] \\ rveq \\ fs [] \\ rveq
+     \\ fs [lookup_delete]
+     \\ rfs [] \\ rveq \\ fs [] \\ rveq)
+  >- fs [lookup_insert]
+  >- rw [Once insert_def]
+  \\ ho_match_mp_tac closed_ptrs_insert
+  \\ fs [lookup_insert] \\ reverse conj_tac
+  >- (ho_match_mp_tac closed_ptrs_refs_insert \\ fs [lookup_insert]
+     \\ ho_match_mp_tac closed_ptrs_refs_insert \\ fs [lookup_insert]
+     \\ ho_match_mp_tac closed_ptrs_refs_insert \\ fs [lookup_insert]
+     \\ fs [closed_ptrs_def])
+  \\ ho_match_mp_tac closed_ptrs_insert
+  \\ fs [lookup_insert] \\ reverse conj_tac
+  >- (ho_match_mp_tac closed_ptrs_refs_insert \\ fs [lookup_insert]
+     \\ ho_match_mp_tac closed_ptrs_refs_insert \\ fs [lookup_insert]
+     \\ fs [closed_ptrs_def])
+  \\ ho_match_mp_tac closed_ptrs_insert
+  \\ fs [lookup_insert] \\ reverse conj_tac
+  >- (ho_match_mp_tac closed_ptrs_refs_insert \\ fs [closed_ptrs_def])
+  \\ ONCE_REWRITE_TAC [closed_ptrs_cons]
+  \\ conj_tac >- fs [closed_ptrs_APPEND,stack_to_vs_def]
+  \\ fs [closed_ptrs_def,closed_ptrs_list_def]
+  end
+QED
+
+Theorem data_safe_yes_code_shallow[local] =
+  data_safe_yes_code |> simp_rule [to_shallow_thm,to_shallow_def]
+
+Theorem data_safe_yes_code_abort:
+ ∀s ts.
+   (s.locals = fromList [RefPtr 2]) ∧
+   (lookup 2 s.refs = SOME (ByteArray T [121w])) ∧
+   2 ≤ s.limits.length_limit ∧
+   (s.stack_frame_sizes = yes_config.word_conf.stack_frame_size) ∧
+   s.limits.arch_64_bit ∧
+   (s.tstamps = SOME ts) ∧
+   (s.code = fromAList yes_data_prog)
+   ⇒ ∃s' e. evaluate ((SND o SND) ^f21, s) =
+       (SOME (Rerr (Rabort e)),s')
+Proof
+ let
+  val code_lookup   = mk_code_lookup
+                        `fromAList yes_data_prog`
+                         yes_data_code_def
+  val frame_lookup   = mk_frame_lookup
+                        `yes_config.word_conf.stack_frame_size`
+                         yes_config_def
+  val strip_assign  = mk_strip_assign code_lookup frame_lookup
+  val open_call     = mk_open_call code_lookup frame_lookup
+  val make_call     = mk_make_call open_call
+  val strip_call    = mk_strip_call open_call
+  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
+  val make_tailcall = mk_make_tailcall open_tailcall
+  in
+  measureInduct_on `^s.clock`
+  \\ fs [ to_shallow_thm
+        , to_shallow_def
+        , initial_state_def ]
+  \\ rw [] \\ fs [fromList_def]
+  \\ strip_call
+  \\ `1 < 2 ** s.limits.length_limit`
+     by (irule LESS_TRANS \\ qexists_tac `s.limits.length_limit` \\ fs [])
+  \\ `2 < 2 ** s.limits.length_limit`
+     by (Cases_on `s.limits.length_limit` \\ fs [])
+  \\ ntac 2 strip_assign
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
+  \\ qmatch_goalsub_abbrev_tac `insert p1 _ s.refs`
+  \\ qmatch_goalsub_abbrev_tac `insert _ (RefPtr pp1) _`
+  \\ `pp1 = p1`  by
+     (UNABBREV_ALL_TAC \\ fs [least_from_def]
+     \\ Cases_on `lookup 0 s.refs` \\ fs []
+     >- (numLib.LEAST_ELIM_TAC
+        \\ conj_tac >- (asm_exists_tac \\ fs [])
+        \\ rw [] \\ Cases_on `n` \\ fs [])
+     \\ rw [] \\ numLib.LEAST_ELIM_TAC
+     \\ conj_tac >- (asm_exists_tac \\ fs [])
+     \\ rw [] \\ numLib.LEAST_ELIM_TAC
+     \\ conj_tac >- (qexists_tac `ptr` \\ fs [])
+     \\ rw [] \\ CCONTR_TAC
+     \\ Cases_on `n' < n`
+     >- (first_x_assum drule \\ rw [])
+     \\ fs [NOT_LESS] \\ `n < n'` by rw []
+     \\ first_x_assum drule \\ rw[]
+     \\ Cases_on `n` \\ fs [])
+  \\ rveq \\ pop_assum kall_tac
+  (* strip_makespace *)
+  \\ qmatch_goalsub_abbrev_tac `bind _ rest_mkspc _`
+  \\ REWRITE_TAC [ bind_def, makespace_def, add_space_def]
+  \\ simp []
+  \\ eval_goalsub_tac ``dataSem$cut_env _ _`` \\ simp []
+  \\ Q.UNABBREV_TAC `rest_mkspc`
+  \\ ntac 2 strip_assign
+  \\ strip_assign \\ fs []
+  \\ Q.ABBREV_TAC `pred = ∃w. 10 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 10` \\ rw [])
+  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
+  \\ ntac 6 (strip_assign \\ fs [])
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  (* strip_call *)
+  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
+  \\ ONCE_REWRITE_TAC [bind_def]
+  \\ simp [ call_def     , find_code_def  , push_env_def
+          , get_vars_def , call_env_def   , dec_clock_def
+          , cut_env_def  , domain_def     , data_safe_def
+          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
+          , lookup_def   , domain_IS_SOME , frame_lookup
+          , code_lookup  , lookup_def     , domain_IS_SOME
+          , flush_state_def
+          , size_of_stack_frame_def]
+  \\ `lookup p1 s.refs = NONE`  by
+     (Q.UNABBREV_TAC `p1` \\ fs [least_from_def]
+     \\ EVERY_CASE_TAC \\ fs [] \\ numLib.LEAST_ELIM_TAC
+     >- metis_tac []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+     \\ rw [] \\ pop_assum (qspec_then `domain s.refs` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup]
+     \\ Cases_on `lookup x s.refs` \\ fs []
+     \\ asm_exists_tac \\ fs [])
+  \\ `p1 ≠ 2` by (CCONTR_TAC  \\ fs [])
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  (* strip_assign *)
+  \\ strip_assign
+  \\ make_if
+  \\ ntac 6 strip_assign
+  (* open_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ ntac 6 strip_assign
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ Q.UNABBREV_TAC `rest_call2`
+  (* strip_assign *)
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ qmatch_goalsub_abbrev_tac (`bind _ rest_call2 _`)
+  \\ ONCE_REWRITE_TAC [bind_def]
+  \\ simp [ call_def     , find_code_def  , push_env_def
+          , get_vars_def , call_env_def   , dec_clock_def
+          , cut_env_def  , domain_def     , data_safe_def
+          , EMPTY_SUBSET , get_var_def    , size_of_stack_def
+          , lookup_def   , domain_IS_SOME , frame_lookup
+          , code_lookup  , lookup_def     , domain_IS_SOME
+          , flush_state_def
+          , size_of_stack_frame_def]
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ push_env_def , to_shallow_def , to_shallow_thm]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  (* strip_assign *)
+  \\ strip_assign
+  \\ make_if
+  \\ qmatch_goalsub_abbrev_tac `dataSem$state_refs_fupd (K (insert p2 _ _)) _`
+  \\ fs [insert_shadow]
+  \\ `lookup p2 s.refs = NONE` by
+    (Q.UNABBREV_TAC `p2`
+    \\ rw [least_from_def]
+    >- (Cases_on `0 = p1` \\ fs [])
+    >- (numLib.LEAST_ELIM_TAC \\ rw []
+       \\ Cases_on `ptr = p1` \\ fs []
+       \\ qexists_tac `ptr` \\ fs [])
+    \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+    \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+    \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
+    \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
+    \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `2 ≠ p2` by (CCONTR_TAC  \\ fs [])
+  \\ ntac 8 strip_assign
+  (* make_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  \\ fs [insert_shadow]
+  \\ `p1 ≠ p2` by
+  (Q.UNABBREV_TAC `p2`
+  \\ rw [least_from_def]
+  >- (Cases_on `0 = p1` \\ fs [])
+  >- (numLib.LEAST_ELIM_TAC \\ rw []
+     \\ Cases_on `ptr = p1` \\ fs []
+     \\ qexists_tac `ptr` \\ fs [])
+  \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+  \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+  \\ rw [] \\ pop_assum (qspec_then `domain (insert p1 ARB s.refs)` assume_tac)
+  \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p1 ARB s.refs)`
+  \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `2 ≠ p2` by (CCONTR_TAC  \\ fs [])
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ ntac 8 strip_assign
+  (* make_tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def]
+  \\ simp [code_lookup,lookup_def,frame_lookup]
+  \\ fs [insert_shadow]
+  \\ IF_CASES_TAC >- simp [data_safe_def]
+  \\ REWRITE_TAC [ call_env_def   , dec_clock_def
+                 , to_shallow_thm , to_shallow_def ]
+  \\ simp [LET_DEF]
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ strip_assign
+  \\ make_if
+  \\ Q.UNABBREV_TAC `rest_call2`
+  \\ strip_assign
+  \\ strip_assign
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ pop_assum kall_tac \\ pop_assum kall_tac
+  \\ qmatch_goalsub_abbrev_tac `dataSem$state_refs_fupd (K (insert p3 _ _)) _`
+  \\ qmatch_goalsub_abbrev_tac `insert _ (RefPtr pp3) _`
+  \\ `pp3 = p3` by
+     (rw [Abbr`pp3`,Abbr`p3`,least_from_def]
+     >- (Cases_on `0 = p2` \\ fs []
+        \\ Cases_on `0 = p1` \\ fs []
+        \\ numLib.LEAST_ELIM_TAC
+        \\ rw []
+        >- (mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+           \\ rw [] \\ pop_assum (qspec_then `domain ((insert p2 ARB (insert p1 ARB s.refs)))` assume_tac)
+           \\ fs [FINITE_domain,domain_lookup] \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
+           \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p1` \\ Cases_on `x = p2` \\ fs [lookup_insert])
+        \\ CCONTR_TAC \\ `0 < n` by rw []
+        \\ first_x_assum drule \\ rw [])
+     \\ fs [] \\ numLib.LEAST_ELIM_TAC
+     \\ conj_tac >- (asm_exists_tac \\ fs [])
+     \\ numLib.LEAST_ELIM_TAC
+     \\ conj_tac >- (asm_exists_tac \\ fs [])
+     \\ rw [] \\ Cases_on `n' < n`
+     >- (first_x_assum drule \\ rw [] \\ Cases_on `n'` \\ fs [])
+     \\ fs [NOT_LESS]
+     \\ CCONTR_TAC
+     \\ `n < n'` by rw []
+     \\ first_x_assum drule \\ rw[]
+     \\ Cases_on `n` \\ fs [])
+  \\ rveq \\ pop_assum kall_tac
+  \\ eval_goalsub_tac ``dataSem$state_locals_fupd _ _``
+  \\ `p3 ≠ p2` by
+     (rw [Abbr `p3`,least_from_def]
+     >- (CCONTR_TAC \\ fs [])
+     >- (numLib.LEAST_ELIM_TAC \\ rw []
+        \\ asm_exists_tac \\ fs [])
+     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV \\ rw []
+     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup]
+     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
+     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `p3 ≠ p1` by
+     (rw [Abbr `p3`,least_from_def]
+     >- (CCONTR_TAC \\ fs [] \\ rfs [])
+     >- (numLib.LEAST_ELIM_TAC \\ rw []
+        \\ asm_exists_tac \\ fs [])
+     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV \\ rw []
+     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup]
+     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
+     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `lookup p3 s.refs = NONE` by
+     (Q.UNABBREV_TAC `p3`
+     \\ rw [least_from_def]
+     >- (Cases_on `0 = p2` \\ Cases_on `0 = p1` \\ fs [])
+     >- (numLib.LEAST_ELIM_TAC \\ rw []
+        \\ Cases_on `ptr = p2`
+        \\ Cases_on `ptr = p1`
+        \\ fs []
+        \\ qexists_tac `ptr` \\ fs [])
+     \\ numLib.LEAST_ELIM_TAC \\ rw [] \\ fs []
+     \\ mp_then Any assume_tac IN_INFINITE_NOT_FINITE INFINITE_NUM_UNIV
+     \\ pop_assum (qspec_then `domain (insert p2 ARB (insert p1 ARB s.refs))` assume_tac)
+     \\ fs [FINITE_domain,domain_lookup]
+     \\ Cases_on `lookup x (insert p2 ARB (insert p1 ARB s.refs))`
+     \\ fs [] \\ qexists_tac `x` \\ Cases_on `x = p2` \\ Cases_on `x = p1` \\ fs [lookup_insert])
+  \\ `2 ≠ p3` by (CCONTR_TAC  \\ fs [])
+  \\ strip_assign
+  \\ fs [lookup_insert]
+  \\ reverse (Cases_on `call_FFI s.ffi "put_char" [121w; 10w] []`
+             \\ fs [])
+  \\ strip_assign
+  \\ simp [return_def,lookup_def,data_safe_def]
+  \\ rpt (pairarg_tac \\ fs [])
+  \\ rfs [insert_shadow,size_of_Number_head]
+  \\ rveq \\ fs [flush_state_def]
+  \\ Q.UNABBREV_TAC `rest_call`
+  (* strip tailcall *)
+  \\ ASM_REWRITE_TAC [ tailcall_def , find_code_def
+                     , get_vars_def , get_var_def
+                     , lookup_def   , timeout_def
+                     , flush_state_def ]
+  \\ simp [code_lookup,lookup_def,lookup_insert,lookup_inter,frame_lookup]
+  \\ IF_CASES_TAC
+  >- fs [data_safe_def,GREATER_DEF,libTheory.the_def,size_of_stack_def]
+  \\ simp[dec_clock_def]
+  \\ eval_goalsub_tac ``dataSem$call_env _ _``
+  \\ qmatch_goalsub_abbrev_tac `f0 (evaluate _)`
+  \\ qmatch_goalsub_abbrev_tac `f0 e0`
+  \\ reverse (sg `∃s' e. e0 = (SOME (Rerr (Rabort e)),s')`)
+  \\ fs [Abbr`f0`,Abbr`e0`]
+  \\ qmatch_goalsub_abbrev_tac `evaluate (p0,s0)`
+  \\ `s0.clock < s.clock` by fs [Abbr `s0`,dec_clock_def]
+  \\ first_x_assum (drule_then (qspec_then `ts + 2` mp_tac))
+  \\ impl_tac >- (fs [Abbr `s0`,lookup_insert,call_env_def] \\ EVAL_TAC)
+  \\ rw [Abbr`p0`,to_shallow_def,to_shallow_thm] \\ fs []
+  end
+QED
+
+Theorem data_safe_yes_code_abort_shallow[local] =
+  data_safe_yes_code_abort |> simp_rule [to_shallow_thm,to_shallow_def]
+
+Theorem data_safe_yes:
+ ∀ffi.
+  backend_config_ok ^yes_x64_conf
+  ⇒ is_safe_for_space ffi
+       yes_x64_conf
+       yes_prog
+       (56,89)
+Proof
+ let
+  val code_lookup   = mk_code_lookup
+                        `fromAList yes_data_prog`
+                         yes_data_code_def
+  val frame_lookup   = mk_frame_lookup
+                        `yes_config.word_conf.stack_frame_size`
+                         yes_config_def
+  val strip_assign  = mk_strip_assign code_lookup frame_lookup
+  val open_call     = mk_open_call code_lookup frame_lookup
+  val make_call     = mk_make_call open_call
+  val strip_call    = mk_strip_call open_call
+  val open_tailcall = mk_open_tailcall code_lookup frame_lookup
+  val make_tailcall = mk_make_tailcall open_tailcall
+ in
+ REWRITE_TAC [yes_prog_def,yes_x64_conf_def]
+ \\ strip_tac \\ strip_tac
+ \\ irule IMP_is_safe_for_space_alt \\ fs []
+ \\ conj_tac >- EVAL_TAC
+ \\ assume_tac yes_thm
+ \\ asm_exists_tac \\ fs []
+ \\ assume_tac yes_to_data_updated_thm
+ \\ fs [data_lang_safe_for_space_def]
+ \\ strip_tac
+ \\ qmatch_goalsub_abbrev_tac `_ v0`
+ \\ `data_safe v0` suffices_by
+    (Cases_on `v0` \\ fs [data_safe_def])
+ \\ UNABBREV_ALL_TAC
+ \\ qmatch_goalsub_abbrev_tac `is_64_bits c0`
+ \\ `is_64_bits c0` by (UNABBREV_ALL_TAC \\ EVAL_TAC)
+ \\ fs []
+ \\ rpt (pop_assum kall_tac)
+ (* start data_safe proof *)
+ \\ REWRITE_TAC [ to_shallow_thm
+                , to_shallow_def
+                , initial_state_def
+                , bvl_to_bviTheory.InitGlobals_location_eq]
+  (* Make first call *)
+ \\ rpt strip_tac
+ \\ make_tailcall
+ (* Bootcode *)
+ \\ ntac 7 strip_assign
+ \\ ho_match_mp_tac data_safe_bind_return
+ (* Yet another call *)
+ \\ make_call
+ \\ strip_call
+ \\ ntac 9 strip_assign
+ \\ make_if
+ \\ UNABBREV_ALL_TAC
+ (* Continues after call *)
+ \\ strip_makespace
+ \\ ntac 49 strip_assign
+ \\ make_tailcall
+ \\ ntac 5
+    (strip_call
+    \\ ntac 9 strip_assign
+    \\ make_if
+    \\ UNABBREV_ALL_TAC)
+  \\ strip_call
+  \\ ntac 9 strip_assign
+  \\ make_if
+  \\ ntac 6 strip_assign
+  \\ ntac 6
+     (open_tailcall
+     \\ ntac 4 strip_assign
+     \\ make_if
+     \\ ntac 2 strip_assign)
+  \\ open_tailcall
+  \\ ntac 4 strip_assign
+  \\ make_if
+  \\ Q.UNABBREV_TAC `rest_call`
+  \\ strip_assign
+  \\ make_tailcall
+  \\ ntac 5
+     (strip_makespace
+     \\ ntac 6 strip_assign
+     \\ make_tailcall)
+  \\ ntac 2 strip_assign
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 0 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 0` \\ rw [])
+  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
+  \\ ntac 2 strip_assign
+  \\ strip_assign
+  \\ Q.ABBREV_TAC `pred = ∃w. 121 = w2n (w:word8)`
+  \\ `pred` by (UNABBREV_ALL_TAC \\ qexists_tac `n2w 121` \\ rw [])
+  \\ fs [] \\ ntac 2 (pop_assum kall_tac)
+  \\ ho_match_mp_tac data_safe_bind_some
+  \\ open_call
+  \\ qmatch_goalsub_abbrev_tac `f (state_locals_fupd _ _)`
+  \\ qmatch_goalsub_abbrev_tac `f s`
+  \\ `∃s' e'. f s = (SOME (Rerr (Rabort e')),s')`
+     by (UNABBREV_ALL_TAC
+        \\ ho_match_mp_tac data_safe_yes_code_abort_shallow
+        \\ fs [] \\ EVAL_TAC)
+  \\ `data_safe (f s)` suffices_by (rw [] \\ rfs [])
+  \\ unabbrev_all_tac
+  \\ ho_match_mp_tac data_safe_yes_code_shallow
+  \\ rw [lookup_def,lookup_fromList,code_lookup]
+  \\ EVAL_TAC
+  \\ qexists_tac `12` \\ fs []
+  end
+QED
+
+Theorem yes_s_def = mk_abbrev"yes_s"
+                      ((rand o rand o rhs o concl) primSemEnvTheory.prim_sem_env_eq)
+
+Definition yes_env_def:
+  yes_env ffi = FST (THE (prim_sem_env sio_ffi_state))
+End
+
+Theorem prim_sem_env_yes:
+  THE (prim_sem_env sio_ffi_state) = (yes_env ffi,yes_s)
+Proof
+EVAL_TAC \\ rw [yes_s_def]
+QED
+
+Theorem backend_config_ok_yes:
+  backend_config_ok yes_x64_conf
+Proof
+ assume_tac x64_backend_config_ok
+ \\ fs [backend_config_ok_def,yes_x64_conf_def,x64_backend_config_def]
+QED
+
+Theorem yes_semantics_prog_not_Fail:
+  let (s,env) = THE (prim_sem_env sio_ffi_state)
+  in ¬semantics_prog s env yes_prog Fail
+Proof
+  assume_tac yes_semantics_prog_Diverge
+  \\ fs [] \\ pairarg_tac \\  fs []
+  \\ CCONTR_TAC \\ fs []
+  \\ drule semanticsPropsTheory.semantics_prog_deterministic
+  \\ pop_assum kall_tac
+  \\ disch_then drule
+  \\ fs []
+QED
+
+Theorem IMP_IMP_TRANS_THM:
+  ∀W P R Q. (W ⇒ Q) ⇒ (P ⇒ R ⇒ W) ⇒ P ⇒ R ⇒ Q
+Proof
+ rw []
+QED
+
+Theorem machine_sem_eq_semantics_prog:
+semantics_prog s env prog (Diverge io_trace) ⇒
+  (machine_sem mc (ffi:'ffi ffi_state) ms = semantics_prog s env prog) ⇒
+     machine_sem mc ffi ms (Diverge io_trace)
+Proof
+  rw []
+QED
+
+Theorem machine_sem_eq_semantics_prog_ex:
+(∃io_trace. semantics_prog s env prog (Diverge io_trace)) ⇒
+  (machine_sem mc (ffi:'ffi ffi_state) ms = semantics_prog s env prog) ⇒
+     (∃io_trace. machine_sem mc ffi ms (Diverge io_trace))
+Proof
+  rw []
+QED
+
+val yes_safe_thm =
+    let
+      val ffi = ``sio_ffi_state``
+      val is_safe = data_safe_yes
+                    |> REWRITE_RULE [GSYM yes_prog_def
+                                    ,GSYM yes_x64_conf_def]
+                    |> ISPEC ffi
+      val not_fail = yes_semantics_prog_not_Fail
+                     |> SIMP_RULE std_ss [LET_DEF,prim_sem_env_yes
+                                         ,ELIM_UNCURRY]
+      val is_corr = MATCH_MP compile_correct_is_safe_for_space yes_thm
+                    |> REWRITE_RULE [GSYM yes_prog_def
+                                    ,GSYM yes_x64_conf_def]
+                    |> Q.INST [`stack_limit` |-> `56`
+                              ,`heap_limit` |-> `89`]
+                    |> INST_TYPE [``:'ffi`` |-> ``:unit``]
+                    |> Q.INST [`ffi` |-> `sio_ffi_state`]
+                    |> SIMP_RULE std_ss [prim_sem_env_yes,LET_DEF,not_fail,ELIM_UNCURRY]
+      val machine_eq = MATCH_MP (machine_sem_eq_semantics_prog |> INST_TYPE [``:'ffi`` |-> ``:unit``])
+                                (yes_semantics_prog_Diverge
+                                   |> SIMP_RULE std_ss [LET_DEF,prim_sem_env_yes,ELIM_UNCURRY])
+      val safe_thm_aux = MATCH_MP (IMP_TRANS is_safe is_corr) backend_config_ok_yes
+    in MATCH_MP (MATCH_MP IMP_IMP_TRANS_THM machine_eq)
+                (safe_thm_aux |> SIMP_RULE std_ss [prim_sem_env_yes,LET_DEF,ELIM_UNCURRY,backend_config_ok_yes])
+    end
+
+Theorem yes_has_space_for_dessert:
+ (read_limits yes_x64_conf mc ms = (56,89)) ⇒
+      mc_conf_ok mc ∧ mc_init_ok yes_x64_conf mc ∧
+      installed yes_code cbspace yes_data data_sp
+        yes_config.lab_conf.ffi_names sio_ffi_state
+        (heap_regs yes_x64_conf.stack_conf.reg_names) mc ms ⇒
+      machine_sem mc sio_ffi_state ms
+        (Diverge (LREPEAT [put_str_event «y\n» ]))
+Proof
+  rw [] \\ drule yes_safe_thm
+  \\ rpt (disch_then drule)
+  \\ simp []
+QED
+
+val _ = check_thm yes_has_space_for_dessert;
+
+val _ = export_theory();
diff --git a/examples/iocatProgScript.sml b/examples/iocatProgScript.sml
index 1002c72428..5a66e0ea1a 100644
--- a/examples/iocatProgScript.sml
+++ b/examples/iocatProgScript.sml
@@ -91,7 +91,8 @@ Proof
              qmatch_assum_abbrev_tac`MEM (xx,yy) fs0.files` >>
              qexists_tac`(xx,yy)` >> fs[])
           >- res_tac
-          >-(fs[MEM_FST_ALOOKUP_SOME])
+          >- (Cases_on ‘ALOOKUP fs0.files (FST y)’ \\ fs []
+              \\ fs [ALOOKUP_NONE] \\ fs [MEM_MAP] \\ metis_tac [])
           >- res_tac) >> fs[] >> rw[]
     >- fs[fsupdate_def,AFUPDKEY_ALOOKUP,openFileFS_files,ADELKEY_nextFD_openFileFS,
          ADELKEY_AFUPDKEY,ALOOKUP_inFS_fname_openFileFS_nextFD,ADELKEY_fastForwardFD_elim]
diff --git a/examples/lpr_checker/array/lpr_arrayProgScript.sml b/examples/lpr_checker/array/lpr_arrayProgScript.sml
index 9a1876bae2..f76b9eb0f0 100644
--- a/examples/lpr_checker/array/lpr_arrayProgScript.sml
+++ b/examples/lpr_checker/array/lpr_arrayProgScript.sml
@@ -1853,10 +1853,12 @@ val _ = translate max_lit_def;
 val _ = translate print_line_def;
 
 val _ = translate spt_center_def;
+val _ = translate apsnd_cons_def;
 val _ = translate spt_centers_def;
 val _ = translate spt_right_def;
 val _ = translate spt_left_def;
-val _ = translate aux_alist_def;
+val _ = translate combine_rle_def;
+val _ = translate spts_to_alist_def;
 val _ = translate toSortedAList_def;
 
 val _ = translate print_dimacs_def;
@@ -2003,7 +2005,7 @@ Theorem ALL_DISTINCT_MAP_FST_toSortedAList:
   ALL_DISTINCT (MAP FST (toSortedAList t))
 Proof
   `SORTED $< (MAP FST (toSortedAList t))` by
-    simp[SORTED_MAP_FST_toSortedAList]>>
+    simp[SORTED_toSortedAList]>>
   pop_assum mp_tac>>
   match_mp_tac SORTED_ALL_DISTINCT>>
   simp[irreflexive_def]
diff --git a/examples/lpr_checker/lpr_commonProgScript.sml b/examples/lpr_checker/lpr_commonProgScript.sml
index 8d2cdf7dd8..37ee936174 100644
--- a/examples/lpr_checker/lpr_commonProgScript.sml
+++ b/examples/lpr_checker/lpr_commonProgScript.sml
@@ -457,10 +457,12 @@ val _ = translate max_lit_def;
 val _ = translate print_line_def;
 
 val _ = translate spt_center_def;
+val _ = translate apsnd_cons_def;
 val _ = translate spt_centers_def;
 val _ = translate spt_right_def;
 val _ = translate spt_left_def;
-val _ = translate aux_alist_def;
+val _ = translate combine_rle_def;
+val _ = translate spts_to_alist_def;
 val _ = translate toSortedAList_def;
 
 val _ = translate print_dimacs_def;
diff --git a/unverified/parse_tap.py b/unverified/parse_tap.py
new file mode 100644
index 0000000000..c9e83c8947
--- /dev/null
+++ b/unverified/parse_tap.py
@@ -0,0 +1,59 @@
+
+import json
+
+def json_to_display (j):
+  if type (j) == list:
+    return map (json_to_display, j)
+  elif 'name' in j:
+    return tuple ([j['name']] + json_to_display (j['args']))
+  else:
+    assert 'isTuple' in j
+    return tuple ([None] + json_to_display (j['elements']))
+
+def parse_output (fname, lang = 'clos'):
+  f = open (fname)
+  header = 'tap.' + lang
+  while header not in f.readline ():
+    pass
+  for l in f:
+    l = l.strip ()
+    if l:
+      break
+  j = json.loads (l)
+  return json_to_display (j['prog'])
+
+def arrange_display (display, indent = 0, margin = 80):
+  if type (display) == list:
+    head = '['
+    tail = '],'
+    ds = display
+  else:
+    head = '%s (' % display[0]
+    tail = '),'
+    ds = display[1:]
+  xs = [arrange_display (d, indent + 2, margin) for d in ds]
+  multi = [x for x in xs if len (x) > 1]
+  line_len = sum ([len (x[0][1]) + 1 for x in xs]
+    + [indent, len (head), len (tail)])
+  if multi or line_len > margin:
+    return [(indent, head)] + [y for x in xs for y in x] + [(indent, tail)]
+  else:
+    return [(indent, head + ' '.join ([x[0][1] for x in xs]) + tail)]
+
+def print_display (display, indent = 0, margin = 80):
+  for (indent, s) in arrange_display (display):
+    print (' ' * indent + s)
+
+def main ():
+  import sys
+  fname = sys.argv[1]
+  if len (sys.argv) > 2:
+    lang = sys.argv[2]
+  else:
+    lang = 'clos'
+  print_display (parse_output (fname, lang))
+
+if __name__ == '__main__':
+  main ()
+
+