diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml
index 6ef9501d78..0877cba481 100644
--- a/interpreter/binary/decode.ml
+++ b/interpreter/binary/decode.ml
@@ -193,6 +193,8 @@ let heap_type s =
       | -0x16 -> ArrayHT
       | -0x17 -> ExnHT
       | -0x18 -> ContHT
+      | -0x19 -> HandlerHT
+      | -0x1a -> NoHandlerHT
       | _ -> error s pos "malformed heap type"
     )
   ] s
@@ -214,6 +216,8 @@ let ref_type s =
   | -0x16 -> (Null, ArrayHT)
   | -0x17 -> (Null, ExnHT)
   | -0x18 -> (Null, ContHT)
+  | -0x19 -> (Null, HandlerHT)
+  | -0x1a -> (Null, NoHandlerHT)
   | -0x1c -> (NoNull, heap_type s)
   | -0x1d -> (Null, heap_type s)
   | _ -> error s pos "malformed reference type"
@@ -259,12 +263,16 @@ let func_type s =
 let cont_type s =
   ContT (heap_type s)
 
+let handler_type s =
+  HandlerT (result_type s)
+
 let str_type s =
   match s7 s with
   | -0x20 -> DefFuncT (func_type s)
   | -0x21 -> DefStructT (struct_type s)
   | -0x22 -> DefArrayT (array_type s)
   | -0x23 -> DefContT (cont_type s) (* TODO(dhil): See comment in encode.ml *)
+  | -0x24 -> DefHandlerT (handler_type s)
   | _ -> error s (pos s - 1) "malformed definition type"
 
 let sub_type s =
@@ -650,6 +658,14 @@ let rec instr s =
     let x = at var s in
     let y = at var s in
     switch x y
+  | 0xe7 ->
+    let x = at var s in
+    let y = at var s in
+    suspend_to x y
+  | 0xe8 ->
+    let x = at var s in
+    let xls = vec on_clause s in
+    resume_with x xls
 
   | 0xfb as b ->
     (match u32 s with
diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml
index 8924dd57d2..70725982a6 100644
--- a/interpreter/binary/encode.ml
+++ b/interpreter/binary/encode.ml
@@ -132,6 +132,8 @@ struct
     | NoExternHT -> s7 (-0x0e)
     | ContHT -> s7 (-0x18)
     | NoContHT -> s7 (-0x0b)
+    | HandlerHT -> s7 (-0x19)
+    | NoHandlerHT -> s7 (-0x1a)
     | VarHT x -> var_type s33 x
     | DefHT _ | BotHT -> assert false
 
@@ -187,6 +189,9 @@ struct
   let cont_type = function
     | ContT ht -> heap_type ht
 
+  let handler_type = function
+    | HandlerT ts -> vec val_type ts
+
   let str_type = function
     | DefStructT st -> s7 (-0x21); struct_type st
     | DefArrayT at -> s7 (-0x22); array_type at
@@ -195,6 +200,7 @@ struct
     (* TODO(dhil): This might need to change again in the future as a
        different proposal might claim this opcode! GC proposal claimed
        the previous opcode we were using. *)
+    | DefHandlerT ht -> s7 (-0x24); handler_type ht
 
   let sub_type = function
     | SubT (Final, [], st) -> str_type st
@@ -301,8 +307,10 @@ struct
     | ContNew x -> op 0xe0; var x
     | ContBind (x, y) -> op 0xe1; var x; var y
     | Suspend x -> op 0xe2; var x
+    | SuspendTo (x, y) -> op 0xe7; var x; var y
     | Resume (x, xls) -> op 0xe3; var x; resumetable xls
     | ResumeThrow (x, y, xls) -> op 0xe4; var x; var y; resumetable xls
+    | ResumeWith (x, xls) -> op 0xe8; var x; resumetable xls
     | Switch (x, y) -> op 0xe5; var x; var y
 
     | Throw x -> op 0x08; var x
diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml
index 086694efd6..cfa5626541 100644
--- a/interpreter/exec/eval.ml
+++ b/interpreter/exec/eval.ml
@@ -58,6 +58,7 @@ type frame =
 }
 
 type code = value stack * admin_instr list
+and handler_name = exn
 
 and admin_instr = admin_instr' phrase
 and admin_instr' =
@@ -72,25 +73,28 @@ and admin_instr' =
   | Label of int * instr list * code
   | Frame of int * frame * code
   | Handler of int * catch list * code
-  | Handle of handle_table * code
-  | Suspending of tag_inst * value stack * ref_ option * ctxt
+  | Handle of handler_name option * handle_table option * code
+  | Suspending of tag_inst * value stack * ref_ option * ref_ option * ctxt
 
 and ctxt = code -> code
 and handle_table = (tag_inst * idx) list * tag_inst list
 
 type cont = int32 * ctxt  (* TODO: represent type properly *)
 type ref_ += ContRef of cont option ref
+type ref_ += HandlerRef of handler_name option ref
 
 let () =
   let type_of_ref' = !Value.type_of_ref' in
   Value.type_of_ref' := function
     | ContRef _ -> ContHT
+    | HandlerRef _ -> HandlerHT
     | r -> type_of_ref' r
 
 let () =
   let string_of_ref' = !Value.string_of_ref' in
   Value.string_of_ref' := function
     | ContRef _ -> "cont"
+    | HandlerRef _ -> "handler"
     | r -> string_of_ref' r
 
 let plain e = Plain e.it @@ e.at
@@ -379,7 +383,18 @@ let rec step (c : config) : config =
         let tagt = tag c.frame.inst x in
         let FuncT (ts, _) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in
         let args, vs' = i32_split (Lib.List32.length ts) vs e.at in
-        vs', [Suspending (tagt, args, None, fun code -> code) @@ e.at]
+        vs', [Suspending (tagt, args, None, None, fun code -> code) @@ e.at]
+
+      | SuspendTo (x, y), vs ->
+        let tagt = tag c.frame.inst y in
+        let FuncT (ts, _) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in
+        let args, vs' = i32_split (Int32.add (Lib.List32.length ts) 1l) vs e.at in
+        let args, href =
+          match args with
+          | Ref r :: rest -> rest, r
+          | _ -> Crash.error e.at "type mismatch at suspend to"
+        in
+        vs', [Suspending (tagt, args, None, Some href, fun code -> code) @@ e.at]
 
       | Resume (x, xls), Ref (NullRef _) :: vs ->
         vs, [Trapping "null continuation reference" @@ e.at]
@@ -391,7 +406,7 @@ let rec step (c : config) : config =
         let hs = handle_table c xls in
         let args, vs' = i32_split n vs e.at in
         cont := None;
-        vs', [Handle (hs, ctxt (args, [])) @@ e.at]
+        vs', [Handle (None, Some hs, ctxt (args, [])) @@ e.at]
 
       | ResumeThrow (x, y, xls), Ref (NullRef _) :: vs ->
         vs, [Trapping "null continuation reference" @@ e.at]
@@ -405,7 +420,23 @@ let rec step (c : config) : config =
         let hs = handle_table c xls in
         let args, vs' = i32_split (Lib.List32.length ts) vs e.at in
         cont := None;
-        vs', [Handle (hs, ctxt ([], [Throwing (tagt, args) @@ e.at])) @@ e.at]
+        vs', [Handle (None, Some hs, ctxt ([], [Throwing (tagt, args) @@ e.at])) @@ e.at]
+
+      | ResumeWith (x, xls), Ref (NullRef _) :: vs ->
+        vs, [Trapping "null continuation reference" @@ e.at]
+
+      | ResumeWith (x, xls), Ref (ContRef {contents = None}) :: vs ->
+        vs, [Trapping "continuation already consumed" @@ e.at]
+
+      | ResumeWith (x, xls), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs ->
+        let hs = handle_table c xls in
+        let args, vs' = i32_split (Int32.sub n 1l) vs e.at in
+        let exception Name in
+        let name =
+          Ref (HandlerRef (ref (Some Name)))
+        in
+        cont := None;
+        vs', [Handle (Some Name, Some hs, ctxt (args @ [name], [])) @@ e.at]
 
       | Switch (x, y), Ref (NullRef _) :: vs ->
          vs, [Trapping "null continuation reference" @@ e.at]
@@ -416,7 +447,7 @@ let rec step (c : config) : config =
       | Switch (x, y), Ref (ContRef {contents = Some (n, ctxt)} as cont) :: vs ->
          let tagt = tag c.frame.inst y in
          let args, vs' = i32_split (Int32.sub n 1l) vs e.at in
-         vs', [Suspending (tagt, args, Some cont, fun code -> code) @@ e.at]
+         vs', [Suspending (tagt, args, Some cont, None, fun code -> code) @@ e.at]
 
       | ReturnCall x, vs ->
         (match (step {c with code = (vs, [Plain (Call x) @@ e.at])}).code with
@@ -1177,9 +1208,9 @@ let rec step (c : config) : config =
     | Label (n, es0, (vs', [])), vs ->
       vs' @ vs, []
 
-    | Label (n, es0, (vs', {it = Suspending (tagt, vs1, contref, ctxt); at} :: es')), vs ->
+    | Label (n, es0, (vs', {it = Suspending (tagt, vs1, contref, href, ctxt); at} :: es')), vs ->
       let ctxt' code = [], [Label (n, es0, compose (ctxt code) (vs', es')) @@ e.at] in
-      vs, [Suspending (tagt, vs1, contref, ctxt') @@ at]
+      vs, [Suspending (tagt, vs1, contref, href, ctxt') @@ at]
 
     | Label (n, es0, (vs', {it = ReturningInvoke (vs0, f); at} :: es')), vs ->
       vs, [ReturningInvoke (vs0, f) @@ at]
@@ -1206,9 +1237,9 @@ let rec step (c : config) : config =
     | Frame (n, frame', (vs', {it = Throwing (a, vs0); at} :: es')), vs ->
       vs, [Throwing (a, vs0) @@ at]
 
-    | Frame (n, frame', (vs', {it = Suspending (tagt, vs1, contref, ctxt); at} :: es')), vs ->
+    | Frame (n, frame', (vs', {it = Suspending (tagt, vs1, contref, href, ctxt); at} :: es')), vs ->
       let ctxt' code = [], [Frame (n, frame', compose (ctxt code) (vs', es')) @@ e.at] in
-      vs, [Suspending (tagt, vs1, contref, ctxt') @@ at]
+      vs, [Suspending (tagt, vs1, contref, href, ctxt') @@ at]
 
     | Frame (n, frame', (vs', {it = Returning vs0; at} :: es')), vs ->
       take n vs0 e.at @ vs, []
@@ -1248,9 +1279,9 @@ let rec step (c : config) : config =
     | Handler (n, [], (vs', {it = Throwing (a, vs0); at} :: es')), vs ->
       vs, [Throwing (a, vs0) @@ at]
 
-    | Handler (n, cs, (vs', {it = Suspending (tagt, vs1, contref, ctxt); at} :: es')), vs ->
+    | Handler (n, cs, (vs', {it = Suspending (tagt, vs1, contref, href, ctxt); at} :: es')), vs ->
       let ctxt' code = [], [Handler (n, cs, compose (ctxt code) (vs', es')) @@ e.at] in
-      vs, [Suspending (tagt, vs1, contref, ctxt') @@ at]
+      vs, [Suspending (tagt, vs1, contref, href, ctxt') @@ at]
 
     | Handler (n, cs, (vs', e' :: es')), vs when is_jumping e' ->
       vs, [e']
@@ -1282,37 +1313,45 @@ let rec step (c : config) : config =
         with Crash (_, msg) -> Crash.error e.at msg)
       )
 
-    | Handle (hso, (vs', [])), vs ->
+    | Handle (name, hso, (vs', [])), vs ->
       vs' @ vs, []
 
-    | Handle ((hs, _), (vs', {it = Suspending (tagt, vs1, None, ctxt); at} :: es')), vs
+    | Handle (name, Some (hs, _), (vs', {it = Suspending (tagt, vs1, None, None, ctxt); at} :: es')), vs
       when List.mem_assq tagt hs ->
       let FuncT (_, ts) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in
       let ctxt' code = compose (ctxt code) (vs', es') in
       [Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt'))))] @ vs1 @ vs,
       [Plain (Br (List.assq tagt hs)) @@ e.at]
 
-    | Handle ((_, hs) as hso, (vs', {it = Suspending (tagt, vs1, Some (ContRef ({contents = Some (_, ctxt)} as cont)), ctxt'); at} :: es')), vs
+    | Handle (Some h, Some (hs, _), (vs', {it = Suspending (tagt, vs1, None, Some (HandlerRef ({contents = Some h'} as href)), ctxt); at} :: es')), vs
+      when h == h' && List.mem_assq tagt hs ->
+      let FuncT (_, ts) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in
+      let ctxt' code = compose (ctxt code) (vs', es') in
+      href := None;
+      [Ref (ContRef (ref (Some (Int32.add (Lib.List32.length ts) 1l, ctxt'))))] @ vs1 @ vs,
+      [Plain (Br (List.assq tagt hs)) @@ e.at]
+
+    | Handle (None, (Some (_, hs) as hso), (vs', {it = Suspending (tagt, vs1, Some (ContRef ({contents = Some (_, ctxt)} as cont)), None, ctxt'); at} :: es')), vs
        when List.memq tagt hs ->
        let FuncT (_, ts) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in
        let ctxt'' code = compose (ctxt' code) (vs', es') in
        let cont' = Ref (ContRef (ref (Some (Int32.add (Lib.List32.length ts) 1l, ctxt'')))) in
        let args = cont' :: vs1 in
        cont := None;
-       vs' @ vs, [Handle (hso, ctxt (args, [])) @@ e.at]
+       vs' @ vs, [Handle (None, hso, ctxt (args, [])) @@ e.at]
 
-    | Handle (hso, (vs', {it = Suspending (tagt, vs1, contref, ctxt); at} :: es')), vs ->
-      let ctxt' code = [], [Handle (hso, compose (ctxt code) (vs', es')) @@ e.at] in
-      vs, [Suspending (tagt, vs1, contref, ctxt') @@ at]
+    | Handle (name, hso, (vs', {it = Suspending (tagt, vs1, contref, href, ctxt); at} :: es')), vs ->
+      let ctxt' code = [], [Handle (name, hso, compose (ctxt code) (vs', es')) @@ e.at] in
+      vs, [Suspending (tagt, vs1, contref, href, ctxt') @@ at]
 
-    | Handle (hso, (vs', e' :: es')), vs when is_jumping e' ->
+    | Handle (name, hso, (vs', e' :: es')), vs when is_jumping e' ->
       vs, [e']
 
-    | Handle (hso, code'), vs ->
+    | Handle (name, hso, code'), vs ->
       let c' = step {c with code = code'} in
-      vs, [Handle (hso, c'.code) @@ e.at]
+      vs, [Handle (name, hso, c'.code) @@ e.at]
 
-    | Suspending (_, _, _, _), _ -> assert false
+    | Suspending (_, _, _, _, _), _ -> assert false
 
   in {c with code = vs', es' @ List.tl es}
 
diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml
index 5ee382fdeb..85a83e2f09 100644
--- a/interpreter/syntax/ast.ml
+++ b/interpreter/syntax/ast.ml
@@ -175,8 +175,10 @@ and instr' =
   | ContNew of idx                    (* create continuation *)
   | ContBind of idx * idx             (* bind continuation arguments *)
   | Suspend of idx                    (* suspend continuation *)
+  | SuspendTo of idx * idx            (* named suspend continuation *)
   | Resume of idx * (idx * hdl) list  (* resume continuation *)
   | ResumeThrow of idx * idx * (idx * hdl) list (* abort continuation *)
+  | ResumeWith of idx * (idx * hdl) list (* named resume continuation *)
   | Switch of idx * idx               (* direct switch continuation *)
   | Throw of idx                      (* throw exception *)
   | ThrowRef                          (* rethrow exception *)
diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml
index 8bfb0d4052..8ebb72bdce 100644
--- a/interpreter/syntax/free.ml
+++ b/interpreter/syntax/free.ml
@@ -82,6 +82,7 @@ let heap_type = function
   | ExnHT | NoExnHT -> empty
   | ExternHT | NoExternHT -> empty
   | ContHT | NoContHT -> empty
+  | HandlerHT | NoHandlerHT -> empty
   | VarHT x -> var_type x
   | DefHT _ct -> empty  (* assume closed *)
   | BotHT -> empty
@@ -109,12 +110,14 @@ let field_type (FieldT (_mut, st)) = storage_type st
 let struct_type (StructT fts) = list field_type fts
 let array_type (ArrayT ft) = field_type ft
 let func_type (FuncT (ts1, ts2)) = list val_type ts1 ++ list val_type ts2
+let handler_type (HandlerT ts) = list val_type ts
 
 let str_type = function
   | DefStructT st -> struct_type st
   | DefArrayT at -> array_type at
   | DefFuncT ft -> func_type ft
   | DefContT ct -> cont_type ct
+  | DefHandlerT ht -> handler_type ht
 
 let sub_type = function
   | SubT (_fin, hts, st) -> list heap_type hts ++ str_type st
@@ -182,7 +185,9 @@ let rec instr (e : instr) =
   | ContBind (x, y) -> types (idx x) ++ types (idx y)
   | ResumeThrow (x, y, xys) -> types (idx x) ++ tags (idx y) ++ list (fun (x, y) -> tags (idx x) ++ hdl y) xys
   | Resume (x, xys) -> types (idx x) ++ list (fun (x, y) -> tags (idx x) ++ hdl y) xys
+  | ResumeWith (x, xys) -> types (idx x) ++ list (fun (x, y) -> tags (idx x) ++ hdl y) xys
   | Suspend x -> tags (idx x)
+  | SuspendTo (x, y) -> types (idx x) ++ tags (idx y)
   | Switch (x, z) -> types (idx x) ++ tags (idx z)
   | Throw x -> tags (idx x)
   | ThrowRef -> empty
diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml
index e6b39aa313..c14388cb7f 100644
--- a/interpreter/syntax/operators.ml
+++ b/interpreter/syntax/operators.ml
@@ -52,8 +52,10 @@ let return_call_indirect x y = ReturnCallIndirect (x, y)
 let cont_new x = ContNew x
 let cont_bind x y = ContBind (x, y)
 let suspend x = Suspend x
+let suspend_to x y = SuspendTo (x, y)
 let resume x xys = Resume (x, xys)
 let resume_throw x y xys = ResumeThrow (x, y, xys)
+let resume_with x xys = ResumeWith (x, xys)
 let switch x y = Switch (x, y)
 let throw x = Throw x
 let throw_ref = ThrowRef
diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml
index be2e05c90e..593d5e94d3 100644
--- a/interpreter/syntax/types.ml
+++ b/interpreter/syntax/types.ml
@@ -21,6 +21,7 @@ type heap_type =
   | ExnHT | NoExnHT
   | ExternHT | NoExternHT
   | ContHT | NoContHT
+  | HandlerHT | NoHandlerHT
   | VarHT of var
   | DefHT of def_type
   | BotHT
@@ -37,12 +38,14 @@ and struct_type = StructT of field_type list
 and array_type = ArrayT of field_type
 and func_type = FuncT of result_type * result_type
 and cont_type = ContT of heap_type
+and handler_type = HandlerT of result_type
 
 and str_type =
   | DefStructT of struct_type
   | DefArrayT of array_type
   | DefFuncT of func_type
   | DefContT of cont_type
+  | DefHandlerT of handler_type
 
 and sub_type = SubT of final * heap_type list * str_type
 and rec_type = RecT of sub_type list
@@ -164,6 +167,8 @@ let subst_heap_type s = function
   | NoExternHT -> NoExternHT
   | ContHT -> ContHT
   | NoContHT -> NoContHT
+  | HandlerHT -> HandlerHT
+  | NoHandlerHT -> NoHandlerHT
   | VarHT x -> s x
   | DefHT dt -> DefHT dt  (* assume closed *)
   | BotHT -> BotHT
@@ -200,11 +205,15 @@ let subst_func_type s = function
 let subst_cont_type s = function
   | ContT ht -> ContT (subst_heap_type s ht)
 
+let subst_handler_type s = function
+  | HandlerT ts -> HandlerT (subst_result_type s ts)
+
 let subst_str_type s = function
   | DefStructT st -> DefStructT (subst_struct_type s st)
   | DefArrayT at -> DefArrayT (subst_array_type s at)
   | DefFuncT ft -> DefFuncT (subst_func_type s ft)
   | DefContT ct -> DefContT (subst_cont_type s ct)
+  | DefHandlerT ht -> DefHandlerT (subst_handler_type s ht)
 
 let subst_sub_type s = function
   | SubT (fin, hts, st) ->
@@ -311,6 +320,11 @@ let as_array_str_type (st : str_type) : array_type =
   | DefArrayT at -> at
   | _ -> assert false
 
+let as_handler_str_type (st : str_type) : handler_type =
+  match st with
+  | DefHandlerT ht -> ht
+  | _ -> assert false
+
 let extern_type_of_import_type (ImportT (et, _, _)) = et
 let extern_type_of_export_type (ExportT (et, _)) = et
 
@@ -378,6 +392,8 @@ let rec string_of_heap_type = function
   | NoExternHT -> "noextern"
   | ContHT -> "cont"
   | NoContHT -> "nocont"
+  | HandlerHT -> "handler"
+  | NoHandlerHT -> "nohandler"
   | VarHT x -> string_of_var x
   | DefHT dt -> "(" ^ string_of_def_type dt ^ ")"
   | BotHT -> "something"
@@ -416,11 +432,15 @@ and string_of_func_type = function
 and string_of_cont_type = function
   | ContT ht -> string_of_heap_type ht
 
+and string_of_handler_type = function
+  | HandlerT ts -> string_of_result_type ts
+
 and string_of_str_type = function
   | DefStructT st -> "struct " ^ string_of_struct_type st
   | DefArrayT at -> "array " ^ string_of_array_type at
   | DefFuncT ft -> "func " ^ string_of_func_type ft
   | DefContT ct -> "cont " ^ string_of_cont_type ct
+  | DefHandlerT ht -> "handler " ^ string_of_handler_type ht
 
 
 and string_of_tag_type = function
diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml
index 9599265d89..f413407d93 100644
--- a/interpreter/text/arrange.ml
+++ b/interpreter/text/arrange.ml
@@ -103,12 +103,16 @@ let func_type (FuncT (ts1, ts2)) =
 let cont_type (ContT ct) =
   Node ("cont", [atom heap_type ct])
 
+let handler_type (HandlerT ts) =
+  Node ("handler", decls "result" ts)
+
 let str_type st =
   match st with
   | DefStructT st -> struct_type st
   | DefArrayT at -> array_type at
   | DefFuncT ft -> func_type ft
   | DefContT ct -> cont_type ct
+  | DefHandlerT ht -> handler_type ht
 
 let sub_type = function
   | SubT (Final, [], st) -> str_type st
@@ -557,10 +561,13 @@ let rec instr e =
     | ContNew x -> "cont.new " ^ var x, []
     | ContBind (x, y) -> "cont.bind " ^ var x ^ " " ^ var y, []
     | Suspend x -> "suspend " ^ var x, []
+    | SuspendTo (x, y) -> "suspend_to " ^ var x ^ " " ^ var y, []
     | Resume (x, xys) ->
       "resume " ^ var x, resumetable xys
     | ResumeThrow (x, y, xys) ->
       "resume_throw " ^ var x ^ " " ^ var y, resumetable xys
+    | ResumeWith (x, xys) ->
+      "resume_with " ^ var x, resumetable xys
     | Switch (x, z) ->
       "switch " ^ var x ^ " " ^ var z, []
     | Throw x -> "throw " ^ var x, []
diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll
index cb124af83f..5d7d5bae09 100644
--- a/interpreter/text/lexer.mll
+++ b/interpreter/text/lexer.mll
@@ -188,6 +188,7 @@ rule token = parse
       | "field" -> FIELD
       | "mut" -> MUT
       | "cont" -> CONT
+      | "handler" -> HANDLER
       | "sub" -> SUB
       | "final" -> FINAL
       | "rec" -> REC
@@ -228,8 +229,10 @@ rule token = parse
       | "cont.new" -> CONT_NEW
       | "cont.bind" -> CONT_BIND
       | "suspend" -> SUSPEND
+      | "suspend_to" -> SUSPEND_TO
       | "resume" -> RESUME
       | "resume_throw" -> RESUME_THROW
+      | "resume_with" -> RESUME_WITH
       | "switch" -> SWITCH
 
 
diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly
index c7f400e2ef..1ef0a0d3ad 100644
--- a/interpreter/text/parser.mly
+++ b/interpreter/text/parser.mly
@@ -299,12 +299,12 @@ let parse_annots (m : module_) : Custom.section list =
 %token<V128.shape> VEC_SHAPE
 %token ANYREF NULLREF EQREF I31REF STRUCTREF ARRAYREF
 %token FUNCREF NULLFUNCREF EXNREF NULLEXNREF EXTERNREF NULLEXTERNREF
-%token NOCONT CONTREF NULLCONTREF
+%token NOCONT CONTREF NULLCONTREF NOHANDLER
 %token ANY NONE EQ I31 REF NOFUNC EXN NOEXN EXTERN NOEXTERN NULL
 %token MUT FIELD STRUCT ARRAY SUB FINAL REC
 %token UNREACHABLE NOP DROP SELECT
 %token BLOCK END IF THEN ELSE LOOP
-%token CONT_NEW CONT_BIND SUSPEND RESUME RESUME_THROW SWITCH
+%token CONT_NEW CONT_BIND SUSPEND SUSPEND_TO RESUME RESUME_THROW RESUME_WITH SWITCH
 %token BR BR_IF BR_TABLE BR_ON_NON_NULL
 %token<Ast.idx -> Ast.instr'> BR_ON_NULL
 %token<Ast.idx -> Types.ref_type -> Types.ref_type -> Ast.instr'> BR_ON_CAST
@@ -336,7 +336,7 @@ let parse_annots (m : module_) : Custom.section list =
 %token<Ast.instr'> VEC_SHIFT VEC_BITMASK VEC_SPLAT
 %token VEC_SHUFFLE
 %token<int -> Ast.instr'> VEC_EXTRACT VEC_REPLACE
-%token FUNC START TYPE PARAM RESULT LOCAL GLOBAL CONT
+%token FUNC START TYPE PARAM RESULT LOCAL GLOBAL CONT HANDLER
 %token TABLE ELEM MEMORY ON TAG DATA DECLARE OFFSET ITEM IMPORT EXPORT
 %token MODULE BIN QUOTE DEFINITION INSTANCE
 %token SCRIPT REGISTER INVOKE GET
@@ -394,6 +394,8 @@ heap_type :
   | NOEXTERN { fun c -> NoExternHT }
   | CONT { fun c -> ContHT }
   | NOCONT { fun c -> NoContHT }
+  | HANDLER { fun c -> HandlerHT }
+  | NOHANDLER { fun c -> NoHandlerHT }
   | var { fun c -> VarHT (StatX ($1 c type_).it) }
 
 ref_type :
@@ -490,6 +492,10 @@ func_type :
     { fun c -> let FuncT (ts1, ts2) = $6 c in
       FuncT ($4 c :: ts1, ts2) }
 
+handler_type :
+  | func_type_result
+    { fun c -> HandlerT ($1 c) }
+
 func_type_result :
   | /* empty */
     { fun c -> [] }
@@ -501,6 +507,7 @@ str_type :
   | LPAR ARRAY array_type RPAR { fun c x -> DefArrayT ($3 c) }
   | LPAR FUNC func_type RPAR { fun c x -> DefFuncT ($3 c) }
   | LPAR CONT cont_type RPAR { fun c x -> DefContT ($3 c) }
+  | LPAR HANDLER handler_type RPAR { fun c x -> DefHandlerT ($3 c) }
 
 sub_type :
   | str_type { fun c x -> SubT (Final, [], $1 c x) }
@@ -626,6 +633,7 @@ plain_instr :
   | CONT_NEW var { fun c -> cont_new ($2 c type_) }
   | CONT_BIND var var { fun c -> cont_bind ($2 c type_) ($3 c type_) }
   | SUSPEND var { fun c -> suspend ($2 c tag) }
+  | SUSPEND_TO var var { fun c -> suspend_to ($2 c type_) ($3 c tag) }
   | THROW var { fun c -> throw ($2 c tag) }
   | THROW_REF { fun c -> throw_ref }
   | LOCAL_GET var { fun c -> local_get ($2 c local) }
@@ -789,6 +797,11 @@ resume_instr_instr_list :
       let x  = $2 c type_ in
       let tag = $3 c tag in
       let hs, es = $4 c in (resume_throw x tag hs @@ loc1) :: es }
+  | RESUME_WITH var resume_instr_handler_instr
+    { let loc1 = $loc($1) in
+      fun c ->
+      let x = $2 c type_ in
+      let hs, es = $3 c in (resume_with x hs @@ loc1) :: es }
 
 resume_instr_handler_instr :
   | LPAR ON var var RPAR resume_instr_handler_instr
@@ -907,6 +920,11 @@ expr1 :  /* Sugar */
       let tag = $3 c tag in
       let hs, es = $4 c in
       es, resume_throw x tag hs }
+  | RESUME_WITH var resume_expr_handler
+    { fun c ->
+      let x = $2 c type_ in
+      let hs, es = $3 c in
+      es, resume_with x hs }
   | BLOCK labeling_opt block
     { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], block bt es }
   | LOOP labeling_opt block
diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml
index 1e8d72e3cc..03998f754d 100644
--- a/interpreter/valid/match.ml
+++ b/interpreter/valid/match.ml
@@ -14,6 +14,7 @@ let abs_of_str_type _c = function
   | DefStructT _ | DefArrayT _ -> StructHT
   | DefFuncT _ -> FuncHT
   | DefContT _ -> ContHT
+  | DefHandlerT _ -> HandlerHT
 
 let rec top_of_str_type c st =
   top_of_heap_type c (abs_of_str_type c st)
@@ -24,6 +25,7 @@ and top_of_heap_type c = function
   | ExnHT | NoExnHT -> ExnHT
   | ExternHT | NoExternHT -> ExternHT
   | ContHT | NoContHT -> ContHT
+  | HandlerHT | NoHandlerHT -> HandlerHT
   | DefHT dt -> top_of_str_type c (expand_def_type dt)
   | VarHT (StatX x) -> top_of_str_type c (expand_def_type (lookup c x))
   | VarHT (RecX _) | BotHT -> assert false
@@ -43,6 +45,7 @@ and bot_of_heap_type c = function
   | ExnHT | NoExnHT -> NoExnHT
   | ExternHT | NoExternHT -> NoExternHT
   | ContHT | NoContHT -> NoContHT
+  | HandlerHT | NoHandlerHT -> NoHandlerHT
   | DefHT dt -> bot_of_str_type c (expand_def_type dt)
   | VarHT (StatX x) -> bot_of_str_type c (expand_def_type (lookup c x))
   | VarHT (RecX _) | BotHT -> assert false
@@ -83,6 +86,7 @@ let rec match_heap_type c t1 t2 =
   | NoExnHT, t -> match_heap_type c t ExnHT
   | NoExternHT, t -> match_heap_type c t ExternHT
   | NoContHT, t -> match_heap_type c t ContHT
+  | NoHandlerHT, t -> match_heap_type c t HandlerHT
   | VarHT (StatX x1), _ -> match_heap_type c (DefHT (lookup c x1)) t2
   | _, VarHT (StatX x2) -> match_heap_type c t1 (DefHT (lookup c x2))
   | DefHT dt1, DefHT dt2 -> match_def_type c dt1 dt2
@@ -96,6 +100,7 @@ let rec match_heap_type c t1 t2 =
     | DefArrayT _, ArrayHT -> true
     | DefFuncT _, FuncHT -> true
     | DefContT _, ContHT -> true
+    | DefHandlerT _, HandlerHT -> true
     | _ -> false
     )
   | BotHT, _ -> true
diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml
index 90bf74a091..85e0da7892 100644
--- a/interpreter/valid/valid.ml
+++ b/interpreter/valid/valid.ml
@@ -84,6 +84,11 @@ let array_type (c : context) x =
   | DefArrayT at -> at
   | _ -> error x.at ("non-array type " ^ I32.to_string_u x.it)
 
+let handler_type (c : context) x =
+  match expand_def_type (type_ c x) with
+  | DefHandlerT ht -> ht
+  | _ -> error x.at ("non-handler type " ^ Int32.to_string x.it)
+
 let refer category (s : Free.Set.t) x =
   if not (Free.Set.mem x.it s) then
     error x.at
@@ -106,6 +111,12 @@ let func_type_of_heap_type (c : context) (ht : heap_type) at : func_type =
   | VarHT (StatX x) -> func_type c (x @@ at)
   | _ -> assert false
 
+let handler_type_of_heap_type (c : context) (ht : heap_type) at : handler_type =
+  match ht with
+  | DefHT dt -> as_handler_str_type (expand_def_type dt)
+  | VarHT (StatX x) -> handler_type c (x @@ at)
+  | _ -> assert false
+
 let func_type_of_cont_type (c : context) (ContT ht) at : func_type =
   func_type_of_heap_type c ht at
 
@@ -114,6 +125,7 @@ let func_type_of_tag_type (c : context) (TagT dt) at : func_type =
   | DefFuncT ft -> ft
   | _ -> error at "non-function type"
 
+
 (* Types *)
 
 let check_limits {min; max} range at msg =
@@ -137,7 +149,8 @@ let check_heap_type (c : context) (t : heap_type) at =
   | FuncHT | NoFuncHT
   | ContHT | NoContHT
   | ExnHT | NoExnHT
-  | ExternHT | NoExternHT -> ()
+  | ExternHT | NoExternHT
+  | HandlerHT | NoHandlerHT -> ()
   | VarHT (StatX x) -> let _dt = type_ c (x @@ at) in ()
   | VarHT (RecX _) | DefHT _ -> assert false
   | BotHT -> ()
@@ -184,6 +197,10 @@ let check_cont_type (c : context) (ct : cont_type) at =
     let _dt = func_type c (x @@ at) in ()
   | _ -> assert false
 
+let check_handler_type (c : context) (ht : handler_type) at =
+  match ht with
+  | HandlerT ts -> check_result_type c ts at
+
 let check_table_type (c : context) (tt : table_type) at =
   let TableT (at_, lim, t) = tt in
   check_ref_type c t at;
@@ -217,6 +234,7 @@ let check_str_type (c : context) (st : str_type) at =
   | DefArrayT rt -> check_array_type c rt at
   | DefFuncT ft -> check_func_type c ft at
   | DefContT ct -> check_cont_type c ct at
+  | DefHandlerT ht -> check_handler_type c ht at
 
 let check_sub_type (c : context) (sut : sub_type) at =
   let SubT (_fin, hts, st) = sut in
@@ -434,11 +452,17 @@ let check_memop (c : context) (memop : ('t, 's) memop) ty_size get_sz at =
  * declarative typing rules.
  *)
 
-let check_resume_table (c : context) ts2 (xys : (idx * hdl) list) at =
+let check_resume_table (c : context) hrt ts2 (xys : (idx * hdl) list) at =
   List.iter (fun (x1, x2) ->
       match x2 with
       | OnLabel x2 ->
-        let FuncT (ts3, ts4) = func_type_of_tag_type c (tag c x1) x1.at in
+        let FuncT (ts3, ts4) =
+          match hrt with
+          | Some rt ->
+            let FuncT (ts3, ts4) = func_type_of_tag_type c (tag c x1) x1.at in
+            FuncT (ts3, ts4 @ [RefT rt])
+          | None -> func_type_of_tag_type c (tag c x1) x1.at
+        in
         let ts' = label c x2 in
         (match Lib.List.last_opt ts' with
         | Some (RefT (nul', ht)) ->
@@ -637,10 +661,17 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in
     let FuncT (ts1, ts2) = func_type_of_tag_type c tag x.at in
     ts1 --> ts2, []
 
+  | SuspendTo (x, y) ->
+    let _hty = handler_type c x in
+    let tag = tag c y in
+    let FuncT (ts1, ts2) = func_type_of_tag_type c tag x.at in
+    (ts1 @ [RefT (Null, VarHT (StatX x.it))]) -->
+      (ts2 @ [RefT (NoNull, VarHT (StatX x.it))]), []
+
   | Resume (x, xys) ->
     let ct = cont_type c x in
     let FuncT (ts1, ts2) = func_type_of_cont_type c ct x.at in
-    check_resume_table c ts2 xys e.at;
+    check_resume_table c None ts2 xys e.at;
     (ts1 @ [RefT (Null, VarHT (StatX x.it))]) --> ts2, []
 
   | ResumeThrow (x, y, xys) ->
@@ -648,9 +679,29 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in
     let FuncT (ts1, ts2) = func_type_of_cont_type c ct x.at in
     let tag = tag c y in
     let FuncT (ts0, _) = func_type_of_tag_type c tag y.at in
-    check_resume_table c ts2 xys e.at;
+    check_resume_table c None ts2 xys e.at;
     (ts0 @ [RefT (Null, VarHT (StatX x.it))]) --> ts2, []
 
+  | ResumeWith (x, xys) ->
+    let ct = cont_type c x in
+    let FuncT (ts1, ts2) = func_type_of_cont_type c ct x.at in
+    let (rt, ts3) =
+      match Lib.List.last_opt ts1 with
+      | Some (RefT ((nul, ht) as rt)) ->
+         let HandlerT ts = handler_type_of_heap_type c ht x.at in
+         (rt, ts)
+      | _ ->
+         error x.at
+           ("type mismatch: instruction requires a handler reference type " ^
+              " but the type annotation has " ^ string_of_result_type ts1)
+    in
+    require (match_result_type c.types ts3 ts2) x.at
+      "type mismatch in handler type";
+    check_resume_table c (Some rt) ts2 xys e.at;
+    let ts1' = Lib.List.lead ts1 in
+    (ts1' @ [RefT (Null, VarHT (StatX x.it))]) --> ts2, []
+
+
   | Switch (x, y) ->
      let ct1 = cont_type c x in
      let FuncT (ts11, ts12) = func_type_of_cont_type c ct1 x.at in
diff --git a/test/core/stack-switching/cont.wast b/test/core/stack-switching/cont.wast
index 91c4ba0cb3..3f2f66a3cb 100644
--- a/test/core/stack-switching/cont.wast
+++ b/test/core/stack-switching/cont.wast
@@ -1067,3 +1067,116 @@
     (func (param $k (ref $ct))
       (switch $ct $t)))
   "type mismatch in switch tag")
+
+;; Named handlers
+(module
+  (type $ht (handler))
+  (type $ft (func (param (ref $ht))))
+  (type $ct (cont $ft))
+
+  (tag $yield (param i32))
+
+  (func $nats (type $ft)
+    (local $h (ref $ht))
+    (local $i i32)
+    (local.set $h (local.get 0))
+    (loop $next
+      (suspend_to $ht $yield
+        (local.get $i) (local.get $h))
+      (local.set $h)
+      (local.set $i (i32.add (i32.const 1) (local.get $i)))
+      (br $next)))
+
+  (func (export "sumUp") (param $n i32) (result i32)
+    (local $i i32)
+    (local $j i32)
+    (local $k (ref $ct))
+    (local.set $k (cont.new $ct (ref.func $nats)))
+    (loop $next
+      (block $on_yield (result i32 (ref $ct))
+        (resume_with $ct (on $yield $on_yield) (local.get $k))
+        (return (local.get $i))
+      ) ;; on_yield
+      (local.set $k)
+      (i32.add (local.get $i))
+      (local.set $i)
+      (local.set $j (i32.add (i32.const 1) (local.get $j)))
+      (br_if $next (i32.le_u (local.get $j) (local.get $n)))
+   )
+   (return (local.get $i)))
+
+  (func $nats-bad (type $ft)
+    (local $h (ref $ht))
+    (local $i i32)
+    (local.set $h (local.get 0))
+    (loop $next
+      (suspend_to $ht $yield
+        (local.get $i) (local.get $h))
+      (drop) ;; drop the handle
+      (local.set $i (i32.add (i32.const 1) (local.get $i)))
+      (br $next)))
+
+  (func (export "sumUp-bad") (param $n i32) (result i32)
+    (local $i i32)
+    (local $j i32)
+    (local $k (ref $ct))
+    (local.set $k (cont.new $ct (ref.func $nats-bad)))
+    (loop $next
+      (block $on_yield (result i32 (ref $ct))
+        (resume_with $ct (on $yield $on_yield) (local.get $k))
+        (return (local.get $i))
+      ) ;; on_yield
+      (local.set $k)
+      (i32.add (local.get $i))
+      (local.set $i)
+      (local.set $j (i32.add (i32.const 1) (local.get $j)))
+      (br_if $next (i32.le_u (local.get $j) (local.get $n)))
+   )
+   (return (local.get $i)))
+
+  (elem declare func $nats $nats-bad)
+)
+(assert_return (invoke "sumUp" (i32.const 10)) (i32.const 55))
+(assert_suspension (invoke "sumUp-bad" (i32.const 10)) "unhandled tag")
+
+(module
+  (type $ht (handler))
+  (type $ft (func (param (ref $ht))))
+  (type $ct (cont $ft))
+
+  (type $ft2 (func))
+  (type $ct2 (cont $ft2))
+
+  (global $h1 (mut (ref null $ht)) (ref.null $ht))
+  (global $h2 (mut (ref null $ht)) (ref.null $ht))
+
+  (tag $yield)
+
+  (func $escape (type $ft)
+    (global.set $h2 (local.get 0))
+    (resume $ct2 (cont.new $ct2 (ref.func $do-suspend)))
+    (unreachable))
+
+  (func $do-suspend
+    (suspend_to $ht $yield (global.get $h1))
+    (unreachable))
+
+  (func $generate-name (type $ft)
+    (global.set $h1 (local.get 0))
+    (block $on_yield (result (ref $ct))
+      (resume_with $ct (on $yield $on_yield) (cont.new $ct (ref.func $escape)))
+      (unreachable)
+    ) ;; on_yield [named]
+    (unreachable))
+
+  (func (export "use-escapee")
+    (block $on_yield (result (ref $ct))
+      (resume_with $ct (on $yield $on_yield) (cont.new $ct (ref.func $generate-name)))
+      (unreachable)
+    ) ;; on_yield
+    (suspend_to $ht $yield (global.get $h2))
+    (unreachable))
+
+  (elem declare func $escape $do-suspend $generate-name)
+)
+(assert_suspension (invoke "use-escapee") "unhandled tag")