From f113cedfae00fc8ba5891147598ffdb10f35fbf3 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 22 Apr 2024 11:35:04 +0200
Subject: [PATCH 001/179] amend `S.TryE`

---
 src/lowering/desugar.ml         | 2 +-
 src/mo_def/arrange.ml           | 3 ++-
 src/mo_def/syntax.ml            | 2 +-
 src/mo_frontend/definedness.ml  | 3 ++-
 src/mo_frontend/parser.mly      | 2 +-
 src/mo_frontend/traversals.ml   | 4 ++--
 src/mo_frontend/typing.ml       | 6 +++---
 src/mo_interpreter/interpret.ml | 2 +-
 8 files changed, 13 insertions(+), 11 deletions(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index f3ffa3cacd5..39f6484bcf8 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -216,7 +216,7 @@ and exp' at note = function
   | S.OldE e -> (oldE (exp e)).it
   | S.IfE (e1, e2, e3) -> I.IfE (exp e1, exp e2, exp e3)
   | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs)
-  | S.TryE (e1, cs) -> I.TryE (exp e1, cases cs)
+  | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs)
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it
diff --git a/src/mo_def/arrange.ml b/src/mo_def/arrange.ml
index 22da9f70a56..e297c553e12 100644
--- a/src/mo_def/arrange.ml
+++ b/src/mo_def/arrange.ml
@@ -125,7 +125,8 @@ module Make (Cfg : Config) = struct
     | PrimE p             -> "PrimE"   $$ [Atom p]
     | ImportE (f, _fp)    -> "ImportE" $$ [Atom f]
     | ThrowE e            -> "ThrowE"  $$ [exp e]
-    | TryE (e, cs)        -> "TryE"    $$ [exp e] @ List.map catch cs
+    | TryE (e, cs, None)  -> "TryE"    $$ [exp e] @ List.map catch cs
+    | TryE (e, cs, Some _)-> "TryE FINALLY" $$ [exp e] @ List.map catch cs (* FIXME *)
     | IgnoreE e           -> "IgnoreE" $$ [exp e]))
 
   and exps es = List.map exp es
diff --git a/src/mo_def/syntax.ml b/src/mo_def/syntax.ml
index a23421ea6ed..60271ed9097 100644
--- a/src/mo_def/syntax.ml
+++ b/src/mo_def/syntax.ml
@@ -193,7 +193,7 @@ and exp' =
   | AnnotE of exp * typ                        (* type annotation *)
   | ImportE of (string * resolved_import ref)  (* import statement *)
   | ThrowE of exp                              (* throw exception *)
-  | TryE of exp * case list                    (* catch exception *)
+  | TryE of exp * case list * exp option       (* catch exception / finally *)
   | IgnoreE of exp                             (* ignore *)
 (*
   | FinalE of exp * exp                        (* finally *)
diff --git a/src/mo_frontend/definedness.ml b/src/mo_frontend/definedness.ml
index af8b6c99624..9255bff48c3 100644
--- a/src/mo_frontend/definedness.ml
+++ b/src/mo_frontend/definedness.ml
@@ -117,7 +117,8 @@ let rec exp msgs e : f = match e.it with
   | OldE e              -> exp msgs e
   | IfE (e1, e2, e3)    -> exps msgs [e1; e2; e3]
   | SwitchE (e, cs)     -> exp msgs e ++ cases msgs cs
-  | TryE (e, cs)        -> exp msgs e ++ cases msgs cs
+  | TryE (e, cs, None)  -> exp msgs e ++ cases msgs cs
+  | TryE (e, cs, Some f)-> exps msgs [e; f] ++ cases msgs cs
   | WhileE (e1, e2)     -> exps msgs [e1; e2]
   | LoopE (e1, None)    -> exp msgs e1
   | LoopE (e1, Some e2) -> exps msgs [e1; e2]
diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly
index 5ceca1e9e6e..d9a64a85001 100644
--- a/src/mo_frontend/parser.mly
+++ b/src/mo_frontend/parser.mly
@@ -708,7 +708,7 @@ exp_un(B) :
   | IF b=exp_nullary(ob) e1=exp_nest ELSE e2=exp_nest
     { IfE(b, e1, e2) @? at $sloc }
   | TRY e1=exp_nest c=catch
-    { TryE(e1, [c]) @? at $sloc }
+    { TryE(e1, [c], None) @? at $sloc }
 (* TODO: enable multi-branch TRY (already supported by compiler)
   | TRY e=exp_nest LCURLY cs=seplist(case, semicolon) RCURLY
     { TryE(e, cs) @? at $sloc }
diff --git a/src/mo_frontend/traversals.ml b/src/mo_frontend/traversals.ml
index db769cefbd0..aba776444b3 100644
--- a/src/mo_frontend/traversals.ml
+++ b/src/mo_frontend/traversals.ml
@@ -60,8 +60,8 @@ let rec over_exp (f : exp -> exp) (exp : exp) : exp = match exp.it with
      f { exp with it = ObjE (List.map (over_exp f) bases, List.map (over_exp_field f) efs) }
   | IfE (exp1, exp2, exp3) ->
      f { exp with it = IfE(over_exp f exp1, over_exp f exp2, over_exp f exp3) }
-  | TryE (exp1, cases) ->
-     f { exp with it = TryE (over_exp f exp1, List.map (over_case f) cases) }
+  | TryE (exp1, cases, exp2_opt) ->
+     f { exp with it = TryE (over_exp f exp1, List.map (over_case f) cases, Option.map (over_exp f) exp2_opt) }
   | SwitchE (exp1, cases) ->
      f { exp with it = SwitchE (over_exp f exp1, List.map (over_case f) cases) }
   | FuncE (name, sort_pat, typ_binds, pat, typ_opt, sugar, exp1) ->
diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml
index cc818699b33..9dcbf06bcf7 100644
--- a/src/mo_frontend/typing.ml
+++ b/src/mo_frontend/typing.ml
@@ -942,7 +942,7 @@ let rec is_explicit_exp e =
   | ObjBlockE (_, _, dfs) ->
     List.for_all (fun (df : dec_field) -> is_explicit_dec df.it.dec) dfs
   | ArrayE (_, es) -> List.exists is_explicit_exp es
-  | SwitchE (e1, cs) | TryE (e1, cs) ->
+  | SwitchE (e1, cs) | TryE (e1, cs, None) ->
     is_explicit_exp e1 &&
     List.exists (fun (c : case) -> is_explicit_exp c.it.exp) cs
   | BlockE ds -> List.for_all is_explicit_dec ds
@@ -1513,7 +1513,7 @@ and infer_exp'' env exp : T.typ =
     if not env.pre then
       coverage_cases "switch" env cases t1 exp.at;
     t
-  | TryE (exp1, cases) ->
+  | TryE (exp1, cases, None) ->
     let t1 = infer_exp env exp1 in
     let t2 = infer_cases env T.catch T.Non cases in
     if not env.pre then begin
@@ -1815,7 +1815,7 @@ and check_exp' env0 t exp : T.typ =
     check_cases env t1 t cases;
     coverage_cases "switch" env cases t1 exp.at;
     t
-  | TryE (exp1, cases), _ ->
+  | TryE (exp1, cases, None), _ ->
     check_ErrorCap env "try" exp.at;
     check_exp env t exp1;
     check_cases env T.catch t cases;
diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index 8537e4e74fe..654cab7fd39 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -620,7 +620,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     interpret_exp env exp1 (fun v1 ->
       interpret_cases env cases exp.at v1 k
       )
-  | TryE (exp1, cases) ->
+  | TryE (exp1, cases, None) ->
     let k' = fun v1 -> interpret_catches env cases exp.at v1 k in
     let env' = { env with throws = Some k' } in
     interpret_exp env' exp1 k

From 9a82bde1f7137c2206aca8ac5a42391993220a02 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 22 Apr 2024 15:50:35 +0200
Subject: [PATCH 002/179] interpret the happy path

---
 src/lowering/desugar.ml         |  1 +
 src/mo_frontend/typing.ml       | 16 +++++++++++++---
 src/mo_interpreter/interpret.ml |  5 +++++
 3 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index 39f6484bcf8..57793661814 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -217,6 +217,7 @@ and exp' at note = function
   | S.IfE (e1, e2, e3) -> I.IfE (exp e1, exp e2, exp e3)
   | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs)
   | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs)
+  | S.TryE (e1, cs, Some _ (*FIXME*)) -> I.TryE (exp e1, cases cs)
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it
diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml
index 9dcbf06bcf7..759b159fd25 100644
--- a/src/mo_frontend/typing.ml
+++ b/src/mo_frontend/typing.ml
@@ -942,7 +942,7 @@ let rec is_explicit_exp e =
   | ObjBlockE (_, _, dfs) ->
     List.for_all (fun (df : dec_field) -> is_explicit_dec df.it.dec) dfs
   | ArrayE (_, es) -> List.exists is_explicit_exp es
-  | SwitchE (e1, cs) | TryE (e1, cs, None) ->
+  | SwitchE (e1, cs) | TryE (e1, cs, _ (*FIXME?*)) ->
     is_explicit_exp e1 &&
     List.exists (fun (c : case) -> is_explicit_exp c.it.exp) cs
   | BlockE ds -> List.for_all is_explicit_dec ds
@@ -1513,13 +1513,18 @@ and infer_exp'' env exp : T.typ =
     if not env.pre then
       coverage_cases "switch" env cases t1 exp.at;
     t
-  | TryE (exp1, cases, None) ->
+  | TryE (exp1, cases, exp2_opt) ->
     let t1 = infer_exp env exp1 in
     let t2 = infer_cases env T.catch T.Non cases in
     if not env.pre then begin
       check_ErrorCap env "try" exp.at;
       coverage_cases "try handler" env cases T.catch exp.at
     end;
+    if not env.pre then
+      begin match exp2_opt with
+      | None -> ()
+      | Some exp2 -> check_exp_strong env T.unit exp2
+      end;
     T.lub t1 t2
   | WhileE (exp1, exp2) ->
     if not env.pre then begin
@@ -1815,11 +1820,16 @@ and check_exp' env0 t exp : T.typ =
     check_cases env t1 t cases;
     coverage_cases "switch" env cases t1 exp.at;
     t
-  | TryE (exp1, cases, None), _ ->
+  | TryE (exp1, cases, exp2_opt), _ ->
     check_ErrorCap env "try" exp.at;
     check_exp env t exp1;
     check_cases env T.catch t cases;
     coverage_cases "try handler" env cases T.catch exp.at;
+    if not env.pre then
+      begin match exp2_opt with
+      | None -> ()
+      | Some exp2 -> check_exp_strong env T.unit exp2
+      end;
     t
   (* TODO: allow shared with one scope par *)
   | FuncE (_, shared_pat,  [], pat, typ_opt, _sugar, exp), T.Func (s, c, [], ts1, ts2) ->
diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index 654cab7fd39..895b26ef366 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -624,6 +624,11 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     let k' = fun v1 -> interpret_catches env cases exp.at v1 k in
     let env' = { env with throws = Some k' } in
     interpret_exp env' exp1 k
+  | TryE (exp1, cases, Some exp2) ->
+    let k' = fun v1 -> interpret_catches env cases exp.at v1 k in
+    let env' = { env with throws = Some k' } in
+    let k'' v = interpret_exp env' exp2 (fun _ -> k v) in
+    interpret_exp env' exp1 k''
   | WhileE (exp1, exp2) ->
     let k_continue = fun v -> V.as_unit v; interpret_exp env exp k in
     interpret_exp env exp1 (fun v1 ->

From 7ebb915927c9734c11bc5a89722759fbed610984 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 22 Apr 2024 16:14:32 +0200
Subject: [PATCH 003/179] postcompose on the `catch` paths too

---
 src/mo_interpreter/interpret.ml | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index 895b26ef366..8008d098fc1 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -625,9 +625,11 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     let env' = { env with throws = Some k' } in
     interpret_exp env' exp1 k
   | TryE (exp1, cases, Some exp2) ->
-    let k' = fun v1 -> interpret_catches env cases exp.at v1 k in
+    let k' v1 =
+      let cleanup v2 = interpret_exp env exp2 (fun _ -> k v2) in
+      interpret_catches env cases exp.at v1 cleanup in
     let env' = { env with throws = Some k' } in
-    let k'' v = interpret_exp env' exp2 (fun _ -> k v) in
+    let k'' v2 = interpret_exp env' exp2 (fun _ -> k v2) in
     interpret_exp env' exp1 k''
   | WhileE (exp1, exp2) ->
     let k_continue = fun v -> V.as_unit v; interpret_exp env exp k in

From de5ba2a1d3f468287d9730d97a79cb02b486b59d Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 23 Apr 2024 16:27:15 +0200
Subject: [PATCH 004/179] add prelim. test

---
 test/run/ok/try-finally.comp.ok     | 1 +
 test/run/ok/try-finally.comp.ret.ok | 1 +
 test/run/ok/try-finally.diff-ir.ok  | 5 +++++
 test/run/ok/try-finally.diff-low.ok | 5 +++++
 test/run/ok/try-finally.run-ir.ok   | 1 +
 test/run/ok/try-finally.run-low.ok  | 1 +
 test/run/ok/try-finally.run.ok      | 2 ++
 test/run/ok/try-finally.tc.ok       | 4 ++++
 test/run/try-finally.mo             | 4 ++++
 9 files changed, 24 insertions(+)
 create mode 100644 test/run/ok/try-finally.comp.ok
 create mode 100644 test/run/ok/try-finally.comp.ret.ok
 create mode 100644 test/run/ok/try-finally.diff-ir.ok
 create mode 100644 test/run/ok/try-finally.diff-low.ok
 create mode 100644 test/run/ok/try-finally.run-ir.ok
 create mode 100644 test/run/ok/try-finally.run-low.ok
 create mode 100644 test/run/ok/try-finally.run.ok
 create mode 100644 test/run/ok/try-finally.tc.ok
 create mode 100644 test/run/try-finally.mo

diff --git a/test/run/ok/try-finally.comp.ok b/test/run/ok/try-finally.comp.ok
new file mode 100644
index 00000000000..675643dba7c
--- /dev/null
+++ b/test/run/ok/try-finally.comp.ok
@@ -0,0 +1 @@
+try-finally.mo:3.1-4.26: type error [M0039], misplaced try
diff --git a/test/run/ok/try-finally.comp.ret.ok b/test/run/ok/try-finally.comp.ret.ok
new file mode 100644
index 00000000000..69becfa16f9
--- /dev/null
+++ b/test/run/ok/try-finally.comp.ret.ok
@@ -0,0 +1 @@
+Return code 1
diff --git a/test/run/ok/try-finally.diff-ir.ok b/test/run/ok/try-finally.diff-ir.ok
new file mode 100644
index 00000000000..59f3f1d4b46
--- /dev/null
+++ b/test/run/ok/try-finally.diff-ir.ok
@@ -0,0 +1,5 @@
+--- try-finally.run
++++ try-finally.run-ir
+@@ -1,2 +1 @@
+ IN
+-OUT
diff --git a/test/run/ok/try-finally.diff-low.ok b/test/run/ok/try-finally.diff-low.ok
new file mode 100644
index 00000000000..83a3ea40d4a
--- /dev/null
+++ b/test/run/ok/try-finally.diff-low.ok
@@ -0,0 +1,5 @@
+--- try-finally.run
++++ try-finally.run-low
+@@ -1,2 +1 @@
+ IN
+-OUT
diff --git a/test/run/ok/try-finally.run-ir.ok b/test/run/ok/try-finally.run-ir.ok
new file mode 100644
index 00000000000..2c9e08fc61e
--- /dev/null
+++ b/test/run/ok/try-finally.run-ir.ok
@@ -0,0 +1 @@
+IN
diff --git a/test/run/ok/try-finally.run-low.ok b/test/run/ok/try-finally.run-low.ok
new file mode 100644
index 00000000000..2c9e08fc61e
--- /dev/null
+++ b/test/run/ok/try-finally.run-low.ok
@@ -0,0 +1 @@
+IN
diff --git a/test/run/ok/try-finally.run.ok b/test/run/ok/try-finally.run.ok
new file mode 100644
index 00000000000..53003c570f0
--- /dev/null
+++ b/test/run/ok/try-finally.run.ok
@@ -0,0 +1,2 @@
+IN
+OUT
diff --git a/test/run/ok/try-finally.tc.ok b/test/run/ok/try-finally.tc.ok
new file mode 100644
index 00000000000..12f760f08ed
--- /dev/null
+++ b/test/run/ok/try-finally.tc.ok
@@ -0,0 +1,4 @@
+try-finally.mo:3.1-4.26: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
new file mode 100644
index 00000000000..729e9adbe54
--- /dev/null
+++ b/test/run/try-finally.mo
@@ -0,0 +1,4 @@
+import { debugPrint } =  "mo:prim";
+
+try { debugPrint "IN" }
+case { debugPrint "OUT" };

From d19368973af517aefefcd3e90ac6a3a620e848e4 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 24 Apr 2024 14:03:59 +0200
Subject: [PATCH 005/179] complicate the test a bit

---
 doc/md/examples/grammar.txt         |  1 +
 src/mo_frontend/parser.mly          |  2 ++
 test/run/ok/try-finally.comp.ok     | 13 +++++++++-
 test/run/ok/try-finally.diff-ir.ok  |  5 ----
 test/run/ok/try-finally.diff-low.ok |  5 ----
 test/run/ok/try-finally.run-ir.ok   |  1 -
 test/run/ok/try-finally.run-low.ok  |  1 -
 test/run/ok/try-finally.run.ok      |  2 ++
 test/run/ok/try-finally.run.ret.ok  |  1 +
 test/run/ok/try-finally.tc.ok       | 10 +++++++-
 test/run/try-finally.mo             | 37 ++++++++++++++++++++++++++---
 11 files changed, 61 insertions(+), 17 deletions(-)
 delete mode 100644 test/run/ok/try-finally.diff-ir.ok
 delete mode 100644 test/run/ok/try-finally.diff-low.ok
 delete mode 100644 test/run/ok/try-finally.run-ir.ok
 delete mode 100644 test/run/ok/try-finally.run-low.ok
 create mode 100644 test/run/ok/try-finally.run.ret.ok

diff --git a/doc/md/examples/grammar.txt b/doc/md/examples/grammar.txt
index 9b30a88bff1..d4cb6641dce 100644
--- a/doc/md/examples/grammar.txt
+++ b/doc/md/examples/grammar.txt
@@ -217,6 +217,7 @@
     'if' <exp_nullary> <exp_nest>
     'if' <exp_nullary> <exp_nest> 'else' <exp_nest>
     'try' <exp_nest> <catch>
+    'try' <exp_nest> 'case' <exp_nest>
     'throw' <exp_nest>
     'switch' <exp_nullary> '{' <list(<case>, ';')> '}'
     'while' <exp_nullary> <exp_nest>
diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly
index d9a64a85001..237eb137181 100644
--- a/src/mo_frontend/parser.mly
+++ b/src/mo_frontend/parser.mly
@@ -709,6 +709,8 @@ exp_un(B) :
     { IfE(b, e1, e2) @? at $sloc }
   | TRY e1=exp_nest c=catch
     { TryE(e1, [c], None) @? at $sloc }
+  | TRY e1=exp_nest CASE e2=exp_nest (* FIXME: needs a different keyword, provisional *)
+    { TryE(e1, [], Some e2) @? at $sloc }
 (* TODO: enable multi-branch TRY (already supported by compiler)
   | TRY e=exp_nest LCURLY cs=seplist(case, semicolon) RCURLY
     { TryE(e, cs) @? at $sloc }
diff --git a/test/run/ok/try-finally.comp.ok b/test/run/ok/try-finally.comp.ok
index 675643dba7c..052310f038f 100644
--- a/test/run/ok/try-finally.comp.ok
+++ b/test/run/ok/try-finally.comp.ok
@@ -1 +1,12 @@
-try-finally.mo:3.1-4.26: type error [M0039], misplaced try
+try-finally.mo:3.1-26.2: type error [M0038], misplaced await
+try-finally.mo:3.1-26.2: type error [M0086], async expressions are not supported
+  (This is a limitation of the current version and flag -wasi-system-api.)
+try-finally.mo:33.1-33.13: type error [M0038], misplaced await
+try-finally.mo:33.7-33.13: type error [M0047], send capability required, but not available
+ (need an enclosing async expression or function body)
+try-finally.mo:34.1-34.13: type error [M0038], misplaced await
+try-finally.mo:34.7-34.13: type error [M0047], send capability required, but not available
+ (need an enclosing async expression or function body)
+try-finally.mo:35.1-35.13: type error [M0038], misplaced await
+try-finally.mo:35.7-35.13: type error [M0047], send capability required, but not available
+ (need an enclosing async expression or function body)
diff --git a/test/run/ok/try-finally.diff-ir.ok b/test/run/ok/try-finally.diff-ir.ok
deleted file mode 100644
index 59f3f1d4b46..00000000000
--- a/test/run/ok/try-finally.diff-ir.ok
+++ /dev/null
@@ -1,5 +0,0 @@
---- try-finally.run
-+++ try-finally.run-ir
-@@ -1,2 +1 @@
- IN
--OUT
diff --git a/test/run/ok/try-finally.diff-low.ok b/test/run/ok/try-finally.diff-low.ok
deleted file mode 100644
index 83a3ea40d4a..00000000000
--- a/test/run/ok/try-finally.diff-low.ok
+++ /dev/null
@@ -1,5 +0,0 @@
---- try-finally.run
-+++ try-finally.run-low
-@@ -1,2 +1 @@
- IN
--OUT
diff --git a/test/run/ok/try-finally.run-ir.ok b/test/run/ok/try-finally.run-ir.ok
deleted file mode 100644
index 2c9e08fc61e..00000000000
--- a/test/run/ok/try-finally.run-ir.ok
+++ /dev/null
@@ -1 +0,0 @@
-IN
diff --git a/test/run/ok/try-finally.run-low.ok b/test/run/ok/try-finally.run-low.ok
deleted file mode 100644
index 2c9e08fc61e..00000000000
--- a/test/run/ok/try-finally.run-low.ok
+++ /dev/null
@@ -1 +0,0 @@
-IN
diff --git a/test/run/ok/try-finally.run.ok b/test/run/ok/try-finally.run.ok
index 53003c570f0..7302bb3c105 100644
--- a/test/run/ok/try-finally.run.ok
+++ b/test/run/ok/try-finally.run.ok
@@ -1,2 +1,4 @@
 IN
 OUT
+IN2
+prim:___: execution error, uncaught throw
diff --git a/test/run/ok/try-finally.run.ret.ok b/test/run/ok/try-finally.run.ret.ok
new file mode 100644
index 00000000000..69becfa16f9
--- /dev/null
+++ b/test/run/ok/try-finally.run.ret.ok
@@ -0,0 +1 @@
+Return code 1
diff --git a/test/run/ok/try-finally.tc.ok b/test/run/ok/try-finally.tc.ok
index 12f760f08ed..c5ac4d3ed99 100644
--- a/test/run/ok/try-finally.tc.ok
+++ b/test/run/ok/try-finally.tc.ok
@@ -1,4 +1,12 @@
-try-finally.mo:3.1-4.26: warning [M0145], this try handler of type
+try-finally.mo:6.9-7.34: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:11.9-15.35: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:19.9-23.35: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
index 729e9adbe54..4a80fcfba7c 100644
--- a/test/run/try-finally.mo
+++ b/test/run/try-finally.mo
@@ -1,4 +1,35 @@
-import { debugPrint } =  "mo:prim";
+import { debugPrint; error } =  "mo:prim";
 
-try { debugPrint "IN" }
-case { debugPrint "OUT" };
+actor A {
+
+    public func t0() : async () {
+        try { debugPrint "IN" }
+        case { debugPrint "OUT" };
+    };
+
+    public func t2() : async () {
+        try {
+            debugPrint "IN2";
+            throw error "IN2";
+        }
+        case { debugPrint "OUT2" };
+    };
+
+    public func t3() : async () {
+        try {
+            debugPrint "IN3";
+            return;
+        }
+        case { debugPrint "OUT3" };
+    };
+
+};
+
+//SKIP run-low
+//SKIP run-ir
+//SKIP ic-ref-run
+
+
+await A.t0();
+await A.t2();
+await A.t3();

From 1d384d549fe259eb2ff8466d3a7e62713d901416 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 24 Apr 2024 14:20:32 +0200
Subject: [PATCH 006/179] show that `catch` works, `return` not

---
 src/mo_frontend/parser.mly         |  2 ++
 test/run/ok/try-finally.comp.ok    | 10 +++++-----
 test/run/ok/try-finally.run.ok     |  4 +++-
 test/run/ok/try-finally.run.ret.ok |  1 -
 test/run/ok/try-finally.tc.ok      |  6 +-----
 test/run/try-finally.mo            |  1 +
 6 files changed, 12 insertions(+), 12 deletions(-)
 delete mode 100644 test/run/ok/try-finally.run.ret.ok

diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly
index 237eb137181..ef62467768c 100644
--- a/src/mo_frontend/parser.mly
+++ b/src/mo_frontend/parser.mly
@@ -711,6 +711,8 @@ exp_un(B) :
     { TryE(e1, [c], None) @? at $sloc }
   | TRY e1=exp_nest CASE e2=exp_nest (* FIXME: needs a different keyword, provisional *)
     { TryE(e1, [], Some e2) @? at $sloc }
+  | TRY e1=exp_nest ELSE c=catch CASE e2=exp_nest (* FIXME: maximal kludge, just to avoid YACC errors *)
+    { TryE(e1, [c], Some e2) @? at $sloc }
 (* TODO: enable multi-branch TRY (already supported by compiler)
   | TRY e=exp_nest LCURLY cs=seplist(case, semicolon) RCURLY
     { TryE(e, cs) @? at $sloc }
diff --git a/test/run/ok/try-finally.comp.ok b/test/run/ok/try-finally.comp.ok
index 052310f038f..e2a48630967 100644
--- a/test/run/ok/try-finally.comp.ok
+++ b/test/run/ok/try-finally.comp.ok
@@ -1,12 +1,12 @@
-try-finally.mo:3.1-26.2: type error [M0038], misplaced await
-try-finally.mo:3.1-26.2: type error [M0086], async expressions are not supported
+try-finally.mo:3.1-27.2: type error [M0038], misplaced await
+try-finally.mo:3.1-27.2: type error [M0086], async expressions are not supported
   (This is a limitation of the current version and flag -wasi-system-api.)
-try-finally.mo:33.1-33.13: type error [M0038], misplaced await
-try-finally.mo:33.7-33.13: type error [M0047], send capability required, but not available
- (need an enclosing async expression or function body)
 try-finally.mo:34.1-34.13: type error [M0038], misplaced await
 try-finally.mo:34.7-34.13: type error [M0047], send capability required, but not available
  (need an enclosing async expression or function body)
 try-finally.mo:35.1-35.13: type error [M0038], misplaced await
 try-finally.mo:35.7-35.13: type error [M0047], send capability required, but not available
  (need an enclosing async expression or function body)
+try-finally.mo:36.1-36.13: type error [M0038], misplaced await
+try-finally.mo:36.7-36.13: type error [M0047], send capability required, but not available
+ (need an enclosing async expression or function body)
diff --git a/test/run/ok/try-finally.run.ok b/test/run/ok/try-finally.run.ok
index 7302bb3c105..76e88ccb0d6 100644
--- a/test/run/ok/try-finally.run.ok
+++ b/test/run/ok/try-finally.run.ok
@@ -1,4 +1,6 @@
 IN
 OUT
 IN2
-prim:___: execution error, uncaught throw
+CAUGHT2
+OUT2
+IN3
diff --git a/test/run/ok/try-finally.run.ret.ok b/test/run/ok/try-finally.run.ret.ok
deleted file mode 100644
index 69becfa16f9..00000000000
--- a/test/run/ok/try-finally.run.ret.ok
+++ /dev/null
@@ -1 +0,0 @@
-Return code 1
diff --git a/test/run/ok/try-finally.tc.ok b/test/run/ok/try-finally.tc.ok
index c5ac4d3ed99..8a4d678e460 100644
--- a/test/run/ok/try-finally.tc.ok
+++ b/test/run/ok/try-finally.tc.ok
@@ -2,11 +2,7 @@ try-finally.mo:6.9-7.34: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:11.9-15.35: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:19.9-23.35: warning [M0145], this try handler of type
+try-finally.mo:20.9-24.35: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
index 4a80fcfba7c..70f44a7b3a9 100644
--- a/test/run/try-finally.mo
+++ b/test/run/try-finally.mo
@@ -12,6 +12,7 @@ actor A {
             debugPrint "IN2";
             throw error "IN2";
         }
+        else catch _ { debugPrint "CAUGHT2" }
         case { debugPrint "OUT2" };
     };
 

From 64033284e60572224c310c6af20e1150cdffc6c8 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 25 Apr 2024 12:37:07 +0200
Subject: [PATCH 007/179] nested `try`, no cigar!

---
 test/run/ok/try-finally.comp.ok | 16 ++++++++--------
 test/run/ok/try-finally.tc.ok   |  2 +-
 test/run/try-finally.mo         | 14 +++++++++++++-
 3 files changed, 22 insertions(+), 10 deletions(-)

diff --git a/test/run/ok/try-finally.comp.ok b/test/run/ok/try-finally.comp.ok
index e2a48630967..ef0101f23b4 100644
--- a/test/run/ok/try-finally.comp.ok
+++ b/test/run/ok/try-finally.comp.ok
@@ -1,12 +1,12 @@
-try-finally.mo:3.1-27.2: type error [M0038], misplaced await
-try-finally.mo:3.1-27.2: type error [M0086], async expressions are not supported
+try-finally.mo:3.1-38.2: type error [M0038], misplaced await
+try-finally.mo:3.1-38.2: type error [M0086], async expressions are not supported
   (This is a limitation of the current version and flag -wasi-system-api.)
-try-finally.mo:34.1-34.13: type error [M0038], misplaced await
-try-finally.mo:34.7-34.13: type error [M0047], send capability required, but not available
+try-finally.mo:45.1-45.13: type error [M0038], misplaced await
+try-finally.mo:45.7-45.13: type error [M0047], send capability required, but not available
  (need an enclosing async expression or function body)
-try-finally.mo:35.1-35.13: type error [M0038], misplaced await
-try-finally.mo:35.7-35.13: type error [M0047], send capability required, but not available
+try-finally.mo:47.1-47.13: type error [M0038], misplaced await
+try-finally.mo:47.7-47.13: type error [M0047], send capability required, but not available
  (need an enclosing async expression or function body)
-try-finally.mo:36.1-36.13: type error [M0038], misplaced await
-try-finally.mo:36.7-36.13: type error [M0047], send capability required, but not available
+try-finally.mo:48.1-48.13: type error [M0038], misplaced await
+try-finally.mo:48.7-48.13: type error [M0047], send capability required, but not available
  (need an enclosing async expression or function body)
diff --git a/test/run/ok/try-finally.tc.ok b/test/run/ok/try-finally.tc.ok
index 8a4d678e460..ee1eaf103f1 100644
--- a/test/run/ok/try-finally.tc.ok
+++ b/test/run/ok/try-finally.tc.ok
@@ -2,7 +2,7 @@ try-finally.mo:6.9-7.34: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:20.9-24.35: warning [M0145], this try handler of type
+try-finally.mo:31.9-35.35: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
index 70f44a7b3a9..2e50c6ad74c 100644
--- a/test/run/try-finally.mo
+++ b/test/run/try-finally.mo
@@ -6,7 +6,18 @@ actor A {
         try { debugPrint "IN" }
         case { debugPrint "OUT" };
     };
-
+/*  nested `try` won't work
+    public func t1() : async () {
+        try {
+            try {
+                debugPrint "IN1";
+                throw error "IN1";
+            }
+            case { debugPrint "OUT1" };
+        }
+        catch _ { debugPrint "CAUGHT1" }
+    };
+*/
     public func t2() : async () {
         try {
             debugPrint "IN2";
@@ -32,5 +43,6 @@ actor A {
 
 
 await A.t0();
+//await A.t1();
 await A.t2();
 await A.t3();

From 290b184d64fa1c1ed233e065c63ae0f7cdd029ea Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 25 Apr 2024 14:22:51 +0200
Subject: [PATCH 008/179] fix up the return continuation too

---
 doc/md/examples/grammar.txt     | 1 +
 src/mo_interpreter/interpret.ml | 3 ++-
 test/run/ok/try-finally.run.ok  | 1 +
 3 files changed, 4 insertions(+), 1 deletion(-)

diff --git a/doc/md/examples/grammar.txt b/doc/md/examples/grammar.txt
index d4cb6641dce..101ce07deaf 100644
--- a/doc/md/examples/grammar.txt
+++ b/doc/md/examples/grammar.txt
@@ -218,6 +218,7 @@
     'if' <exp_nullary> <exp_nest> 'else' <exp_nest>
     'try' <exp_nest> <catch>
     'try' <exp_nest> 'case' <exp_nest>
+    'try' <exp_nest> 'else' <catch> 'case' <exp_nest>
     'throw' <exp_nest>
     'switch' <exp_nullary> '{' <list(<case>, ';')> '}'
     'while' <exp_nullary> <exp_nest>
diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index 8008d098fc1..a235a05bee7 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -628,7 +628,8 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     let k' v1 =
       let cleanup v2 = interpret_exp env exp2 (fun _ -> k v2) in
       interpret_catches env cases exp.at v1 cleanup in
-    let env' = { env with throws = Some k' } in
+    let ret ret v = interpret_exp env exp2 (fun _ -> ret v) in
+    let env' = { env with throws = Some k'; rets = Option.map ret env.rets } in
     let k'' v2 = interpret_exp env' exp2 (fun _ -> k v2) in
     interpret_exp env' exp1 k''
   | WhileE (exp1, exp2) ->
diff --git a/test/run/ok/try-finally.run.ok b/test/run/ok/try-finally.run.ok
index 76e88ccb0d6..607742cdf72 100644
--- a/test/run/ok/try-finally.run.ok
+++ b/test/run/ok/try-finally.run.ok
@@ -4,3 +4,4 @@ IN2
 CAUGHT2
 OUT2
 IN3
+OUT3

From cfe61aa9174cc3c8865c6bdd277eb885d83bf9da Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 29 Apr 2024 14:49:01 +0200
Subject: [PATCH 009/179] check that `finally` not running twice

---
 test/run/ok/try-finally.comp.ok     | 12 -----------
 test/run/ok/try-finally.comp.ret.ok |  1 -
 test/run/ok/try-finally.run.ok      |  2 ++
 test/run/ok/try-finally.tc.ok       |  4 ++++
 test/run/try-finally.mo             | 31 ++++++++++++++++++++---------
 5 files changed, 28 insertions(+), 22 deletions(-)
 delete mode 100644 test/run/ok/try-finally.comp.ok
 delete mode 100644 test/run/ok/try-finally.comp.ret.ok

diff --git a/test/run/ok/try-finally.comp.ok b/test/run/ok/try-finally.comp.ok
deleted file mode 100644
index ef0101f23b4..00000000000
--- a/test/run/ok/try-finally.comp.ok
+++ /dev/null
@@ -1,12 +0,0 @@
-try-finally.mo:3.1-38.2: type error [M0038], misplaced await
-try-finally.mo:3.1-38.2: type error [M0086], async expressions are not supported
-  (This is a limitation of the current version and flag -wasi-system-api.)
-try-finally.mo:45.1-45.13: type error [M0038], misplaced await
-try-finally.mo:45.7-45.13: type error [M0047], send capability required, but not available
- (need an enclosing async expression or function body)
-try-finally.mo:47.1-47.13: type error [M0038], misplaced await
-try-finally.mo:47.7-47.13: type error [M0047], send capability required, but not available
- (need an enclosing async expression or function body)
-try-finally.mo:48.1-48.13: type error [M0038], misplaced await
-try-finally.mo:48.7-48.13: type error [M0047], send capability required, but not available
- (need an enclosing async expression or function body)
diff --git a/test/run/ok/try-finally.comp.ret.ok b/test/run/ok/try-finally.comp.ret.ok
deleted file mode 100644
index 69becfa16f9..00000000000
--- a/test/run/ok/try-finally.comp.ret.ok
+++ /dev/null
@@ -1 +0,0 @@
-Return code 1
diff --git a/test/run/ok/try-finally.run.ok b/test/run/ok/try-finally.run.ok
index 607742cdf72..5decddaf658 100644
--- a/test/run/ok/try-finally.run.ok
+++ b/test/run/ok/try-finally.run.ok
@@ -5,3 +5,5 @@ CAUGHT2
 OUT2
 IN3
 OUT3
+IN4
+OUT4
diff --git a/test/run/ok/try-finally.tc.ok b/test/run/ok/try-finally.tc.ok
index ee1eaf103f1..e7f4e8ea23b 100644
--- a/test/run/ok/try-finally.tc.ok
+++ b/test/run/ok/try-finally.tc.ok
@@ -6,3 +6,7 @@ try-finally.mo:31.9-35.35: warning [M0145], this try handler of type
   Error
 does not cover value
   _
+try-finally.mo:40.9-43.35: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
index 2e50c6ad74c..b64947c56c4 100644
--- a/test/run/try-finally.mo
+++ b/test/run/try-finally.mo
@@ -2,12 +2,12 @@ import { debugPrint; error } =  "mo:prim";
 
 actor A {
 
-    public func t0() : async () {
+    func t0() : async () {
         try { debugPrint "IN" }
         case { debugPrint "OUT" };
     };
 /*  nested `try` won't work
-    public func t1() : async () {
+    func t1() : async () {
         try {
             try {
                 debugPrint "IN1";
@@ -18,7 +18,7 @@ actor A {
         catch _ { debugPrint "CAUGHT1" }
     };
 */
-    public func t2() : async () {
+    func t2() : async () {
         try {
             debugPrint "IN2";
             throw error "IN2";
@@ -27,7 +27,7 @@ actor A {
         case { debugPrint "OUT2" };
     };
 
-    public func t3() : async () {
+    func t3() : async () {
         try {
             debugPrint "IN3";
             return;
@@ -35,14 +35,27 @@ actor A {
         case { debugPrint "OUT3" };
     };
 
+    // check that finally not running twice
+    func t4() : async () {
+        try {
+            debugPrint "IN4";
+        }
+        case { debugPrint "OUT4" };
+        return;
+    };
+
+    public func go() : async () {
+        await t0();
+        //await t1();
+        await t2();
+        await t3();
+        await t4();
+    };
 };
 
+//SKIP comp
 //SKIP run-low
 //SKIP run-ir
 //SKIP ic-ref-run
 
-
-await A.t0();
-//await A.t1();
-await A.t2();
-await A.t3();
+A.go();

From 32ba4f600fac3bc0c0df72947bfbd0466a0f2de2 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 29 Apr 2024 15:49:40 +0200
Subject: [PATCH 010/179] test `break`

---
 test/run/ok/try-finally.run.ok | 1 +
 test/run/ok/try-finally.tc.ok  | 4 ++++
 test/run/try-finally.mo        | 9 +++++++++
 3 files changed, 14 insertions(+)

diff --git a/test/run/ok/try-finally.run.ok b/test/run/ok/try-finally.run.ok
index 5decddaf658..9340313417d 100644
--- a/test/run/ok/try-finally.run.ok
+++ b/test/run/ok/try-finally.run.ok
@@ -7,3 +7,4 @@ IN3
 OUT3
 IN4
 OUT4
+IN5
diff --git a/test/run/ok/try-finally.tc.ok b/test/run/ok/try-finally.tc.ok
index e7f4e8ea23b..771c58b98be 100644
--- a/test/run/ok/try-finally.tc.ok
+++ b/test/run/ok/try-finally.tc.ok
@@ -10,3 +10,7 @@ try-finally.mo:40.9-43.35: warning [M0145], this try handler of type
   Error
 does not cover value
   _
+try-finally.mo:48.19-52.35: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
index b64947c56c4..7b4885c1204 100644
--- a/test/run/try-finally.mo
+++ b/test/run/try-finally.mo
@@ -44,12 +44,21 @@ actor A {
         return;
     };
 
+    func t5() : async () {
+        label out try {
+            debugPrint "IN5";
+            break out;
+        }
+        case { debugPrint "OUT5" };
+    };
+
     public func go() : async () {
         await t0();
         //await t1();
         await t2();
         await t3();
         await t4();
+        await t5();
     };
 };
 

From 9933eca69fe01730b5f695583dbc75b5f925e6e9 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 29 Apr 2024 16:16:25 +0200
Subject: [PATCH 011/179] fix up outwards label continuations

---
 src/mo_interpreter/interpret.ml | 6 ++++--
 test/run/ok/try-finally.run.ok  | 1 +
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index a235a05bee7..b2539e6ad1a 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -628,8 +628,10 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     let k' v1 =
       let cleanup v2 = interpret_exp env exp2 (fun _ -> k v2) in
       interpret_catches env cases exp.at v1 cleanup in
-    let ret ret v = interpret_exp env exp2 (fun _ -> ret v) in
-    let env' = { env with throws = Some k'; rets = Option.map ret env.rets } in
+    let out ret v = interpret_exp env exp2 (fun _ -> ret v) in
+    let env' = { env with throws = Some k'
+                        ; rets = Option.map out env.rets
+                        ; labs = V.Env.map out env.labs } in
     let k'' v2 = interpret_exp env' exp2 (fun _ -> k v2) in
     interpret_exp env' exp1 k''
   | WhileE (exp1, exp2) ->
diff --git a/test/run/ok/try-finally.run.ok b/test/run/ok/try-finally.run.ok
index 9340313417d..977a2a770df 100644
--- a/test/run/ok/try-finally.run.ok
+++ b/test/run/ok/try-finally.run.ok
@@ -8,3 +8,4 @@ OUT3
 IN4
 OUT4
 IN5
+OUT5

From f73231aa7f529c948b0c2753d06a14fb88c357dd Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 30 Apr 2024 13:22:11 +0200
Subject: [PATCH 012/179] accept IR interpreters

---
 test/run/ok/try-finally.diff-ir.ok  | 14 ++++++++++++++
 test/run/ok/try-finally.diff-low.ok | 14 ++++++++++++++
 test/run/ok/try-finally.run-ir.ok   |  6 ++++++
 test/run/ok/try-finally.run-low.ok  |  6 ++++++
 test/run/try-finally.mo             |  2 --
 5 files changed, 40 insertions(+), 2 deletions(-)
 create mode 100644 test/run/ok/try-finally.diff-ir.ok
 create mode 100644 test/run/ok/try-finally.diff-low.ok
 create mode 100644 test/run/ok/try-finally.run-ir.ok
 create mode 100644 test/run/ok/try-finally.run-low.ok

diff --git a/test/run/ok/try-finally.diff-ir.ok b/test/run/ok/try-finally.diff-ir.ok
new file mode 100644
index 00000000000..0427f16b0b0
--- /dev/null
+++ b/test/run/ok/try-finally.diff-ir.ok
@@ -0,0 +1,14 @@
+--- try-finally.run
++++ try-finally.run-ir
+@@ -1,11 +1,6 @@
+ IN
+-OUT
+ IN2
+ CAUGHT2
+-OUT2
+ IN3
+-OUT3
+ IN4
+-OUT4
+ IN5
+-OUT5
diff --git a/test/run/ok/try-finally.diff-low.ok b/test/run/ok/try-finally.diff-low.ok
new file mode 100644
index 00000000000..246366276c6
--- /dev/null
+++ b/test/run/ok/try-finally.diff-low.ok
@@ -0,0 +1,14 @@
+--- try-finally.run
++++ try-finally.run-low
+@@ -1,11 +1,6 @@
+ IN
+-OUT
+ IN2
+ CAUGHT2
+-OUT2
+ IN3
+-OUT3
+ IN4
+-OUT4
+ IN5
+-OUT5
diff --git a/test/run/ok/try-finally.run-ir.ok b/test/run/ok/try-finally.run-ir.ok
new file mode 100644
index 00000000000..0e9f2796c77
--- /dev/null
+++ b/test/run/ok/try-finally.run-ir.ok
@@ -0,0 +1,6 @@
+IN
+IN2
+CAUGHT2
+IN3
+IN4
+IN5
diff --git a/test/run/ok/try-finally.run-low.ok b/test/run/ok/try-finally.run-low.ok
new file mode 100644
index 00000000000..0e9f2796c77
--- /dev/null
+++ b/test/run/ok/try-finally.run-low.ok
@@ -0,0 +1,6 @@
+IN
+IN2
+CAUGHT2
+IN3
+IN4
+IN5
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
index 7b4885c1204..b929cd73dd2 100644
--- a/test/run/try-finally.mo
+++ b/test/run/try-finally.mo
@@ -63,8 +63,6 @@ actor A {
 };
 
 //SKIP comp
-//SKIP run-low
-//SKIP run-ir
 //SKIP ic-ref-run
 
 A.go();

From d6763a082b60675ebb28c91c19039b974de4bf25 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 30 Apr 2024 15:04:33 +0200
Subject: [PATCH 013/179] checkpoint

---
 src/lowering/desugar.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index 57793661814..e268a0c09cf 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -217,7 +217,7 @@ and exp' at note = function
   | S.IfE (e1, e2, e3) -> I.IfE (exp e1, exp e2, exp e3)
   | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs)
   | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs)
-  | S.TryE (e1, cs, Some _ (*FIXME*)) -> I.TryE (exp e1, cases cs)
+  | S.TryE (e1, cs, Some e2) -> let e2 = exp e2 in I.TryE (exp e1, cases cs)
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it

From fc646127a4925e39f8886a2adf9e5bf8a1023ae0 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 2 May 2024 11:11:07 +0200
Subject: [PATCH 014/179] add a todo

---
 test/run/try-finally.mo | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
index b929cd73dd2..1c0cbce12cd 100644
--- a/test/run/try-finally.mo
+++ b/test/run/try-finally.mo
@@ -52,6 +52,8 @@ actor A {
         case { debugPrint "OUT5" };
     };
 
+    // TODO: trap on happy/catch
+
     public func go() : async () {
         await t0();
         //await t1();

From 25464c3be4465ac4f3bfcd444f12dd00bce37340 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 2 May 2024 11:36:30 +0200
Subject: [PATCH 015/179] happy path when `unit` result

---
 src/lowering/desugar.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index e268a0c09cf..92c2c8df577 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -217,7 +217,8 @@ and exp' at note = function
   | S.IfE (e1, e2, e3) -> I.IfE (exp e1, exp e2, exp e3)
   | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs)
   | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs)
-  | S.TryE (e1, cs, Some e2) -> let e2 = exp e2 in I.TryE (exp e1, cases cs)
+  | S.TryE (e1, cs, Some e2) ->
+     I.TryE (blockE [exp e1 |> expD; exp e2 |> expD] (unitE ()), cases cs)
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it

From 023b4ee7730c81c44fedfd2431fcdbb58519c28a Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 2 May 2024 11:45:55 +0200
Subject: [PATCH 016/179] accept IR happy

---
 test/run/ok/try-finally.diff-ir.ok  | 7 +++----
 test/run/ok/try-finally.diff-low.ok | 7 +++----
 test/run/ok/try-finally.run-ir.ok   | 2 ++
 test/run/ok/try-finally.run-low.ok  | 2 ++
 4 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/test/run/ok/try-finally.diff-ir.ok b/test/run/ok/try-finally.diff-ir.ok
index 0427f16b0b0..61222b5eac1 100644
--- a/test/run/ok/try-finally.diff-ir.ok
+++ b/test/run/ok/try-finally.diff-ir.ok
@@ -1,14 +1,13 @@
 --- try-finally.run
 +++ try-finally.run-ir
-@@ -1,11 +1,6 @@
- IN
--OUT
+@@ -2,10 +2,7 @@
+ OUT
  IN2
  CAUGHT2
 -OUT2
  IN3
 -OUT3
  IN4
--OUT4
+ OUT4
  IN5
 -OUT5
diff --git a/test/run/ok/try-finally.diff-low.ok b/test/run/ok/try-finally.diff-low.ok
index 246366276c6..8c0a459725a 100644
--- a/test/run/ok/try-finally.diff-low.ok
+++ b/test/run/ok/try-finally.diff-low.ok
@@ -1,14 +1,13 @@
 --- try-finally.run
 +++ try-finally.run-low
-@@ -1,11 +1,6 @@
- IN
--OUT
+@@ -2,10 +2,7 @@
+ OUT
  IN2
  CAUGHT2
 -OUT2
  IN3
 -OUT3
  IN4
--OUT4
+ OUT4
  IN5
 -OUT5
diff --git a/test/run/ok/try-finally.run-ir.ok b/test/run/ok/try-finally.run-ir.ok
index 0e9f2796c77..b320179b312 100644
--- a/test/run/ok/try-finally.run-ir.ok
+++ b/test/run/ok/try-finally.run-ir.ok
@@ -1,6 +1,8 @@
 IN
+OUT
 IN2
 CAUGHT2
 IN3
 IN4
+OUT4
 IN5
diff --git a/test/run/ok/try-finally.run-low.ok b/test/run/ok/try-finally.run-low.ok
index 0e9f2796c77..b320179b312 100644
--- a/test/run/ok/try-finally.run-low.ok
+++ b/test/run/ok/try-finally.run-low.ok
@@ -1,6 +1,8 @@
 IN
+OUT
 IN2
 CAUGHT2
 IN3
 IN4
+OUT4
 IN5

From 86ec31a12887c8a30c7eab0ed3f09f4460d6cb47 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 2 May 2024 11:51:37 +0200
Subject: [PATCH 017/179] simplify for special case

---
 src/lowering/desugar.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index 92c2c8df577..aa3ad6d6295 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -218,7 +218,7 @@ and exp' at note = function
   | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs)
   | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs)
   | S.TryE (e1, cs, Some e2) ->
-     I.TryE (blockE [exp e1 |> expD; exp e2 |> expD] (unitE ()), cases cs)
+     I.TryE (blockE [exp e1 |> expD] (exp e2), cases cs)
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it

From 90e247da149aab9793b16a0c092d04d95352eb80 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 2 May 2024 12:17:07 +0200
Subject: [PATCH 018/179] post compose cleanup with cases too

---
 src/lowering/desugar.ml             | 12 ++++++++----
 test/run/ok/try-finally.diff-ir.ok  |  6 ++----
 test/run/ok/try-finally.diff-low.ok |  6 ++----
 test/run/ok/try-finally.run-ir.ok   |  1 +
 test/run/ok/try-finally.run-low.ok  |  1 +
 5 files changed, 14 insertions(+), 12 deletions(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index aa3ad6d6295..9e488d9a274 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -218,7 +218,9 @@ and exp' at note = function
   | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs)
   | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs)
   | S.TryE (e1, cs, Some e2) ->
-     I.TryE (blockE [exp e1 |> expD] (exp e2), cases cs)
+    assert (T.is_unit note.Note.typ);
+    let post e1 = blockE [expD e1] (exp e2) in
+    I.TryE (blockE [exp e1 |> expD] (exp e2), cases_map post cs)
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it
@@ -778,11 +780,13 @@ and dec' at n = function
     } in
     I.LetD (varPat, fn)
 
-and cases cs = List.map case cs
+and cases cs = List.map (case (fun x -> x)) cs
 
-and case c = phrase case' c
+and cases_map f cs = List.map (case f) cs
 
-and case' c = S.{ I.pat = pat c.pat; I.exp = exp c.exp }
+and case f c = phrase (case' f) c
+
+and case' f c = S.{ I.pat = pat c.pat; I.exp = f (exp c.exp) }
 
 and pats ps = List.map pat ps
 
diff --git a/test/run/ok/try-finally.diff-ir.ok b/test/run/ok/try-finally.diff-ir.ok
index 61222b5eac1..1f62330c482 100644
--- a/test/run/ok/try-finally.diff-ir.ok
+++ b/test/run/ok/try-finally.diff-ir.ok
@@ -1,10 +1,8 @@
 --- try-finally.run
 +++ try-finally.run-ir
-@@ -2,10 +2,7 @@
- OUT
- IN2
+@@ -4,8 +4,6 @@
  CAUGHT2
--OUT2
+ OUT2
  IN3
 -OUT3
  IN4
diff --git a/test/run/ok/try-finally.diff-low.ok b/test/run/ok/try-finally.diff-low.ok
index 8c0a459725a..e5d11e46a92 100644
--- a/test/run/ok/try-finally.diff-low.ok
+++ b/test/run/ok/try-finally.diff-low.ok
@@ -1,10 +1,8 @@
 --- try-finally.run
 +++ try-finally.run-low
-@@ -2,10 +2,7 @@
- OUT
- IN2
+@@ -4,8 +4,6 @@
  CAUGHT2
--OUT2
+ OUT2
  IN3
 -OUT3
  IN4
diff --git a/test/run/ok/try-finally.run-ir.ok b/test/run/ok/try-finally.run-ir.ok
index b320179b312..ac636903336 100644
--- a/test/run/ok/try-finally.run-ir.ok
+++ b/test/run/ok/try-finally.run-ir.ok
@@ -2,6 +2,7 @@ IN
 OUT
 IN2
 CAUGHT2
+OUT2
 IN3
 IN4
 OUT4
diff --git a/test/run/ok/try-finally.run-low.ok b/test/run/ok/try-finally.run-low.ok
index b320179b312..ac636903336 100644
--- a/test/run/ok/try-finally.run-low.ok
+++ b/test/run/ok/try-finally.run-low.ok
@@ -2,6 +2,7 @@ IN
 OUT
 IN2
 CAUGHT2
+OUT2
 IN3
 IN4
 OUT4

From 8d649be0df6ab1004269b6367588b359fd462020 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 2 May 2024 12:18:40 +0200
Subject: [PATCH 019/179] cleanup

---
 src/lowering/desugar.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index 9e488d9a274..eb5e40a7dcb 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -220,7 +220,7 @@ and exp' at note = function
   | S.TryE (e1, cs, Some e2) ->
     assert (T.is_unit note.Note.typ);
     let post e1 = blockE [expD e1] (exp e2) in
-    I.TryE (blockE [exp e1 |> expD] (exp e2), cases_map post cs)
+    I.TryE (exp e1 |> post, cases_map post cs)
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it

From a419d8041bc03093e5954a4f50d900f240d76125 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 2 May 2024 16:34:54 +0200
Subject: [PATCH 020/179] WIP

---
 src/lowering/desugar.ml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index eb5e40a7dcb..b122278d00a 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -219,6 +219,7 @@ and exp' at note = function
   | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs)
   | S.TryE (e1, cs, Some e2) ->
     assert (T.is_unit note.Note.typ);
+    let thunk = T.(funcE ("$FIXME") Local Returns [] [] [] (exp e2)) in
     let post e1 = blockE [expD e1] (exp e2) in
     I.TryE (exp e1 |> post, cases_map post cs)
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it

From 2f455bf0b3efa7fd84226980939a30a96427de23 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 6 May 2024 11:31:19 +0200
Subject: [PATCH 021/179] WIP

---
 src/ir_def/arrange_ir.ml         | 2 +-
 src/ir_def/check_ir.ml           | 4 +++-
 src/ir_def/freevars.ml           | 2 +-
 src/ir_def/ir.ml                 | 2 +-
 src/ir_def/rename.ml             | 2 +-
 src/ir_passes/const.ml           | 7 ++++++-
 src/ir_passes/eq.ml              | 4 ++--
 src/ir_passes/erase_typ_field.ml | 4 ++--
 src/ir_passes/show.ml            | 6 +++---
 src/ir_passes/tailcall.ml        | 2 +-
 src/lowering/desugar.ml          | 6 ++++--
 11 files changed, 25 insertions(+), 16 deletions(-)

diff --git a/src/ir_def/arrange_ir.ml b/src/ir_def/arrange_ir.ml
index 7b68f595f6d..e7d37810f13 100644
--- a/src/ir_def/arrange_ir.ml
+++ b/src/ir_def/arrange_ir.ml
@@ -32,7 +32,7 @@ let rec exp e = match e.it with
     "SelfCallE" $$ [typ (Type.seq ts); exp exp_f; exp exp_k; exp exp_r]
   | ActorE (ds, fs, u, t) -> "ActorE"  $$ List.map dec ds @ fields fs @ [system u; typ t]
   | NewObjE (s, fs, t)  -> "NewObjE" $$ (Arrange_type.obj_sort s :: fields fs @ [typ t])
-  | TryE (e, cs)        -> "TryE" $$ [exp e] @ List.map case cs
+  | TryE (e, cs, _FIXME) -> "TryE" $$ [exp e] @ List.map case cs
 
 and system { meta; preupgrade; postupgrade; heartbeat; timer; inspect} = (* TODO: show meta? *)
   "System" $$ [
diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index e9c0e0d84a9..8f235aefb4f 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -718,12 +718,14 @@ let rec check_exp env (exp:Ir.exp) : unit =
         warn env exp.at "the cases in this switch do not cover all possible values";
  *)
     check_cases env t1 t cases
-  | TryE (exp1, cases) ->
+  | TryE (exp1, cases, exp2) ->
     check env.flavor.has_await "try in non-await flavor";
     check (env.async <> None) "misplaced try";
     check_exp env exp1;
     typ exp1 <: t;
     check_cases env T.catch t cases;
+    Option.iter (check_exp env) exp2;
+    Option.iter (fun exp2 -> typ exp2 <: T.unit) exp2;
   | LoopE exp1 ->
     check_exp { env with lvl = NotTopLvl } exp1;
     typ exp1 <: T.unit;
diff --git a/src/ir_def/freevars.ml b/src/ir_def/freevars.ml
index eb0f49fcc83..72dcd74ec06 100644
--- a/src/ir_def/freevars.ml
+++ b/src/ir_def/freevars.ml
@@ -118,7 +118,7 @@ let rec exp e : f = match e.it with
   | FuncE (x, s, c, tp, as_, t, e) -> under_lambda (exp e /// args as_)
   | ActorE (ds, fs, u, _)  -> actor ds fs u
   | NewObjE (_, fs, _)  -> fields fs
-  | TryE (e, cs)        -> exp e ++ cases cs
+  | TryE (e, cs, cl)    -> exp e ++ cases cs ++ (match cl with Some e -> exp e | _ -> M.empty)
   | SelfCallE (_, e1, e2, e3) -> under_lambda (exp e1) ++ exp e2 ++ exp e3
 
 and actor ds fs u = close (decs ds +++ fields fs +++ system u)
diff --git a/src/ir_def/ir.ml b/src/ir_def/ir.ml
index f58bdb9567a..84b1d9ebbd6 100644
--- a/src/ir_def/ir.ml
+++ b/src/ir_def/ir.ml
@@ -74,7 +74,7 @@ and exp' =
   | SelfCallE of Type.typ list * exp * exp * exp (* essentially ICCallPrim (FuncE shared…) *)
   | ActorE of dec list * field list * system * Type.typ (* actor *)
   | NewObjE of Type.obj_sort * field list * Type.typ  (* make an object *)
-  | TryE of exp * case list                    (* try/catch *)
+  | TryE of exp * case list * exp option       (* try/catch/cleanup *)
 
 and system = {
   meta : meta;
diff --git a/src/ir_def/rename.ml b/src/ir_def/rename.ml
index 0a14e5da22a..1ddaefe36ca 100644
--- a/src/ir_def/rename.ml
+++ b/src/ir_def/rename.ml
@@ -63,7 +63,7 @@ and exp' rho = function
      let e' = exp rho' e in
      FuncE (x, s, c, tp, p', ts, e')
   | NewObjE (s, fs, t)  -> NewObjE (s, fields rho fs, t)
-  | TryE (e, cs)        -> TryE (exp rho e, cases rho cs)
+  | TryE (e, cs, cl)    -> TryE (exp rho e, cases rho cs, Option.map (exp rho) cl)
   | SelfCallE (ts, e1, e2, e3) ->
      SelfCallE (ts, exp rho e1, exp rho e2, exp rho e3)
 
diff --git a/src/ir_passes/const.ml b/src/ir_passes/const.ml
index 063f088febb..6edd94786c9 100644
--- a/src/ir_passes/const.ml
+++ b/src/ir_passes/const.ml
@@ -152,10 +152,15 @@ let rec exp lvl (env : env) e : Lbool.t =
       exp_ lvl env e2;
       exp_ lvl env e3;
       surely_false
-    | SwitchE (e1, cs) | TryE (e1, cs) ->
+    | SwitchE (e1, cs) | TryE (e1, cs, None) ->
       exp_ lvl env e1;
       List.iter (case_ lvl env) cs;
       surely_false
+    | TryE (e1, cs, Some e2) ->
+      exp_ lvl env e1;
+      List.iter (case_ lvl env) cs;
+      exp_ lvl env e2;
+      surely_false
     | NewObjE _ -> (* mutable objects *)
       surely_false
     | ActorE (ds, fs, {meta; preupgrade; postupgrade; heartbeat; timer; inspect}, _typ) ->
diff --git a/src/ir_passes/eq.ml b/src/ir_passes/eq.ml
index 92eb02988f9..3d4605f7f10 100644
--- a/src/ir_passes/eq.ml
+++ b/src/ir_passes/eq.ml
@@ -229,14 +229,14 @@ and t_exp' env = function
         cases
     in
     SwitchE (t_exp env exp1, cases')
-  | TryE (exp1, cases) ->
+  | TryE (exp1, cases, exp2) ->
     let cases' =
       List.map
         (fun {it = {pat;exp}; at; note} ->
           {it = {pat = pat; exp = t_exp env exp}; at; note})
         cases
     in
-    TryE (t_exp env exp1, cases')
+    TryE (t_exp env exp1, cases', Option.map (t_exp env) exp2)
   | LoopE exp1 ->
     LoopE (t_exp env exp1)
   | LabelE (id, typ, exp1) ->
diff --git a/src/ir_passes/erase_typ_field.ml b/src/ir_passes/erase_typ_field.ml
index 3a999ebe0a9..7ba5f63cd0d 100644
--- a/src/ir_passes/erase_typ_field.ml
+++ b/src/ir_passes/erase_typ_field.ml
@@ -118,8 +118,8 @@ let transform prog =
       LabelE (id, t_typ typ, t_exp exp1)
     | AsyncE (s, tb, exp1, typ) ->
       AsyncE (s, t_typ_bind tb, t_exp exp1, t_typ typ)
-    | TryE (exp1, cases) ->
-      TryE (t_exp exp1, List.map t_case cases)
+    | TryE (exp1, cases, exp2) ->
+      TryE (t_exp exp1, List.map t_case cases, Option.map t_exp exp2)
     | DeclareE (id, typ, exp1) ->
       DeclareE (id, t_typ typ, t_exp exp1)
     | DefineE (id, mut ,exp1) ->
diff --git a/src/ir_passes/show.ml b/src/ir_passes/show.ml
index 08f70ea5be8..de351926061 100644
--- a/src/ir_passes/show.ml
+++ b/src/ir_passes/show.ml
@@ -271,14 +271,14 @@ and t_exp' env = function
         cases
     in
     SwitchE (t_exp env exp1, cases')
-  | TryE (exp1, cases) ->
+  | TryE (exp1, cases, exp2) ->
     let cases' =
       List.map
         (fun {it = {pat;exp}; at; note} ->
-          {it = {pat = pat; exp = t_exp env exp}; at; note})
+          {it = {pat; exp = t_exp env exp}; at; note})
         cases
     in
-    TryE (t_exp env exp1, cases')
+    TryE (t_exp env exp1, cases', Option.map (t_exp env) exp2)
   | LoopE exp1 ->
     LoopE (t_exp env exp1)
   | LabelE (id, typ, exp1) ->
diff --git a/src/ir_passes/tailcall.ml b/src/ir_passes/tailcall.ml
index 3734fc8409e..165df14c47e 100644
--- a/src/ir_passes/tailcall.ml
+++ b/src/ir_passes/tailcall.ml
@@ -106,7 +106,7 @@ and exp' env e  : exp' = match e.it with
   | BlockE (ds, e)      -> BlockE (block env ds e)
   | IfE (e1, e2, e3)    -> IfE (exp env e1, tailexp env e2, tailexp env e3)
   | SwitchE (e, cs)     -> SwitchE (exp env e, cases env cs)
-  | TryE (e, cs)        -> TryE (exp env e, cases env cs) (* TBR *)
+  | TryE (e, cs, e2)    -> TryE (exp env e, cases env cs, Option.map (exp env) e2) (* TBR *)
   | LoopE e1            -> LoopE (exp env e1)
   | LabelE (i, t, e)    -> let env1 = bind env i None in
                            LabelE(i, t, exp env1 e)
diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index b122278d00a..034df04dbd8 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -219,9 +219,11 @@ and exp' at note = function
   | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs)
   | S.TryE (e1, cs, Some e2) ->
     assert (T.is_unit note.Note.typ);
-    let thunk = T.(funcE ("$FIXME") Local Returns [] [] [] (exp e2)) in
+    (*let thunk = T.(funcE ("$FIXME") Local Returns [] [] [] (exp e2)) in*)
     let post e1 = blockE [expD e1] (exp e2) in
-    I.TryE (exp e1 |> post, cases_map post cs)
+    let post e1 = blockE [letD v e1; expD (callE thunk (unitE ()))] (varE v) in
+    (*blockE [letD thunk]*)
+      I.TryE (exp e1 |> post, cases_map post cs, Some thunk)
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it

From 82f355a3afe24fa5aa809efa77bad696c8935e65 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 7 May 2024 12:40:32 +0200
Subject: [PATCH 022/179] more WIP

---
 src/ir_interpreter/interpret_ir.ml |  2 +-
 src/ir_passes/await.ml             |  2 +-
 src/lowering/desugar.ml            | 14 ++++++++------
 test/run/try-finally.mo            |  6 +++++-
 4 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index f8c245b5769..0e4791e49da 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -492,7 +492,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     interpret_exp env exp1 (fun v1 ->
       interpret_cases env cases exp.at v1 k
     )
-  | TryE (exp1, cases) ->
+  | TryE (exp1, cases, _TODO) ->
     let k' = fun v1 -> interpret_catches env cases exp.at v1 k in
     let env' = { env with throws = Some k' } in
     interpret_exp env' exp1 k
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 3cf213b2b2e..d465b26ecc4 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -324,7 +324,7 @@ and c_exp' context exp k =
                at = exp.at;
                note = Note.{ exp.note with typ = typ' } }))
     end)
-  | TryE (exp1, cases) ->
+  | TryE (exp1, cases, _TODO) ->
     (* TODO: do we need to reify f? *)
     let f = match LabelEnv.find Throw context with Cont f -> f | _ -> assert false in
     letcont f (fun f ->
diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index 034df04dbd8..83d48a4e7d6 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -216,14 +216,16 @@ and exp' at note = function
   | S.OldE e -> (oldE (exp e)).it
   | S.IfE (e1, e2, e3) -> I.IfE (exp e1, exp e2, exp e3)
   | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs)
-  | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs)
+  | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs, None)
   | S.TryE (e1, cs, Some e2) ->
     assert (T.is_unit note.Note.typ);
-    (*let thunk = T.(funcE ("$FIXME") Local Returns [] [] [] (exp e2)) in*)
-    let post e1 = blockE [expD e1] (exp e2) in
-    let post e1 = blockE [letD v e1; expD (callE thunk (unitE ()))] (varE v) in
-    (*blockE [letD thunk]*)
-      I.TryE (exp e1 |> post, cases_map post cs, Some thunk)
+    let thunk = T.(funcE ("$FIXME") Local Returns [] [] [] (exp e2)) in
+    (*let post e1 = blockE [expD e1] (exp e2) in*)
+    let v = fresh_var "res" note.Note.typ in
+    let post e1 = blockE [letD v e1; expD (callE thunk [] (unitE ()))] (varE v) in
+    let th = fresh_var "thunk" thunk.note.typ in
+    (blockE [letD th thunk]
+      { e1 with it = I.TryE (exp e1 |> post, cases_map post cs, Some (varE th)); note }).it
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
index 1c0cbce12cd..90fe86a2a2c 100644
--- a/test/run/try-finally.mo
+++ b/test/run/try-finally.mo
@@ -6,6 +6,7 @@ actor A {
         try { debugPrint "IN" }
         case { debugPrint "OUT" };
     };
+
 /*  nested `try` won't work
     func t1() : async () {
         try {
@@ -18,6 +19,7 @@ actor A {
         catch _ { debugPrint "CAUGHT1" }
     };
 */
+
     func t2() : async () {
         try {
             debugPrint "IN2";
@@ -27,6 +29,8 @@ actor A {
         case { debugPrint "OUT2" };
     };
 
+    //TODO: func t2t() : async Int { ... }
+
     func t3() : async () {
         try {
             debugPrint "IN3";
@@ -55,7 +59,7 @@ actor A {
     // TODO: trap on happy/catch
 
     public func go() : async () {
-        await t0();
+        /*ignore*/ await t0();
         //await t1();
         await t2();
         await t3();

From 0e4d181cd746fbfb42e5367e48756e45907d3b48 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 7 May 2024 13:04:32 +0200
Subject: [PATCH 023/179] sharing fix

---
 src/lowering/desugar.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index 83d48a4e7d6..df537c7ed6f 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -222,8 +222,8 @@ and exp' at note = function
     let thunk = T.(funcE ("$FIXME") Local Returns [] [] [] (exp e2)) in
     (*let post e1 = blockE [expD e1] (exp e2) in*)
     let v = fresh_var "res" note.Note.typ in
-    let post e1 = blockE [letD v e1; expD (callE thunk [] (unitE ()))] (varE v) in
-    let th = fresh_var "thunk" thunk.note.typ in
+    let th = fresh_var "thunk" thunk.note.Note.typ in
+    let post e1 = blockE [letD v e1; expD (callE (varE th) [] (unitE ()))] (varE v) in
     (blockE [letD th thunk]
       { e1 with it = I.TryE (exp e1 |> post, cases_map post cs, Some (varE th)); note }).it
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it

From 8bc89b7fdbb3688a1804c6eba3c9c91a5ca253da Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 8 May 2024 09:12:10 +0200
Subject: [PATCH 024/179] WIP: analyse the context

---
 src/ir_passes/await.ml  | 42 +++++++++++++++++++++++++++++++++++++++--
 src/lowering/desugar.ml |  4 ++--
 2 files changed, 42 insertions(+), 4 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index d465b26ecc4..4f3ff88dce5 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -324,14 +324,14 @@ and c_exp' context exp k =
                at = exp.at;
                note = Note.{ exp.note with typ = typ' } }))
     end)
-  | TryE (exp1, cases, _TODO) ->
+  | TryE (exp1, cases, None) ->
     (* TODO: do we need to reify f? *)
     let f = match LabelEnv.find Throw context with Cont f -> f | _ -> assert false in
     letcont f (fun f ->
     letcont k (fun k ->
     match eff exp1 with
     | T.Triv ->
-      varE k -*- (t_exp context exp1)
+      varE k -*- t_exp context exp1
     | T.Await ->
       let error = fresh_var "v" T.catch  in
       let cases' =
@@ -359,6 +359,44 @@ and c_exp' context exp k =
         ]
         (c_exp context' exp1 (ContVar k))
     ))
+  | TryE (exp1, cases, Some exp2) ->
+    (* TODO: do we need to reify f? *)
+    let f = match LabelEnv.find Throw context with Cont f -> f | _ -> assert false in
+    letcont f (fun f ->
+    letcont k (fun k ->
+    match eff exp1 with
+    | T.Triv -> assert false (* TODO: maybe lift this later? *)
+    | T.Await ->
+      let error = fresh_var "v" T.catch in
+      let cases' =
+        List.map
+          (fun {it = {pat;exp}; at; note} ->
+            let exp' = match eff exp with
+              | T.Triv -> varE k -*- (t_exp context exp)
+              | T.Await -> c_exp context exp (ContVar k)
+            in
+            { it = { pat; exp = exp' }; at; note })
+          cases
+        @ [{ it = {pat = varP error; exp = varE f -*- varE error};
+             at = no_region;
+             note = ()
+        }] in
+      let throw = fresh_err_cont (answerT (typ_of_var k)) in
+      let lab n = function
+        | Label -> failwith "Label"
+        | Cont _ -> failwith "Cont" in
+      let context'' = LabelEnv.mapi (function | Return | Throw -> fun c -> c | Named n -> lab n) context in
+      let context' = LabelEnv.add Throw (Cont (ContVar throw)) context in
+      blockE
+        [ let e = fresh_var "e" T.catch in
+          funcD throw e {
+            it = SwitchE (varE e, cases');
+            at = exp.at;
+            note = Note.{ def with typ = typ_cases cases'; eff = T.Await; (* shouldn't matter *) }
+          }
+        ]
+        (c_exp context' exp1 (ContVar k))
+    ))
   | LoopE exp1 ->
     c_loop context k exp1
   | LabelE (id, _typ, exp1) ->
diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index df537c7ed6f..bee0feb73d3 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -223,8 +223,8 @@ and exp' at note = function
     (*let post e1 = blockE [expD e1] (exp e2) in*)
     let v = fresh_var "res" note.Note.typ in
     let th = fresh_var "thunk" thunk.note.Note.typ in
-    let post e1 = blockE [letD v e1; expD (callE (varE th) [] (unitE ()))] (varE v) in
-    (blockE [letD th thunk]
+    let post e1 = blockE [letD v e1; expD (varE th -*- unitE ())] (varE v) in
+    (blockE [letD th thunk] (* use funcD for thunk? *)
       { e1 with it = I.TryE (exp e1 |> post, cases_map post cs, Some (varE th)); note }).it
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)

From f8fb9b0d66b44258b35fa9c5e9dad4edaec988f8 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 8 May 2024 11:53:37 +0200
Subject: [PATCH 025/179] WIP

---
 src/lowering/desugar.ml | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index bee0feb73d3..b76fc7ccc9a 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -218,12 +218,14 @@ and exp' at note = function
   | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs)
   | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs, None)
   | S.TryE (e1, cs, Some e2) ->
-    assert (T.is_unit note.Note.typ);
+    assert (T.is_unit note.Note.typ); (* NOPE!*)
     let thunk = T.(funcE ("$FIXME") Local Returns [] [] [] (exp e2)) in
     (*let post e1 = blockE [expD e1] (exp e2) in*)
-    let v = fresh_var "res" note.Note.typ in
+    assert T.(is_func thunk.note.Note.typ);
     let th = fresh_var "thunk" thunk.note.Note.typ in
-    let post e1 = blockE [letD v e1; expD (varE th -*- unitE ())] (varE v) in
+    let post e1 =
+      let v = fresh_var "res" note.Note.typ in
+      blockE [letD v e1; expD (varE th -*- unitE ())] (varE v) in
     (blockE [letD th thunk] (* use funcD for thunk? *)
       { e1 with it = I.TryE (exp e1 |> post, cases_map post cs, Some (varE th)); note }).it
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it

From 7dd2eaaa6784dd9e130ea8e1215228a4efbf256f Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 10 May 2024 13:17:11 +0200
Subject: [PATCH 026/179] disable flawed check

---
 src/ir_def/check_ir.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 8f235aefb4f..0cf2ba93ec0 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -725,7 +725,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
     typ exp1 <: t;
     check_cases env T.catch t cases;
     Option.iter (check_exp env) exp2;
-    Option.iter (fun exp2 -> typ exp2 <: T.unit) exp2;
+  (*Option.iter (fun exp2 -> typ exp2 <: TODO: T.unit->unit) exp2;*)
   | LoopE exp1 ->
     check_exp { env with lvl = NotTopLvl } exp1;
     typ exp1 <: T.unit;

From 278f8604cfacff8d1a57b626688f75b644e22873 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 13 May 2024 15:39:52 +0200
Subject: [PATCH 027/179] WIP: try precomposing the `finally`-thunk on the
 label continuation

---
 src/ir_passes/await.ml       | 25 +++++++++++-
 test/run-drun/try-finally.mo | 78 ++++++++++++++++++++++++++++++++++++
 2 files changed, 101 insertions(+), 2 deletions(-)
 create mode 100644 test/run-drun/try-finally.mo

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 4f3ff88dce5..caf6e101e06 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -37,6 +37,22 @@ let letcont k scope =
     blockE [funcD k' v e] (* at this point, I'm really worried about variable capture *)
             (scope k')
 
+
+let precont k thunk =
+  (* let thread e = *)
+    match k with
+    | ContVar k' ->
+       MetaCont (T.unit, fun _v -> blockE [expD (thunk -*- unitE ())] (varE k'  -*- unitE ()))
+
+       (*failwith "ContVar"       scope k'          letcont eta-contraction *)
+    | MetaCont (typ0, cont) -> failwith "MetaCont"
+       (*let v = fresh_var "v" typ0 in
+       let e = cont v in
+       let k' = fresh_cont typ0 (typ e) in
+       blockE [funcD k' v e] (* at this point, I'm really worried about variable capture *)
+         (scope k') in
+  MetaCont *)
+
 (* Named labels for break, special labels for return and throw *)
 type label = Return | Throw | Named of string
 
@@ -384,9 +400,14 @@ and c_exp' context exp k =
       let throw = fresh_err_cont (answerT (typ_of_var k)) in
       let lab n = function
         | Label -> failwith "Label"
-        | Cont _ -> failwith "Cont" in
+        | Cont l ->
+           (*let k_lab = fresh_cont T.unit T.unit in*)
+           (*MetaCont (T.unit, letcont l (fun l -> failwith "reified")*)
+           Cont (precont l exp2)
+           
+      in
       let context'' = LabelEnv.mapi (function | Return | Throw -> fun c -> c | Named n -> lab n) context in
-      let context' = LabelEnv.add Throw (Cont (ContVar throw)) context in
+      let context' = LabelEnv.add Throw (Cont (ContVar throw)) context'' in
       blockE
         [ let e = fresh_var "e" T.catch in
           funcD throw e {
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
new file mode 100644
index 00000000000..659f8042495
--- /dev/null
+++ b/test/run-drun/try-finally.mo
@@ -0,0 +1,78 @@
+import { debugPrint; error } =  "mo:prim";
+
+actor A {
+    func m() : async () {
+    };
+    
+
+    func t0() : async () {
+        try { debugPrint "IN"; await m(); }
+        case { debugPrint "OUT" };
+    };
+
+/*  nested `try` won't work
+    func t1() : async () {
+        try {
+            try {
+                debugPrint "IN1";
+                throw error "IN1";
+            }
+            case { debugPrint "OUT1" };
+        }
+        catch _ { debugPrint "CAUGHT1" }
+    };
+*/
+/*
+    func t2() : async () {
+        try {
+            debugPrint "IN2";
+            throw error "IN2";
+        }
+        else catch _ { debugPrint "CAUGHT2" }
+        case { debugPrint "OUT2" };
+    };
+
+    //TODO: func t2t() : async Int { ... }
+
+    func t3() : async () {
+        try {
+            debugPrint "IN3";
+            return;
+        }
+        case { debugPrint "OUT3" };
+    };
+
+    // check that finally not running twice
+    func t4() : async () {
+        try {
+            debugPrint "IN4";
+        }
+        case { debugPrint "OUT4" };
+        return;
+    };
+*/
+    func t5() : async () {
+        label out try {
+            debugPrint "IN5";
+            await m();
+            break out;
+        }
+        case { debugPrint "OUT5" };
+    };
+
+    // TODO: trap on happy/catch
+
+    public func go() : async () {
+        /*ignore*/ await t0();
+        //await t1();
+        /*await t2();
+        await t3();
+        await t4();*/
+        await t5();
+    };
+};
+
+//XSKIP comp
+//SKIP ic-ref-run
+
+A.go(); //OR-CALL ingress go "DIDL\x00\x00"

From ebdeeb70072c75ff483001a97b66218300e721b2 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 13 May 2024 16:03:48 +0200
Subject: [PATCH 028/179] use the respons variable

(I am not entrely sure abou this...)
---
 src/ir_passes/await.ml | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index caf6e101e06..5900450848e 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -39,10 +39,9 @@ let letcont k scope =
 
 
 let precont k thunk =
-  (* let thread e = *)
     match k with
     | ContVar k' ->
-       MetaCont (T.unit, fun _v -> blockE [expD (thunk -*- unitE ())] (varE k'  -*- unitE ()))
+       MetaCont (T.unit, fun v -> blockE [expD (thunk -*- unitE ())] (varE k' -*- varE v))
 
        (*failwith "ContVar"       scope k'          letcont eta-contraction *)
     | MetaCont (typ0, cont) -> failwith "MetaCont"

From a428afad01bb2708a0abf0942caece3bc0fa836e Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 13 May 2024 18:03:45 +0200
Subject: [PATCH 029/179] WIP: try to implement the nested `try` case

---
 src/ir_passes/await.ml       | 15 ++++-----------
 test/run-drun/try-finally.mo | 19 +++++++++++++++++++
 test/run/try-finally.mo      | 16 ++++++++++------
 3 files changed, 33 insertions(+), 17 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 5900450848e..0b46cecaad4 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -37,20 +37,13 @@ let letcont k scope =
     blockE [funcD k' v e] (* at this point, I'm really worried about variable capture *)
             (scope k')
 
-
+(* pre-compose a continuation with a call to a `finally`-thunk *)
 let precont k thunk =
     match k with
     | ContVar k' ->
-       MetaCont (T.unit, fun v -> blockE [expD (thunk -*- unitE ())] (varE k' -*- varE v))
-
-       (*failwith "ContVar"       scope k'          letcont eta-contraction *)
-    | MetaCont (typ0, cont) -> failwith "MetaCont"
-       (*let v = fresh_var "v" typ0 in
-       let e = cont v in
-       let k' = fresh_cont typ0 (typ e) in
-       blockE [funcD k' v e] (* at this point, I'm really worried about variable capture *)
-         (scope k') in
-  MetaCont *)
+       MetaCont ((*FIXME: T.dom (typ_of_var v)*) T.unit, fun v -> blockE [expD (thunk -*- unitE ())] (varE k' -*- varE v))
+    | MetaCont (typ0, cont) ->
+      MetaCont (typ0, fun v -> blockE [expD (thunk -*- unitE ())] (cont v))
 
 (* Named labels for break, special labels for return and throw *)
 type label = Return | Throw | Named of string
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 659f8042495..6624a32a139 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -52,12 +52,30 @@ actor A {
     };
 */
     func t5() : async () {
+        debugPrint "BEFORE5";
         label out try {
             debugPrint "IN5";
             await m();
             break out;
+            debugPrint "DEAD5";
         }
         case { debugPrint "OUT5" };
+        debugPrint "AFTER5"
+    };
+
+    func t6() : async () {
+        debugPrint "BEFORE6";
+        label out try {
+            debugPrint "IN6";
+            try {
+                debugPrint "InnerIN6";
+                await m();
+                break out;
+            } case { debugPrint "innerOUT6" };
+            debugPrint "DEAD6";
+        }
+        case { debugPrint "OUT6" };
+        debugPrint "AFTER6"
     };
 
     // TODO: trap on happy/catch
@@ -69,6 +87,7 @@ actor A {
         await t3();
         await t4();*/
         await t5();
+        await t6();
     };
 };
 
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
index 90fe86a2a2c..e417b5419c6 100644
--- a/test/run/try-finally.mo
+++ b/test/run/try-finally.mo
@@ -1,9 +1,12 @@
 import { debugPrint; error } =  "mo:prim";
 
 actor A {
+    func m() : async () {
+    };
+    
 
     func t0() : async () {
-        try { debugPrint "IN" }
+        try { debugPrint "IN"; await m(); }
         case { debugPrint "OUT" };
     };
 
@@ -19,7 +22,7 @@ actor A {
         catch _ { debugPrint "CAUGHT1" }
     };
 */
-
+/*
     func t2() : async () {
         try {
             debugPrint "IN2";
@@ -47,10 +50,11 @@ actor A {
         case { debugPrint "OUT4" };
         return;
     };
-
+*/
     func t5() : async () {
         label out try {
             debugPrint "IN5";
+            await m();
             break out;
         }
         case { debugPrint "OUT5" };
@@ -61,14 +65,14 @@ actor A {
     public func go() : async () {
         /*ignore*/ await t0();
         //await t1();
-        await t2();
+        /*await t2();
         await t3();
-        await t4();
+        await t4();*/
         await t5();
     };
 };
 
-//SKIP comp
+//XSKIP comp
 //SKIP ic-ref-run
 
 A.go();

From 6c7f0ad41b9053ee77e122e0216128cd07210af9 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 13 May 2024 18:17:09 +0200
Subject: [PATCH 030/179] cleanup

---
 src/ir_passes/await.ml | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 0b46cecaad4..34e38b80c99 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -393,10 +393,8 @@ and c_exp' context exp k =
       let lab n = function
         | Label -> failwith "Label"
         | Cont l ->
-           (*let k_lab = fresh_cont T.unit T.unit in*)
-           (*MetaCont (T.unit, letcont l (fun l -> failwith "reified")*)
-           Cont (precont l exp2)
-           
+          Cont (precont l exp2)
+
       in
       let context'' = LabelEnv.mapi (function | Return | Throw -> fun c -> c | Named n -> lab n) context in
       let context' = LabelEnv.add Throw (Cont (ContVar throw)) context'' in

From 47910404c6d134b4d3ff5fa8c7bc4dc140cbd773 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 14 May 2024 11:46:59 +0200
Subject: [PATCH 031/179] test with `drun`

---
 test/run-drun/ok/try-finally.diff-ir.ok  | 15 +++++++++++++++
 test/run-drun/ok/try-finally.drun-run.ok | 19 +++++++++++++++++++
 test/run-drun/ok/try-finally.run-ir.ok   | 13 +++++++++++++
 test/run-drun/ok/try-finally.run-low.ok  | 16 ++++++++++++++++
 test/run-drun/ok/try-finally.run.ok      | 16 ++++++++++++++++
 test/run-drun/ok/try-finally.tc.ok       | 16 ++++++++++++++++
 test/run-drun/try-finally.mo             | 13 +++++++------
 7 files changed, 102 insertions(+), 6 deletions(-)
 create mode 100644 test/run-drun/ok/try-finally.diff-ir.ok
 create mode 100644 test/run-drun/ok/try-finally.drun-run.ok
 create mode 100644 test/run-drun/ok/try-finally.run-ir.ok
 create mode 100644 test/run-drun/ok/try-finally.run-low.ok
 create mode 100644 test/run-drun/ok/try-finally.run.ok
 create mode 100644 test/run-drun/ok/try-finally.tc.ok

diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
new file mode 100644
index 00000000000..da77e074820
--- /dev/null
+++ b/test/run-drun/ok/try-finally.diff-ir.ok
@@ -0,0 +1,15 @@
+--- try-finally.run
++++ try-finally.run-ir
+@@ -5,12 +5,9 @@
+ OUT2
+ BEFORE5
+ IN5
+-OUT5
+ AFTER5
+ BEFORE6
+ IN6
+ InnerIN6
+ InnerLIVE6
+-InnerOUT6
+-OUT6
+ AFTER6
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
new file mode 100644
index 00000000000..264cc4df03b
--- /dev/null
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -0,0 +1,19 @@
+ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
+ingress Completed: Reply: 0x4449444c0000
+debug.print: IN
+debug.print: OUT
+debug.print: IN2
+debug.print: CAUGHT2
+debug.print: OUT2
+debug.print: BEFORE5
+debug.print: IN5
+debug.print: OUT5
+debug.print: AFTER5
+debug.print: BEFORE6
+debug.print: IN6
+debug.print: InnerIN6
+debug.print: InnerLIVE6
+debug.print: InnerOUT6
+debug.print: OUT6
+debug.print: AFTER6
+ingress Completed: Reply: 0x4449444c0000
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
new file mode 100644
index 00000000000..0d13843d740
--- /dev/null
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -0,0 +1,13 @@
+IN
+OUT
+IN2
+CAUGHT2
+OUT2
+BEFORE5
+IN5
+AFTER5
+BEFORE6
+IN6
+InnerIN6
+InnerLIVE6
+AFTER6
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
new file mode 100644
index 00000000000..c83e175a7be
--- /dev/null
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -0,0 +1,16 @@
+IN
+OUT
+IN2
+CAUGHT2
+OUT2
+BEFORE5
+IN5
+OUT5
+AFTER5
+BEFORE6
+IN6
+InnerIN6
+InnerLIVE6
+InnerOUT6
+OUT6
+AFTER6
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
new file mode 100644
index 00000000000..c83e175a7be
--- /dev/null
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -0,0 +1,16 @@
+IN
+OUT
+IN2
+CAUGHT2
+OUT2
+BEFORE5
+IN5
+OUT5
+AFTER5
+BEFORE6
+IN6
+InnerIN6
+InnerLIVE6
+InnerOUT6
+OUT6
+AFTER6
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
new file mode 100644
index 00000000000..12ef233d10a
--- /dev/null
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -0,0 +1,16 @@
+try-finally.mo:9.9-10.34: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:56.19-62.35: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:70.13-76.46: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:68.19-79.35: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 6624a32a139..7304a75c77f 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -22,7 +22,7 @@ actor A {
         catch _ { debugPrint "CAUGHT1" }
     };
 */
-/*
+
     func t2() : async () {
         try {
             debugPrint "IN2";
@@ -31,7 +31,7 @@ actor A {
         else catch _ { debugPrint "CAUGHT2" }
         case { debugPrint "OUT2" };
     };
-
+/*
     //TODO: func t2t() : async Int { ... }
 
     func t3() : async () {
@@ -70,8 +70,10 @@ actor A {
             try {
                 debugPrint "InnerIN6";
                 await m();
+                debugPrint "InnerLIVE6";
                 break out;
-            } case { debugPrint "innerOUT6" };
+                debugPrint "InnerDEAD6";
+            } case { debugPrint "InnerOUT6" };
             debugPrint "DEAD6";
         }
         case { debugPrint "OUT6" };
@@ -83,15 +85,14 @@ actor A {
     public func go() : async () {
         /*ignore*/ await t0();
         //await t1();
-        /*await t2();
-        await t3();
+        await t2();
+        /*await t3();
         await t4();*/
         await t5();
         await t6();
     };
 };
 
-//XSKIP comp
 //SKIP ic-ref-run
 
 A.go(); //OR-CALL ingress go "DIDL\x00\x00"

From f0e15e89f56e1375d546876235a77f70a1dac04f Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 14 May 2024 11:56:20 +0200
Subject: [PATCH 032/179] tweaks

---
 src/ir_passes/await.ml | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 34e38b80c99..0277f95e095 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -41,7 +41,11 @@ let letcont k scope =
 let precont k thunk =
     match k with
     | ContVar k' ->
-       MetaCont ((*FIXME: T.dom (typ_of_var v)*) T.unit, fun v -> blockE [expD (thunk -*- unitE ())] (varE k' -*- varE v))
+      let dom = match typ_of_var k' with
+        | T.(Func (Local, Returns, [], [], _)) -> T.unit
+        | T.(Func (Local, Returns, [], [dom], _)) -> dom
+        | _ -> assert false in
+      MetaCont (dom, fun v -> blockE [expD (thunk -*- unitE ())] (varE k' -*- varE v))
     | MetaCont (typ0, cont) ->
       MetaCont (typ0, fun v -> blockE [expD (thunk -*- unitE ())] (cont v))
 
@@ -78,7 +82,7 @@ let rec t_async context exp =
    let k_fail = fresh_err_cont T.unit in
    let context' =
      LabelEnv.add Return (Cont (ContVar k_ret))
-       (LabelEnv.add Throw (Cont (ContVar k_fail)) LabelEnv.empty)
+       (LabelEnv.singleton Throw (Cont (ContVar k_fail)))
    in
      cps_asyncE s typ1 (typ exp1)
        (forall [tb] ([k_ret; k_fail] -->*
@@ -108,9 +112,9 @@ and t_exp' context exp =
     SwitchE (t_exp context exp1, cases')
   | LoopE exp1 ->
     LoopE (t_exp context exp1)
-  | LabelE (id, _typ, exp1) ->
+  | LabelE (id, typ, exp1) ->
     let context' = LabelEnv.add (Named id) Label context in
-    LabelE (id, _typ, t_exp context' exp1)
+    LabelE (id, typ, t_exp context' exp1)
   | PrimE (BreakPrim id, [exp1]) ->
     begin
       match LabelEnv.find_opt (Named id) context with
@@ -160,7 +164,7 @@ and t_exp' context exp =
   | FuncE (x, s, c, typbinds, pat, typs, exp1) ->
     assert (not (T.is_local_async_func (typ exp)));
     assert (not (T.is_shared_func (typ exp)));
-    let context' = LabelEnv.add Return Label LabelEnv.empty in
+    let context' = LabelEnv.singleton Return Label in
     FuncE (x, s, c, typbinds, pat, typs, t_exp context' exp1)
   | ActorE (ds, ids, { meta; preupgrade; postupgrade; heartbeat; timer; inspect}, t) ->
     ActorE (t_decs context ds, ids,
@@ -444,7 +448,7 @@ and c_exp' context exp k =
     let k_fail = fresh_err_cont T.unit in
     let context' =
       LabelEnv.add Return (Cont (ContVar k_ret))
-        (LabelEnv.add Throw (Cont (ContVar k_fail)) LabelEnv.empty)
+        (LabelEnv.singleton Throw (Cont (ContVar k_fail)))
     in
     let r = match LabelEnv.find_opt Throw context with
       | Some (Cont r) -> r

From 067a35b3e68d1ce1c085d817f8962ab1beacb85c Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 14 May 2024 12:23:16 +0200
Subject: [PATCH 033/179] more tweaks

---
 src/ir_def/construct.ml |  2 +-
 src/ir_passes/await.ml  | 18 ++++++------------
 2 files changed, 7 insertions(+), 13 deletions(-)

diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 8c0a52a2bb9..56c52b82855 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -313,7 +313,7 @@ let funcE name sort ctrl typ_binds args typs exp =
   }
 
 let callE exp1 typs exp2 =
-  let typ =  match T.promote (typ exp1) with
+  let typ = match T.promote (typ exp1) with
     | T.Func (_sort, control, _, _, ret_tys) ->
       T.codom control (fun () -> List.hd typs) (List.map (T.open_ typs) ret_tys)
     | T.Non -> T.Non
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 0277f95e095..8a837c79fb6 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -423,22 +423,19 @@ and c_exp' context exp k =
     begin
       match LabelEnv.find_opt (Named id) context with
       | Some (Cont k') -> c_exp context exp1 k'
-      | Some Label -> assert false
-      | None -> assert false
+      | _ -> assert false
     end
   | PrimE (RetPrim, [exp1]) ->
     begin
       match LabelEnv.find_opt Return context with
       | Some (Cont k') -> c_exp context exp1 k'
-      | Some Label -> assert false
-      | None -> assert false
+      | _ -> assert false
     end
   | PrimE (ThrowPrim, [exp1]) ->
     begin
       match LabelEnv.find_opt Throw context with
       | Some (Cont k') -> c_exp context exp1 k'
-      | Some Label
-      | None -> assert false
+      | _ -> assert false
     end
   | AsyncE (T.Cmp, tb, exp1, typ1) ->
     assert false (* must have effect T.Triv, handled by first case *)
@@ -452,8 +449,7 @@ and c_exp' context exp k =
     in
     let r = match LabelEnv.find_opt Throw context with
       | Some (Cont r) -> r
-      | Some Label
-      | None -> assert false
+      | _ -> assert false
     in
     let cps_async =
       cps_asyncE T.Fut typ1 (typ exp1)
@@ -469,8 +465,7 @@ and c_exp' context exp k =
   | PrimE (AwaitPrim s, [exp1]) ->
     let r = match LabelEnv.find_opt Throw context with
       | Some (Cont r) -> r
-      | Some Label
-      | None -> assert false
+      | _ -> assert false
     in
     letcont r (fun r ->
     letcont k (fun k ->
@@ -491,8 +486,7 @@ and c_exp' context exp k =
   | PrimE (p, exps) when is_async_call p exps ->
     let r = match LabelEnv.find_opt Throw context with
       | Some (Cont r) -> r
-      | Some Label
-      | None -> assert false
+      | _ -> assert false
     in
     let k' = meta (typ exp)
       (fun v ->

From 7456f5a332bc8b484c4bfaaddb117a665ad30750 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 14 May 2024 12:24:25 +0200
Subject: [PATCH 034/179] `Label` cannot happen, see `BreakPrim` below

---
 src/ir_passes/await.ml | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 8a837c79fb6..da7a8a3ad70 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -395,13 +395,11 @@ and c_exp' context exp k =
         }] in
       let throw = fresh_err_cont (answerT (typ_of_var k)) in
       let lab n = function
-        | Label -> failwith "Label"
-        | Cont l ->
-          Cont (precont l exp2)
-
+        | Cont l -> Cont (precont l exp2)
+        | Label -> assert false
       in
-      let context'' = LabelEnv.mapi (function | Return | Throw -> fun c -> c | Named n -> lab n) context in
-      let context' = LabelEnv.add Throw (Cont (ContVar throw)) context'' in
+      let context' = LabelEnv.mapi (function | Return | Throw -> fun c -> c | Named n -> lab n) context in
+      let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
       blockE
         [ let e = fresh_var "e" T.catch in
           funcD throw e {
@@ -410,7 +408,7 @@ and c_exp' context exp k =
             note = Note.{ def with typ = typ_cases cases'; eff = T.Await; (* shouldn't matter *) }
           }
         ]
-        (c_exp context' exp1 (ContVar k))
+        (c_exp context'' exp1 (ContVar k))
     ))
   | LoopE exp1 ->
     c_loop context k exp1

From 60cd29337e2f2fc6f00d80f4dc182b67325bc8b0 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 14 May 2024 12:43:04 +0200
Subject: [PATCH 035/179] cleanups

---
 src/ir_passes/await.ml | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index da7a8a3ad70..5c429019cda 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -39,15 +39,16 @@ let letcont k scope =
 
 (* pre-compose a continuation with a call to a `finally`-thunk *)
 let precont k thunk =
-    match k with
-    | ContVar k' ->
-      let dom = match typ_of_var k' with
-        | T.(Func (Local, Returns, [], [], _)) -> T.unit
-        | T.(Func (Local, Returns, [], [dom], _)) -> dom
-        | _ -> assert false in
-      MetaCont (dom, fun v -> blockE [expD (thunk -*- unitE ())] (varE k' -*- varE v))
-    | MetaCont (typ0, cont) ->
-      MetaCont (typ0, fun v -> blockE [expD (thunk -*- unitE ())] (cont v))
+  let finally = blockE [expD (thunk -*- unitE ())] in
+  match k with
+  | ContVar k' ->
+     let typ = match typ_of_var k' with
+       | T.(Func (Local, Returns, [], [], _)) -> T.unit
+       | T.(Func (Local, Returns, [], [typ], _)) -> typ
+       | _ -> assert false in
+    MetaCont (typ, fun v -> finally (varE k' -*- varE v))
+  | MetaCont (typ, cont) ->
+    MetaCont (typ, fun v -> finally (cont v))
 
 (* Named labels for break, special labels for return and throw *)
 type label = Return | Throw | Named of string

From 5f822528948d10deb70d20e37f69006188be351c Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 14 May 2024 13:04:20 +0200
Subject: [PATCH 036/179] test `return`

---
 test/run-drun/ok/try-finally.diff-ir.ok  |  5 ++++-
 test/run-drun/ok/try-finally.diff-low.ok | 10 ++++++++++
 test/run-drun/ok/try-finally.drun-run.ok |  1 +
 test/run-drun/ok/try-finally.run-ir.ok   |  1 +
 test/run-drun/ok/try-finally.run-low.ok  |  1 +
 test/run-drun/ok/try-finally.run.ok      |  2 ++
 test/run-drun/ok/try-finally.tc.ok       | 10 +++++++---
 test/run-drun/try-finally.mo             |  9 +++++----
 8 files changed, 31 insertions(+), 8 deletions(-)
 create mode 100644 test/run-drun/ok/try-finally.diff-low.ok

diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
index da77e074820..19c96dd36d8 100644
--- a/test/run-drun/ok/try-finally.diff-ir.ok
+++ b/test/run-drun/ok/try-finally.diff-ir.ok
@@ -1,7 +1,10 @@
 --- try-finally.run
 +++ try-finally.run-ir
-@@ -5,12 +5,9 @@
+@@ -4,15 +4,11 @@
+ CAUGHT2
  OUT2
+ IN3
+-OUT3
  BEFORE5
  IN5
 -OUT5
diff --git a/test/run-drun/ok/try-finally.diff-low.ok b/test/run-drun/ok/try-finally.diff-low.ok
new file mode 100644
index 00000000000..acdb0c9da57
--- /dev/null
+++ b/test/run-drun/ok/try-finally.diff-low.ok
@@ -0,0 +1,10 @@
+--- try-finally.run
++++ try-finally.run-low
+@@ -4,7 +4,6 @@
+ CAUGHT2
+ OUT2
+ IN3
+-OUT3
+ BEFORE5
+ IN5
+ OUT5
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 264cc4df03b..a1d42d07024 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -5,6 +5,7 @@ debug.print: OUT
 debug.print: IN2
 debug.print: CAUGHT2
 debug.print: OUT2
+debug.print: IN3
 debug.print: BEFORE5
 debug.print: IN5
 debug.print: OUT5
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index 0d13843d740..1f770a7e031 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -3,6 +3,7 @@ OUT
 IN2
 CAUGHT2
 OUT2
+IN3
 BEFORE5
 IN5
 AFTER5
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index c83e175a7be..872a4e90ddd 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -3,6 +3,7 @@ OUT
 IN2
 CAUGHT2
 OUT2
+IN3
 BEFORE5
 IN5
 OUT5
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index c83e175a7be..1129288641e 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -3,6 +3,8 @@ OUT
 IN2
 CAUGHT2
 OUT2
+IN3
+OUT3
 BEFORE5
 IN5
 OUT5
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 12ef233d10a..1a29a98acff 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -2,15 +2,19 @@ try-finally.mo:9.9-10.34: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:56.19-62.35: warning [M0145], this try handler of type
+try-finally.mo:38.9-43.35: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:70.13-76.46: warning [M0145], this try handler of type
+try-finally.mo:57.19-63.35: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:68.19-79.35: warning [M0145], this try handler of type
+try-finally.mo:71.13-77.46: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:69.19-80.35: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 7304a75c77f..7b96f77d13f 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -31,17 +31,18 @@ actor A {
         else catch _ { debugPrint "CAUGHT2" }
         case { debugPrint "OUT2" };
     };
-/*
+
     //TODO: func t2t() : async Int { ... }
 
     func t3() : async () {
         try {
             debugPrint "IN3";
+            await m();
             return;
         }
         case { debugPrint "OUT3" };
     };
-
+/*
     // check that finally not running twice
     func t4() : async () {
         try {
@@ -86,8 +87,8 @@ actor A {
         /*ignore*/ await t0();
         //await t1();
         await t2();
-        /*await t3();
-        await t4();*/
+        await t3();
+        /*await t4();*/
         await t5();
         await t6();
     };

From 1e5905260721ea14ad02c5347ea648775af4c6e0 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 14 May 2024 13:28:59 +0200
Subject: [PATCH 037/179] cover `Return` "labels" too

---
 src/ir_passes/await.ml                   |  2 +-
 test/run-drun/ok/try-finally.diff-low.ok | 10 ----------
 test/run-drun/ok/try-finally.drun-run.ok |  1 +
 test/run-drun/ok/try-finally.run-low.ok  |  1 +
 4 files changed, 3 insertions(+), 11 deletions(-)
 delete mode 100644 test/run-drun/ok/try-finally.diff-low.ok

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 5c429019cda..a1ac2d01657 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -399,7 +399,7 @@ and c_exp' context exp k =
         | Cont l -> Cont (precont l exp2)
         | Label -> assert false
       in
-      let context' = LabelEnv.mapi (function | Return | Throw -> fun c -> c | Named n -> lab n) context in
+      let context' = LabelEnv.mapi (function | Return -> lab "" | Throw -> fun c -> c | Named n -> lab n) context in
       let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
       blockE
         [ let e = fresh_var "e" T.catch in
diff --git a/test/run-drun/ok/try-finally.diff-low.ok b/test/run-drun/ok/try-finally.diff-low.ok
deleted file mode 100644
index acdb0c9da57..00000000000
--- a/test/run-drun/ok/try-finally.diff-low.ok
+++ /dev/null
@@ -1,10 +0,0 @@
---- try-finally.run
-+++ try-finally.run-low
-@@ -4,7 +4,6 @@
- CAUGHT2
- OUT2
- IN3
--OUT3
- BEFORE5
- IN5
- OUT5
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index a1d42d07024..e98009c7de8 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -6,6 +6,7 @@ debug.print: IN2
 debug.print: CAUGHT2
 debug.print: OUT2
 debug.print: IN3
+debug.print: OUT3
 debug.print: BEFORE5
 debug.print: IN5
 debug.print: OUT5
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index 872a4e90ddd..1129288641e 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -4,6 +4,7 @@ IN2
 CAUGHT2
 OUT2
 IN3
+OUT3
 BEFORE5
 IN5
 OUT5

From 279f61e8fefb69f2be72a225be4cf94a0429652d Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 14 May 2024 13:33:15 +0200
Subject: [PATCH 038/179] cleanup

---
 src/ir_passes/await.ml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index a1ac2d01657..cb4586f1c1f 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -395,11 +395,11 @@ and c_exp' context exp k =
              note = ()
         }] in
       let throw = fresh_err_cont (answerT (typ_of_var k)) in
-      let lab n = function
-        | Cont l -> Cont (precont l exp2)
+      let lab = function
+        | Cont k -> Cont (precont k exp2)
         | Label -> assert false
       in
-      let context' = LabelEnv.mapi (function | Return -> lab "" | Throw -> fun c -> c | Named n -> lab n) context in
+      let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Throw -> fun c -> c) context in
       let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
       blockE
         [ let e = fresh_var "e" T.catch in

From e3713c2645e157beb55a6594acaf0d70027e44f4 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 17 May 2024 13:03:59 +0200
Subject: [PATCH 039/179] tweaks

---
 src/ir_passes/async.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 5d4a000cabf..a25ef22425a 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -254,7 +254,7 @@ let transform prog =
           (* unit answer type, from await in `async {}` *)
           (ensureNamed (t_exp kr) (fun vkr ->
             let schedule = fresh_var "schedule" (T.Func(T.Local, T.Returns, [], [], [])) in
-            switch_variantE ((t_exp a) -*- varE vkr)
+            switch_variantE (t_exp a -*- varE vkr)
               [ ("suspend", wildP,
                   unitE()); (* suspend *)
                 ("schedule", varP schedule, (* resume later *)
@@ -271,7 +271,7 @@ let transform prog =
     | PrimE (CPSAwait (Cmp, cont_typ), [a; kr]) ->
       begin match cont_typ with
       | Func(_, _, [], _, []) ->
-         ((t_exp a) -*- (t_exp kr)).it
+         (t_exp a -*- t_exp kr).it
       | _ -> assert false
       end
     | PrimE (CPSAsync (Fut, t), [exp1]) ->

From 85ee9b7a1c744a76eb979a408adc9add4b3c6804 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 22 May 2024 10:44:36 +0200
Subject: [PATCH 040/179] WIP

---
 src/ir_def/check_ir.ml       | 10 +++++-----
 src/ir_def/construct.ml      |  8 ++++----
 src/ir_def/construct.mli     |  2 +-
 src/ir_passes/async.ml       | 31 +++++++++++++++++--------------
 src/ir_passes/await.ml       |  3 ++-
 src/prelude/internals.mo     | 16 ++++++++--------
 test/run-drun/try-finally.mo | 10 +++++-----
 7 files changed, 42 insertions(+), 38 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 0cf2ba93ec0..98ae474f2dd 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -365,13 +365,13 @@ let rec check_exp env (exp:Ir.exp) : unit =
   (* helpers *)
   let check p = check env exp.at p in
   let (<:) t1 t2 =
-(*  try *)
+  try
       check_sub env exp.at t1 t2
-(*  with e ->
+  with e ->
      (Printf.eprintf "(in here):\n%s"
         (Wasm.Sexpr.to_string 80 (Arrange_ir.exp exp));
       raise e)
-*)
+
   in
   (* check for aliasing *)
   if exp.note.Note.check_run = env.check_run
@@ -549,7 +549,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
       check (T.shared (T.seq ots)) "DeserializeOpt is not defined for operand type";
       typ exp1 <: T.blob;
       T.Opt (T.seq ots) <: t
-    | CPSAwait (s, cont_typ), [a; kr] ->
+    | CPSAwait (s, cont_typ), [a; krc] ->
       let (_, t1) =
         try T.as_async_sub s T.Non (T.normalize (typ a))
         with _ -> error env exp.at "CPSAwait expect async arg, found %s" (T.string_of_typ (typ a))
@@ -560,7 +560,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
            (match ts2 with
             | [] -> ()
             | _ -> error env exp.at "CPSAwait answer type error");
-           typ kr <: T.Tup [cont_typ; T.Func(T.Local, T.Returns, [], [T.catch], ts2)];
+           typ krc <: T.Tup [cont_typ; T.Func(T.Local, T.Returns, [], [T.catch], ts2); cont_typ(* BETTER: T.Func(T.Local, T.Returns, [], [], ts2)*)];
            t1 <: T.seq ts1;
            T.seq ts2 <: t;
          end;
diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 56c52b82855..b5c3c9c8fc9 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -183,8 +183,8 @@ let ic_rejectE e =
     note = Note.{ def with typ = T.unit; eff = eff e }
   }
 
-let ic_callE f e k r =
-  let es = [f; e; k; r] in
+let ic_callE f e k r c =
+  let es = [f; e; k; r(*; c*)] in
   let effs = List.map eff es in
   let eff = List.fold_left max_eff T.Triv effs in
   { it = PrimE (ICCallPrim, es);
@@ -192,7 +192,7 @@ let ic_callE f e k r =
     note = Note.{ def with typ = T.unit; eff = eff }
   }
 
-let ic_call_rawE p m a k r =
+let ic_call_rawE p m a k r = (* FIXME *)
   let es = [p; m; a; k; r] in
   let effs = List.map eff es in
   let eff = List.fold_left max_eff T.Triv effs in
@@ -637,7 +637,7 @@ let answerT typ : T.typ =
   | T.Func (T.Local, T.Returns, [], ts1, ts2) -> T.seq ts2
   | _ -> assert false
 
-let cpsT typ ans_typ = T.(Func (Local, Returns, [], [contT typ ans_typ; err_contT ans_typ], as_seq ans_typ))
+let cpsT typ ans_typ = T.(Func (Local, Returns, [], [contT typ ans_typ; err_contT ans_typ; contT T.unit ans_typ], as_seq ans_typ))
 
 (* Sequence expressions *)
 
diff --git a/src/ir_def/construct.mli b/src/ir_def/construct.mli
index 731568f94a2..d693c854563 100644
--- a/src/ir_def/construct.mli
+++ b/src/ir_def/construct.mli
@@ -55,7 +55,7 @@ val cps_asyncE : async_sort -> typ -> typ -> exp -> exp
 val cps_awaitE : async_sort -> typ -> exp -> exp -> exp
 val ic_replyE : typ list -> exp -> exp
 val ic_rejectE : exp -> exp
-val ic_callE : exp -> exp -> exp -> exp -> exp
+val ic_callE : exp -> exp -> exp -> exp -> exp -> exp
 val ic_call_rawE : exp -> exp -> exp -> exp -> exp -> exp
 val projE : exp -> int -> exp
 val optE : exp -> exp
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index a25ef22425a..1fab2ece8ed 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -42,6 +42,8 @@ let fulfillT as_seq typ = T.Func(T.Local, T.Returns, [], as_seq typ, [])
 
 let failT = T.Func(T.Local, T.Returns, [], [T.catch], [])
 
+(*let cleanupT = T.Func(T.Local, T.Returns, [], [], [])*)
+
 let t_async_fut as_seq t =
   T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT],
     [T.sum [
@@ -57,9 +59,9 @@ let new_asyncT =
   T.Func (
     T.Local,
     T.Returns,
-    [ { var = "T"; sort = T.Type; bound = T.Any } ],
+    [ { var = "TX"; sort = T.Type; bound = T.Any } ],
     [],
-    new_async_ret unary (T.Var ("T", 0)))
+    new_async_ret unary (T.Var ("TX", 0)))
 
 let new_asyncE () =
   varE (var "@new_async" new_asyncT)
@@ -81,6 +83,7 @@ let new_nary_async_reply ts =
       let v = fresh_var "v" u in
       let k = fresh_var "k" (contT u T.unit) in
       let r = fresh_var "r" (err_contT T.unit) in
+      let c = fresh_var "c" T.(contT unit unit) in
       [k; r] -->* (
         varE unary_async -*-
           (tupE [
@@ -117,7 +120,7 @@ let new_nary_async_reply ts =
     fresh_var "reject" (typ_of_var fail)
   in
     (async, reply, reject),
-      blockE [letP (tupP [varP unary_async; varP unary_fulfill; varP fail])  call_new_async]
+      blockE [letP (tupP [varP unary_async; varP unary_fulfill; varP fail]) call_new_async]
         (tupE [nary_async; nary_reply; varE fail])
 
 
@@ -248,30 +251,30 @@ let transform prog =
     | VarE id -> exp'
     | AssignE (exp1, exp2) ->
       AssignE (t_lexp exp1, t_exp exp2)
-    | PrimE (CPSAwait (Fut, cont_typ), [a; kr]) ->
+    | PrimE (CPSAwait (Fut, cont_typ), [a; krc]) ->
       begin match cont_typ with
         | Func(_, _, [], _, []) ->
           (* unit answer type, from await in `async {}` *)
-          (ensureNamed (t_exp kr) (fun vkr ->
+          (ensureNamed (t_exp krc) (fun vkrc ->
             let schedule = fresh_var "schedule" (T.Func(T.Local, T.Returns, [], [], [])) in
-            switch_variantE (t_exp a -*- varE vkr)
+            switch_variantE (t_exp a -*- varE vkrc)
               [ ("suspend", wildP,
                   unitE()); (* suspend *)
                 ("schedule", varP schedule, (* resume later *)
                   (* try await async (); schedule() catch e -> r(e) *)
                  (let v = fresh_var "call" T.unit in
                   letE v
-                    (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkr) 1))
-                    (check_call_perform_status (varE v) (fun e -> projE (varE vkr) 1 -*- e))))
+                    (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1))
+                    (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
               ]
               T.unit
           )).it
         | _ -> assert false
       end
-    | PrimE (CPSAwait (Cmp, cont_typ), [a; kr]) ->
+    | PrimE (CPSAwait (Cmp, cont_typ), [a; krc]) ->
       begin match cont_typ with
       | Func(_, _, [], _, []) ->
-         (t_exp a -*- t_exp kr).it
+         (t_exp a -*- t_exp krc).it
       | _ -> assert false
       end
     | PrimE (CPSAsync (Fut, t), [exp1]) ->
@@ -308,7 +311,7 @@ let transform prog =
       let v_ret = fresh_var "v" t_ret in
       let v_fail = fresh_var "e" t_fail in
       ([v_ret; v_fail] -->* (callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail]))).it
-    | PrimE (CallPrim typs, [exp1; exp2]) when is_awaitable_func exp1 ->
+    | PrimE (CallPrim typs, [exp1; exp2]) when is_awaitable_func exp1 ->(* HERE *)
       let ts1,ts2 =
         match typ exp1 with
         | T.Func (T.Shared _, T.Promises, tbs, ts1, ts2) ->
@@ -318,14 +321,14 @@ let transform prog =
       in
       let exp1' = t_exp exp1 in
       let exp2' = t_exp exp2 in
-      let ((nary_async, nary_reply, reject), def) =
+      let ((nary_async, nary_reply, reject(*, cleanup*)), def) =
         new_nary_async_reply ts2
       in
       (blockE (
-        letP (tupP [varP nary_async; varP nary_reply; varP reject]) def ::
+        letP (tupP [varP nary_async; varP nary_reply; varP reject(*; varP cleanup*)]) def ::
         let_eta exp1' (fun v1 ->
           let_seq ts1 exp2' (fun vs ->
-            [ expD (ic_callE v1 (seqE (List.map varE vs)) (varE nary_reply) (varE reject)) ]
+            [ expD (ic_callE v1 (seqE (List.map varE vs)) (varE nary_reply) (varE reject) (varE reject)) ]
            )
           )
          )
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index cb4586f1c1f..db8c3e57ae3 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -473,8 +473,9 @@ and c_exp' context exp k =
       | T.Triv ->
         cps_awaitE s (typ_of_var k) (t_exp context exp1) kr
       | T.Await ->
+        let krc = tupE [varE k; varE r; varE k(* FIXME: cleanups*)] in
         c_exp context exp1
-          (meta (typ exp1) (fun v1 -> (cps_awaitE s (typ_of_var k) (varE v1) kr)))
+          (meta (typ exp1) (fun v1 -> (cps_awaitE s (typ_of_var k) (varE v1) krc)))
     ))
   | DeclareE (id, typ, exp1) ->
     unary context k (fun v1 -> e (DeclareE (id, typ, varE v1))) exp1
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index 3cba8906b82..70c2d94e6ba 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -285,7 +285,7 @@ func @equal_array<T>(eq : (T, T) -> Bool, a : [T], b : [T]) : Bool {
 };
 
 type @Cont<T> = T -> () ;
-type @Async<T> = (@Cont<T>,@Cont<Error>) -> {
+type @Async<TF> = (@Cont<TF>,@Cont<Error>) -> {
   #suspend;
   #schedule : () -> ();
 };
@@ -307,15 +307,15 @@ func @getSystemRefund() : @Refund {
   return (prim "cyclesRefunded" : () -> Nat) ();
 };
 
-func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>) {
-  let w_null = func(r : @Refund, t : T) { };
+func @new_async<TM <: Any>() : (@Async<TM>, @Cont<TM>, @Cont<Error>) {
+  let w_null = func(r : @Refund, t : TM) { };
   let r_null = func(_ : Error) {};
-  var result : ?(@Result<T>) = null;
-  var ws : @Waiter<T> = w_null;
+  var result : ?(@Result<TM>) = null;
+  var ws : @Waiter<TM> = w_null;
   var rs : @Cont<Error> = r_null;
   let getRefund = @cycles != 0;
 
-  func fulfill(t : T) {
+  func fulfill(t : TM) {
     switch result {
       case null {
         let refund = if getRefund @getSystemRefund() else 0;
@@ -342,14 +342,14 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>) {
     };
   };
 
-  func enqueue(k : @Cont<T>, r : @Cont<Error>) : {
+  func enqueue(k : @Cont<TM>, r : @Cont<Error>) : {
     #suspend;
     #schedule : () -> ();
   } {
     switch result {
       case null {
         let ws_ = ws;
-        ws := func(r : @Refund, t : T) {
+        ws := func(r : @Refund, t : TM) {
           ws_(r, t);
           @reset_cycles();
           @refund := r;
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 7b96f77d13f..f67cb10bc27 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -22,7 +22,7 @@ actor A {
         catch _ { debugPrint "CAUGHT1" }
     };
 */
-
+/*
     func t2() : async () {
         try {
             debugPrint "IN2";
@@ -80,20 +80,20 @@ actor A {
         case { debugPrint "OUT6" };
         debugPrint "AFTER6"
     };
-
+*/
     // TODO: trap on happy/catch
 
     public func go() : async () {
         /*ignore*/ await t0();
         //await t1();
-        await t2();
+        /*await t2();
         await t3();
         /*await t4();*/
         await t5();
-        await t6();
+        await t6();*/
     };
 };
 
 //SKIP ic-ref-run
 
-A.go(); //OR-CALL ingress go "DIDL\x00\x00"
+//A.go(); //OR-CALL ingress go "DIDL\x00\x00"

From 70e96b7ac0a8a656c0d52dca6f716feee8e4b83d Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 22 May 2024 15:02:40 +0200
Subject: [PATCH 041/179] WIP: more

---
 src/ir_passes/async.ml | 5 +++--
 src/ir_passes/await.ml | 2 +-
 2 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 1fab2ece8ed..0d18f386da7 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -311,7 +311,7 @@ let transform prog =
       let v_ret = fresh_var "v" t_ret in
       let v_fail = fresh_var "e" t_fail in
       ([v_ret; v_fail] -->* (callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail]))).it
-    | PrimE (CallPrim typs, [exp1; exp2]) when is_awaitable_func exp1 ->(* HERE *)
+    | PrimE (CallPrim typs (Some cleanup), [exp1; exp2]) when is_awaitable_func exp1 ->(* HERE *)
       let ts1,ts2 =
         match typ exp1 with
         | T.Func (T.Shared _, T.Promises, tbs, ts1, ts2) ->
@@ -334,7 +334,8 @@ let transform prog =
          )
          (varE nary_async))
         .it
-    | PrimE (OtherPrim "call_raw", [exp1; exp2; exp3]) ->
+    | PrimE (OtherPrim "call_raw_cleanup", [exp1; exp2; exp3; cleanup]) ->
+    | PrimE (CleanupPrim (OtherPrim "call_raw", cleanup), [exp1; exp2; exp3]) ->
       let exp1' = t_exp exp1 in
       let exp2' = t_exp exp2 in
       let exp3' = t_exp exp3 in
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index db8c3e57ae3..41d703df8df 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -475,7 +475,7 @@ and c_exp' context exp k =
       | T.Await ->
         let krc = tupE [varE k; varE r; varE k(* FIXME: cleanups*)] in
         c_exp context exp1
-          (meta (typ exp1) (fun v1 -> (cps_awaitE s (typ_of_var k) (varE v1) krc)))
+          (meta (typ exp1) (fun v1 -> (cps_awaitE s (typ_of_var k) (varE v1) kr)))
     ))
   | DeclareE (id, typ, exp1) ->
     unary context k (fun v1 -> e (DeclareE (id, typ, varE v1))) exp1

From c6a132958cb67af648922d2e8f20ed2d74db308f Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 22 May 2024 16:35:16 +0200
Subject: [PATCH 042/179] WIP: roll back some wrong ideas

---
 src/ir_def/check_ir.ml   |  4 ++--
 src/ir_def/construct.ml  | 27 +++++++++++----------------
 src/ir_def/construct.mli |  2 +-
 src/ir_def/ir_effect.ml  |  2 +-
 src/ir_passes/async.ml   | 22 +++++++++-------------
 src/ir_passes/await.ml   |  1 -
 6 files changed, 24 insertions(+), 34 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 98ae474f2dd..3ceed133103 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -549,7 +549,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
       check (T.shared (T.seq ots)) "DeserializeOpt is not defined for operand type";
       typ exp1 <: T.blob;
       T.Opt (T.seq ots) <: t
-    | CPSAwait (s, cont_typ), [a; krc] ->
+    | CPSAwait (s, cont_typ), [a; kr] ->
       let (_, t1) =
         try T.as_async_sub s T.Non (T.normalize (typ a))
         with _ -> error env exp.at "CPSAwait expect async arg, found %s" (T.string_of_typ (typ a))
@@ -560,7 +560,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
            (match ts2 with
             | [] -> ()
             | _ -> error env exp.at "CPSAwait answer type error");
-           typ krc <: T.Tup [cont_typ; T.Func(T.Local, T.Returns, [], [T.catch], ts2); cont_typ(* BETTER: T.Func(T.Local, T.Returns, [], [], ts2)*)];
+           typ kr <: T.Tup [cont_typ; T.Func(T.Local, T.Returns, [], [T.catch], ts2)];
            t1 <: T.seq ts1;
            T.seq ts2 <: t;
          end;
diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index b5c3c9c8fc9..de738956ce4 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -117,8 +117,7 @@ let primE prim es =
     | OtherPrim "is_controller" -> T.bool
     | _ -> assert false (* implement more as needed *)
   in
-  let effs = List.map eff es in
-  let eff = List.fold_left max_eff T.Triv effs in
+  let eff = List.(map eff es |> fold_left max_eff T.Triv) in
   { it = PrimE (prim, es);
     at = no_region;
     note = Note.{ def with typ; eff }
@@ -184,21 +183,19 @@ let ic_rejectE e =
   }
 
 let ic_callE f e k r c =
-  let es = [f; e; k; r(*; c*)] in
-  let effs = List.map eff es in
-  let eff = List.fold_left max_eff T.Triv effs in
-  { it = PrimE (ICCallPrim, es);
+  let es = [f; e; k; r] in
+  let eff = List.(map eff es |> fold_left max_eff T.Triv) in
+  { it = PrimE (ICCallPrim (*c*), es);
     at = no_region;
-    note = Note.{ def with typ = T.unit; eff = eff }
+    note = Note.{ def with typ = T.unit; eff }
   }
 
-let ic_call_rawE p m a k r = (* FIXME *)
+let ic_call_rawE p m a k r c = (* FIXME *)
   let es = [p; m; a; k; r] in
-  let effs = List.map eff es in
-  let eff = List.fold_left max_eff T.Triv effs in
-  { it = PrimE (ICCallRawPrim, es);
+  let eff = List.(map eff es |> fold_left max_eff T.Triv) in
+  { it = PrimE (ICCallRawPrim (*c*), es);
     at = no_region;
-    note = Note.{ def with typ = T.unit; eff = eff }
+    note = Note.{ def with typ = T.unit; eff }
   }
 
 (* tuples *)
@@ -245,9 +242,8 @@ let blockE decs exp =
   match decs' with
   | [] -> exp
   | _ ->
-    let es = List.map dec_eff decs' in
     let typ = typ exp in
-    let eff =  List.fold_left max_eff (eff exp) es in
+    let eff =  List.(map dec_eff decs' |> fold_left max_eff (eff exp)) in
     { it = BlockE (decs', exp);
       at = no_region;
       note = Note.{ def with typ; eff }
@@ -442,8 +438,7 @@ let switch_textE exp1 cases (pat, exp2) typ1 =
 
 
 let tupE exps =
-  let effs = List.map eff exps in
-  let eff = List.fold_left max_eff T.Triv effs in
+  let eff = List.(map eff exps |> fold_left max_eff T.Triv) in
   { it = PrimE (TupPrim, exps);
     at = no_region;
     note = Note.{ def with typ = T.Tup (List.map typ exps); eff };
diff --git a/src/ir_def/construct.mli b/src/ir_def/construct.mli
index d693c854563..a0168aae052 100644
--- a/src/ir_def/construct.mli
+++ b/src/ir_def/construct.mli
@@ -56,7 +56,7 @@ val cps_awaitE : async_sort -> typ -> exp -> exp -> exp
 val ic_replyE : typ list -> exp -> exp
 val ic_rejectE : exp -> exp
 val ic_callE : exp -> exp -> exp -> exp -> exp -> exp
-val ic_call_rawE : exp -> exp -> exp -> exp -> exp -> exp
+val ic_call_rawE : exp -> exp -> exp -> exp -> exp -> exp -> exp
 val projE : exp -> int -> exp
 val optE : exp -> exp
 val tagE : id -> exp -> exp
diff --git a/src/ir_def/ir_effect.ml b/src/ir_def/ir_effect.ml
index 169f206fa89..e14c4385de7 100644
--- a/src/ir_def/ir_effect.ml
+++ b/src/ir_def/ir_effect.ml
@@ -21,7 +21,7 @@ let is_triv phrase = eff phrase = T.Triv
 let effect_exp (exp: exp) : T.eff = eff exp
 
 let is_async_call p exps =
-  match (p, exps) with
+  match p, exps with
   | CallPrim _, [exp1; _] ->
     T.is_shared_func (typ exp1) ||
     T.is_local_async_func (typ exp1)
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 0d18f386da7..e82f56b95bd 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -42,8 +42,6 @@ let fulfillT as_seq typ = T.Func(T.Local, T.Returns, [], as_seq typ, [])
 
 let failT = T.Func(T.Local, T.Returns, [], [T.catch], [])
 
-(*let cleanupT = T.Func(T.Local, T.Returns, [], [], [])*)
-
 let t_async_fut as_seq t =
   T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT],
     [T.sum [
@@ -59,9 +57,9 @@ let new_asyncT =
   T.Func (
     T.Local,
     T.Returns,
-    [ { var = "TX"; sort = T.Type; bound = T.Any } ],
+    [ { var = "T"; sort = T.Type; bound = T.Any } ],
     [],
-    new_async_ret unary (T.Var ("TX", 0)))
+    new_async_ret unary (T.Var ("T", 0)))
 
 let new_asyncE () =
   varE (var "@new_async" new_asyncT)
@@ -83,7 +81,6 @@ let new_nary_async_reply ts =
       let v = fresh_var "v" u in
       let k = fresh_var "k" (contT u T.unit) in
       let r = fresh_var "r" (err_contT T.unit) in
-      let c = fresh_var "c" T.(contT unit unit) in
       [k; r] -->* (
         varE unary_async -*-
           (tupE [
@@ -311,31 +308,30 @@ let transform prog =
       let v_ret = fresh_var "v" t_ret in
       let v_fail = fresh_var "e" t_fail in
       ([v_ret; v_fail] -->* (callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail]))).it
-    | PrimE (CallPrim typs (Some cleanup), [exp1; exp2]) when is_awaitable_func exp1 ->(* HERE *)
+    | PrimE (CallPrim typs, (exp1 :: exp2 :: _)) when is_awaitable_func exp1 ->(* HERE *)
       let ts1,ts2 =
         match typ exp1 with
         | T.Func (T.Shared _, T.Promises, tbs, ts1, ts2) ->
           List.map (fun t -> t_typ (T.open_ typs t)) ts1,
           List.map (fun t -> t_typ (T.open_ typs t)) ts2
-        | _ -> assert(false)
+        | _ -> assert false
       in
       let exp1' = t_exp exp1 in
       let exp2' = t_exp exp2 in
-      let ((nary_async, nary_reply, reject(*, cleanup*)), def) =
+      let ((nary_async, nary_reply, reject), def) =
         new_nary_async_reply ts2
       in
       (blockE (
-        letP (tupP [varP nary_async; varP nary_reply; varP reject(*; varP cleanup*)]) def ::
+        letP (tupP [varP nary_async; varP nary_reply; varP reject]) def ::
         let_eta exp1' (fun v1 ->
           let_seq ts1 exp2' (fun vs ->
-            [ expD (ic_callE v1 (seqE (List.map varE vs)) (varE nary_reply) (varE reject) (varE reject)) ]
+            [expD (ic_callE v1 (seqE (List.map varE vs)) (varE nary_reply) (varE reject) (varE reject(* REALLY: Some cleanup *)))]
            )
           )
          )
          (varE nary_async))
         .it
-    | PrimE (OtherPrim "call_raw_cleanup", [exp1; exp2; exp3; cleanup]) ->
-    | PrimE (CleanupPrim (OtherPrim "call_raw", cleanup), [exp1; exp2; exp3]) ->
+    | PrimE (OtherPrim "call_raw", [exp1; exp2; exp3]) ->(* HERE *)
       let exp1' = t_exp exp1 in
       let exp2' = t_exp exp2 in
       let exp3' = t_exp exp3 in
@@ -345,7 +341,7 @@ let transform prog =
           let_eta exp1' (fun v1 ->
           let_eta exp2' (fun v2 ->
           let_eta exp3' (fun v3 ->
-            [ expD (ic_call_rawE v1 v2 v3 (varE nary_reply) (varE reject)) ]
+            [expD (ic_call_rawE v1 v2 v3 (varE nary_reply) (varE reject) (varE reject(* REALLY: Some cleanup *))) ]
             )
           ))
          )
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 41d703df8df..cb4586f1c1f 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -473,7 +473,6 @@ and c_exp' context exp k =
       | T.Triv ->
         cps_awaitE s (typ_of_var k) (t_exp context exp1) kr
       | T.Await ->
-        let krc = tupE [varE k; varE r; varE k(* FIXME: cleanups*)] in
         c_exp context exp1
           (meta (typ exp1) (fun v1 -> (cps_awaitE s (typ_of_var k) (varE v1) kr)))
     ))

From 63fc12f09cec6d7e0f85a69ae8194d6e9b3833bf Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 22 May 2024 16:50:49 +0200
Subject: [PATCH 043/179] tweaks

---
 src/ir_def/construct.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index de738956ce4..1b8137e1e4b 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -408,7 +408,7 @@ let switch_variantE exp1 cases typ1 =
     at = no_region;
     note = Note.{ def with
       typ = typ1;
-      eff = List.fold_left max_eff (eff exp1) (List.map (fun (l,p,e) -> eff e) cases)
+      eff = List.(map (fun (l,p,e) -> eff e) cases |> fold_left max_eff (eff exp1))
     }
   }
 
@@ -432,7 +432,7 @@ let switch_textE exp1 cases (pat, exp2) typ1 =
     note = Note.{
       def with
       typ = typ1;
-      eff = List.fold_left max_eff (eff exp1) (List.map (fun c -> eff c.it.exp) cs)
+      eff = List.(map (fun c -> eff c.it.exp) cs |> fold_left max_eff (eff exp1))
     }
   }
 

From 120c313ea0a120375b68b1d37691d3edd984ee74 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 22 May 2024 16:54:29 +0200
Subject: [PATCH 044/179] WIP: undo more

---
 src/ir_def/construct.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 1b8137e1e4b..758e766d07c 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -632,7 +632,7 @@ let answerT typ : T.typ =
   | T.Func (T.Local, T.Returns, [], ts1, ts2) -> T.seq ts2
   | _ -> assert false
 
-let cpsT typ ans_typ = T.(Func (Local, Returns, [], [contT typ ans_typ; err_contT ans_typ; contT T.unit ans_typ], as_seq ans_typ))
+let cpsT typ ans_typ = T.(Func (Local, Returns, [], [contT typ ans_typ; err_contT ans_typ], as_seq ans_typ))
 
 (* Sequence expressions *)
 

From 8726208e3bffd169ccd14e8f2c15addaecdcdafa Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 22 May 2024 17:02:21 +0200
Subject: [PATCH 045/179] tweak

---
 src/ir_def/check_ir.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 3ceed133103..cbc91115370 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -22,7 +22,7 @@ let typ = E.typ
 
 let immute_typ p =
   assert (not (T.is_mut (typ p)));
-  (typ p)
+  typ p
 
 (* Scope *)
 

From ef93fb33a23345ada0c90f869068205655a6b3e3 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 23 May 2024 14:49:52 +0200
Subject: [PATCH 046/179] WIP: cleanups

---
 src/codegen/compile.ml   |  1 +
 src/ir_def/check_ir.ml   | 10 ++++++++--
 src/ir_def/construct.ml  |  3 +--
 src/ir_def/ir_effect.ml  |  2 +-
 src/ir_passes/async.ml   | 14 +++++++-------
 src/ir_passes/await.ml   |  2 +-
 src/prelude/internals.mo | 16 ++++++++--------
 7 files changed, 27 insertions(+), 21 deletions(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index bbce0ee1646..81c3b588fe0 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -10576,6 +10576,7 @@ and compile_prim_invocation (env : E.t) ae p es at =
 
   begin match p, es with
   (* Calls *)
+  | CallPrim _, [e1; e2; _] (* FIXME just ignore the third (cleanup stack) arg for now *)
   | CallPrim _, [e1; e2] ->
     let sort, control, _, arg_tys, ret_tys = Type.as_func e1.note.Note.typ in
     let n_args = List.length arg_tys in
diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index cbc91115370..ca95fcdba2a 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -398,7 +398,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
   | PrimE (p, es) ->
     List.iter (check_exp env) es;
     begin match p, es with
-    | CallPrim insts, [exp1; exp2] ->
+    | CallPrim insts, (exp1 :: exp2 :: _) when List.length es <= 3 ->
       begin match T.promote (typ exp1) with
         | T.Func (sort, control, tbs, arg_tys, ret_tys) ->
           check_inst_bounds env tbs insts exp.at;
@@ -409,7 +409,13 @@ let rec check_exp env (exp:Ir.exp) : unit =
             check_concrete env exp.at t_ret;
           end;
           typ exp2 <: t_arg;
-          t_ret <: t
+          t_ret <: t;
+        (* TODO: when after await.ml AND length es == 3 then check that exp3 is ()->() *)
+          if List.length es = 3 then
+            begin
+              assert (not env.flavor.has_await);
+              typ (List.nth es 2) <:  T.unit
+            end
         | T.Non -> () (* dead code, not much to check here *)
         | t1 -> error env exp1.at "expected function type, but expression produces type\n  %s"
              (T.string_of_typ_expand t1)
diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 758e766d07c..047152a160a 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -636,8 +636,7 @@ let cpsT typ ans_typ = T.(Func (Local, Returns, [], [contT typ ans_typ; err_cont
 
 (* Sequence expressions *)
 
-let seqE es =
-  match es with
+let seqE = function
   | [e] -> e
   | es -> tupE es
 
diff --git a/src/ir_def/ir_effect.ml b/src/ir_def/ir_effect.ml
index e14c4385de7..3cfdb8c9edb 100644
--- a/src/ir_def/ir_effect.ml
+++ b/src/ir_def/ir_effect.ml
@@ -22,7 +22,7 @@ let effect_exp (exp: exp) : T.eff = eff exp
 
 let is_async_call p exps =
   match p, exps with
-  | CallPrim _, [exp1; _] ->
+  | CallPrim _, (exp1 :: _ :: _) ->
     T.is_shared_func (typ exp1) ||
     T.is_local_async_func (typ exp1)
   | OtherPrim "call_raw", _ ->
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index e82f56b95bd..4ec783b2731 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -248,30 +248,30 @@ let transform prog =
     | VarE id -> exp'
     | AssignE (exp1, exp2) ->
       AssignE (t_lexp exp1, t_exp exp2)
-    | PrimE (CPSAwait (Fut, cont_typ), [a; krc]) ->
+    | PrimE (CPSAwait (Fut, cont_typ), [a; kr(*; c*)]) ->
       begin match cont_typ with
         | Func(_, _, [], _, []) ->
           (* unit answer type, from await in `async {}` *)
-          (ensureNamed (t_exp krc) (fun vkrc ->
+          (ensureNamed (t_exp kr) (fun vkr ->
             let schedule = fresh_var "schedule" (T.Func(T.Local, T.Returns, [], [], [])) in
-            switch_variantE (t_exp a -*- varE vkrc)
+            switch_variantE (t_exp a -*- varE vkr)
               [ ("suspend", wildP,
                   unitE()); (* suspend *)
                 ("schedule", varP schedule, (* resume later *)
                   (* try await async (); schedule() catch e -> r(e) *)
                  (let v = fresh_var "call" T.unit in
                   letE v
-                    (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1))
-                    (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
+                    (selfcallE [] (*c*) (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkr) 1))
+                    (check_call_perform_status (varE v) (fun e -> projE (varE vkr) 1 -*- e))))
               ]
               T.unit
           )).it
         | _ -> assert false
       end
-    | PrimE (CPSAwait (Cmp, cont_typ), [a; krc]) ->
+    | PrimE (CPSAwait (Cmp, cont_typ), [a; kr]) ->
       begin match cont_typ with
       | Func(_, _, [], _, []) ->
-         (t_exp a -*- t_exp krc).it
+         (t_exp a -*- t_exp kr).it
       | _ -> assert false
       end
     | PrimE (CPSAsync (Fut, t), [exp1]) ->
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index cb4586f1c1f..8eedda3f692 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -493,7 +493,7 @@ and c_exp' context exp k =
           (k -@- varE v)
           (fun e -> r -@- e))
     in
-    nary context k' (fun vs -> e (PrimE (p, vs))) exps
+    nary context k' (fun vs -> e (PrimE (p, vs))) (exps @ [unitE ()(* FOR NOW *)])
   | PrimE (p, exps) ->
     nary context k (fun vs -> e (PrimE (p, vs))) exps
 
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index 70c2d94e6ba..3cba8906b82 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -285,7 +285,7 @@ func @equal_array<T>(eq : (T, T) -> Bool, a : [T], b : [T]) : Bool {
 };
 
 type @Cont<T> = T -> () ;
-type @Async<TF> = (@Cont<TF>,@Cont<Error>) -> {
+type @Async<T> = (@Cont<T>,@Cont<Error>) -> {
   #suspend;
   #schedule : () -> ();
 };
@@ -307,15 +307,15 @@ func @getSystemRefund() : @Refund {
   return (prim "cyclesRefunded" : () -> Nat) ();
 };
 
-func @new_async<TM <: Any>() : (@Async<TM>, @Cont<TM>, @Cont<Error>) {
-  let w_null = func(r : @Refund, t : TM) { };
+func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>) {
+  let w_null = func(r : @Refund, t : T) { };
   let r_null = func(_ : Error) {};
-  var result : ?(@Result<TM>) = null;
-  var ws : @Waiter<TM> = w_null;
+  var result : ?(@Result<T>) = null;
+  var ws : @Waiter<T> = w_null;
   var rs : @Cont<Error> = r_null;
   let getRefund = @cycles != 0;
 
-  func fulfill(t : TM) {
+  func fulfill(t : T) {
     switch result {
       case null {
         let refund = if getRefund @getSystemRefund() else 0;
@@ -342,14 +342,14 @@ func @new_async<TM <: Any>() : (@Async<TM>, @Cont<TM>, @Cont<Error>) {
     };
   };
 
-  func enqueue(k : @Cont<TM>, r : @Cont<Error>) : {
+  func enqueue(k : @Cont<T>, r : @Cont<Error>) : {
     #suspend;
     #schedule : () -> ();
   } {
     switch result {
       case null {
         let ws_ = ws;
-        ws := func(r : @Refund, t : TM) {
+        ws := func(r : @Refund, t : T) {
           ws_(r, t);
           @reset_cycles();
           @refund := r;

From 10e38dd120aee749dace18d50a77f9aa26150277 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 23 May 2024 14:59:02 +0200
Subject: [PATCH 047/179] tweak

---
 src/ir_def/ir_effect.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_def/ir_effect.ml b/src/ir_def/ir_effect.ml
index 3cfdb8c9edb..c46f766c73e 100644
--- a/src/ir_def/ir_effect.ml
+++ b/src/ir_def/ir_effect.ml
@@ -29,7 +29,7 @@ let is_async_call p exps =
     true
   | _ -> false
 
-(* infer the effect of an expression, assuming all sub-expressions are correctly effect-annotated es*)
+(* infer the effect of an expression, assuming all sub-expressions are correctly effect-annotated *)
 
 let rec infer_effect_prim p exps =
   match p, exps with

From a9e93bc0af8e7f14983dd826af743f3059a390fc Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 23 May 2024 16:50:26 +0200
Subject: [PATCH 048/179] WIP: start propagating the cleanup

---
 src/codegen/compile.ml             | 2 +-
 src/ir_def/arrange_ir.ml           | 2 +-
 src/ir_def/check_ir.ml             | 2 +-
 src/ir_def/construct.ml            | 2 +-
 src/ir_def/construct.mli           | 2 +-
 src/ir_def/ir.ml                   | 4 ++--
 src/ir_interpreter/interpret_ir.ml | 2 +-
 src/ir_passes/async.ml             | 2 +-
 8 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index 81c3b588fe0..9feabec703e 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -11784,7 +11784,7 @@ and compile_prim_invocation (env : E.t) ae p es at =
   | ICCallerPrim, [] ->
     SR.Vanilla, IC.caller env
 
-  | ICCallPrim, [f;e;k;r] ->
+  | ICCallPrim _, [f;e;k;r] ->
     SR.unit, begin
     (* TBR: Can we do better than using the notes? *)
     let _, _, _, ts1, _ = Type.as_func f.note.Note.typ in
diff --git a/src/ir_def/arrange_ir.ml b/src/ir_def/arrange_ir.ml
index e7d37810f13..eccb436932d 100644
--- a/src/ir_def/arrange_ir.ml
+++ b/src/ir_def/arrange_ir.ml
@@ -111,7 +111,7 @@ and prim = function
   | ICReplyPrim ts    -> "ICReplyPrim" $$ List.map typ ts
   | ICRejectPrim      -> Atom "ICRejectPrim"
   | ICCallerPrim      -> Atom "ICCallerPrim"
-  | ICCallPrim        -> Atom "ICCallPrim"
+  | ICCallPrim _      -> Atom "ICCallPrim"
   | ICCallRawPrim     -> Atom "ICCallRawPrim"
   | ICMethodNamePrim  -> Atom "ICMethodNamePrim"
   | ICStableWrite t   -> "ICStableWrite" $$ [typ t]
diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index ca95fcdba2a..5d14beee028 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -599,7 +599,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
       T.Non <: t
     | ICCallerPrim, [] ->
       T.caller <: t
-    | ICCallPrim, [exp1; exp2; k; r] ->
+    | ICCallPrim _, [exp1; exp2; k; r] ->
       let t1 = T.promote (typ exp1) in
       begin match t1 with
       | T.Func (sort, T.Replies, _ (*TBR*), arg_tys, ret_tys) ->
diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 047152a160a..854da2e583a 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -185,7 +185,7 @@ let ic_rejectE e =
 let ic_callE f e k r c =
   let es = [f; e; k; r] in
   let eff = List.(map eff es |> fold_left max_eff T.Triv) in
-  { it = PrimE (ICCallPrim (*c*), es);
+  { it = PrimE (ICCallPrim (Option.map id_of_var c), es);
     at = no_region;
     note = Note.{ def with typ = T.unit; eff }
   }
diff --git a/src/ir_def/construct.mli b/src/ir_def/construct.mli
index a0168aae052..93c915e316d 100644
--- a/src/ir_def/construct.mli
+++ b/src/ir_def/construct.mli
@@ -55,7 +55,7 @@ val cps_asyncE : async_sort -> typ -> typ -> exp -> exp
 val cps_awaitE : async_sort -> typ -> exp -> exp -> exp
 val ic_replyE : typ list -> exp -> exp
 val ic_rejectE : exp -> exp
-val ic_callE : exp -> exp -> exp -> exp -> exp -> exp
+val ic_callE : exp -> exp -> exp -> exp -> var option -> exp
 val ic_call_rawE : exp -> exp -> exp -> exp -> exp -> exp -> exp
 val projE : exp -> int -> exp
 val optE : exp -> exp
diff --git a/src/ir_def/ir.ml b/src/ir_def/ir.ml
index 84b1d9ebbd6..92fe490ed7a 100644
--- a/src/ir_def/ir.ml
+++ b/src/ir_def/ir.ml
@@ -168,7 +168,7 @@ and prim =
   | ICReplyPrim of Type.typ list
   | ICRejectPrim
   | ICCallerPrim
-  | ICCallPrim
+  | ICCallPrim of id option
   | ICCallRawPrim
   | ICMethodNamePrim
   | ICArgDataPrim
@@ -307,7 +307,7 @@ let map_prim t_typ t_id p =
   | ICPerformGC
   | ICRejectPrim
   | ICCallerPrim
-  | ICCallPrim
+  | ICCallPrim _
   | ICCallRawPrim
   | ICMethodNamePrim -> p
   | ICStableWrite t -> ICStableWrite (t_typ t)
diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index 0e4791e49da..cbbbf218a48 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -446,7 +446,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
         let reject = Option.get env.rejects in
         let e = V.Tup [V.Variant ("canister_reject", V.unit); v1] in
         Scheduler.queue (fun () -> reject e)
-      | ICCallPrim, [v1; v2; kv; rv] ->
+      | ICCallPrim _, [v1; v2; kv; rv] ->
         let call_conv, f = V.as_func v1 in
         check_call_conv (List.hd es) call_conv;
         check_call_conv_arg env exp v2 call_conv;
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 4ec783b2731..50077852e66 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -325,7 +325,7 @@ let transform prog =
         letP (tupP [varP nary_async; varP nary_reply; varP reject]) def ::
         let_eta exp1' (fun v1 ->
           let_seq ts1 exp2' (fun vs ->
-            [expD (ic_callE v1 (seqE (List.map varE vs)) (varE nary_reply) (varE reject) (varE reject(* REALLY: Some cleanup *)))]
+            [expD (ic_callE v1 (seqE (List.map varE vs)) (varE nary_reply) (varE reject) (Some reject(* REALLY: Some cleanup *)))]
            )
           )
          )

From cf03986757badda59ee5d1cb0650c5eef588aff2 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 24 May 2024 16:30:21 +0200
Subject: [PATCH 049/179] tweaks

---
 src/codegen/compile.ml | 32 ++++++++++++++++----------------
 1 file changed, 16 insertions(+), 16 deletions(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index 9feabec703e..68c65c0f74b 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -9149,39 +9149,39 @@ module FuncDec = struct
     ))
 
   let message_start env sort = match sort with
-      | Type.Shared Type.Write ->
-        Lifecycle.trans env Lifecycle.InUpdate
-      | Type.Shared Type.Query ->
-        Lifecycle.trans env Lifecycle.InQuery
-      | Type.Shared Type.Composite ->
-        Lifecycle.trans env Lifecycle.InComposite
+      | Type.(Shared Write) ->
+        Lifecycle.(trans env InUpdate)
+      | Type.(Shared Query) ->
+        Lifecycle.(trans env InQuery)
+      | Type.(Shared Composite) ->
+        Lifecycle.(trans env InComposite)
       | _ -> assert false
 
   let message_cleanup env sort = match sort with
-      | Type.Shared Type.Write ->
+      | Type.(Shared Write) ->
         GC.collect_garbage env ^^
-        Lifecycle.trans env Lifecycle.Idle
-      | Type.Shared Type.Query ->
-        Lifecycle.trans env Lifecycle.PostQuery
-      | Type.Shared Type.Composite ->
+        Lifecycle.(trans env Idle)
+      | Type.(Shared Query) ->
+        Lifecycle.(trans env PostQuery)
+      | Type.(Shared Composite) ->
         (* Stay in composite query state such that callbacks of 
         composite queries can also use the memory reserve. 
         The state is isolated since memory changes of queries 
         are rolled back by the IC runtime system. *)
-        Lifecycle.trans env Lifecycle.InComposite
+        Lifecycle.(trans env InComposite)
       | _ -> assert false
 
   let callback_start env =
-    Lifecycle.is_in env Lifecycle.InComposite ^^
+    Lifecycle.(is_in env InComposite) ^^
     G.if0
       (G.nop)
-      (message_start env (Type.Shared Type.Write))
+      (message_start env Type.(Shared Write))
 
   let callback_cleanup env =
-    Lifecycle.is_in env Lifecycle.InComposite ^^
+    Lifecycle.(is_in env InComposite) ^^
     G.if0
       (G.nop)
-      (message_cleanup env (Type.Shared Type.Write))
+      (message_cleanup env Type.(Shared Write))
   
   let compile_const_message outer_env outer_ae sort control args mk_body ret_tys at : E.func_with_names =
     let ae0 = VarEnv.mk_fun_ae outer_ae in

From c0ad414292cbc8b46cbe038a9ded373b76c8fed0 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 28 May 2024 12:22:23 +0200
Subject: [PATCH 050/179] WIP: back towards plan A

---
 src/ir_passes/async.ml   | 22 ++++++++++++----------
 src/prelude/internals.mo |  7 +++++--
 2 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 50077852e66..21c696fb2d6 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -69,12 +69,13 @@ let new_async t =
   let async = fresh_var "async" (typ (projE call_new_async 0)) in
   let fulfill = fresh_var "fulfill" (typ (projE call_new_async 1)) in
   let fail = fresh_var "fail" (typ (projE call_new_async 2)) in
-  (async, fulfill, fail), call_new_async
+  let clean = fresh_var "clean" (typ (projE call_new_async 3)) in
+  (async, fulfill, fail, clean), call_new_async
 
 let new_nary_async_reply ts =
   (* The async implementation isn't n-ary *)
   let t = T.seq ts in
-  let (unary_async, unary_fulfill, fail), call_new_async = new_async t in
+  let (unary_async, unary_fulfill, fail, clean), call_new_async = new_async t in
   (* construct the n-ary async value, coercing the continuation, if necessary *)
   let nary_async =
     let coerce u =
@@ -111,14 +112,15 @@ let new_nary_async_reply ts =
     in
     vs -->* (varE unary_fulfill -*- seq_of_vs)
   in
-  let async,reply,reject =
+  let async, reply, reject, cleanup =
     fresh_var "async" (typ nary_async),
     fresh_var "reply" (typ nary_reply),
-    fresh_var "reject" (typ_of_var fail)
+    fresh_var "reject" (typ_of_var fail),
+    fresh_var "cleanup" (typ_of_var fail)
   in
-    (async, reply, reject),
-      blockE [letP (tupP [varP unary_async; varP unary_fulfill; varP fail]) call_new_async]
-        (tupE [nary_async; nary_reply; varE fail])
+    (async, reply, reject, cleanup),
+      blockE [letP (tupP [varP unary_async; varP unary_fulfill; varP fail; varP clean]) call_new_async] 
+        (tupE [nary_async; nary_reply; varE fail; varE clean])
 
 
 let let_eta e scope =
@@ -280,7 +282,7 @@ let transform prog =
         | Func(_,_, [tb], [Func(_, _, [], ts1, []); _], []) ->
           tb, List.map t_typ (List.map (T.open_ [t]) ts1)
         | t -> assert false in
-      let ((nary_async, nary_reply, reject), def) =
+      let (nary_async, nary_reply, reject, clean), def =
         new_nary_async_reply ts1
       in
       ( blockE [
@@ -318,7 +320,7 @@ let transform prog =
       in
       let exp1' = t_exp exp1 in
       let exp2' = t_exp exp2 in
-      let ((nary_async, nary_reply, reject), def) =
+      let (nary_async, nary_reply, reject, clean), def =
         new_nary_async_reply ts2
       in
       (blockE (
@@ -335,7 +337,7 @@ let transform prog =
       let exp1' = t_exp exp1 in
       let exp2' = t_exp exp2 in
       let exp3' = t_exp exp3 in
-      let ((nary_async, nary_reply, reject), def) = new_nary_async_reply [T.blob] in
+      let (nary_async, nary_reply, reject, clean), def = new_nary_async_reply [T.blob] in
       (blockE (
         letP (tupP [varP nary_async; varP nary_reply; varP reject]) def ::
           let_eta exp1' (fun v1 ->
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index 3cba8906b82..92dbed83ede 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -307,7 +307,7 @@ func @getSystemRefund() : @Refund {
   return (prim "cyclesRefunded" : () -> Nat) ();
 };
 
-func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>) {
+func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>) {
   let w_null = func(r : @Refund, t : T) { };
   let r_null = func(_ : Error) {};
   var result : ?(@Result<T>) = null;
@@ -342,6 +342,9 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>) {
     };
   };
 
+  func clean(_ : Nat32) {
+  };
+
   func enqueue(k : @Cont<T>, r : @Cont<Error>) : {
     #suspend;
     #schedule : () -> ();
@@ -373,7 +376,7 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>) {
     };
   };
 
-  (enqueue, fulfill, fail)
+  (enqueue, fulfill, fail, clean)
 };
 
 // Subset of IC management canister interface required for our use

From 88420fb86a9c68c53f37998445a9ff182e9bb9d3 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 29 May 2024 12:15:45 +0200
Subject: [PATCH 051/179] WIP: some progress with ir_check

---
 src/ir_def/check_ir.ml   |  4 ++--
 src/ir_passes/async.ml   | 37 ++++++++++++++++++++-----------------
 src/ir_passes/await.ml   |  6 +++---
 src/mo_types/type.ml     |  1 +
 src/mo_types/type.mli    |  1 +
 src/prelude/internals.mo |  4 ++--
 6 files changed, 29 insertions(+), 24 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 5d14beee028..2410aa7d9d3 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -555,7 +555,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
       check (T.shared (T.seq ots)) "DeserializeOpt is not defined for operand type";
       typ exp1 <: T.blob;
       T.Opt (T.seq ots) <: t
-    | CPSAwait (s, cont_typ), [a; kr] ->
+    | CPSAwait (s, cont_typ), [a; krc] ->
       let (_, t1) =
         try T.as_async_sub s T.Non (T.normalize (typ a))
         with _ -> error env exp.at "CPSAwait expect async arg, found %s" (T.string_of_typ (typ a))
@@ -566,7 +566,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
            (match ts2 with
             | [] -> ()
             | _ -> error env exp.at "CPSAwait answer type error");
-           typ kr <: T.Tup [cont_typ; T.Func(T.Local, T.Returns, [], [T.catch], ts2)];
+           typ krc <: T.Tup [cont_typ; T.Func(T.Local, T.Returns, [], [T.catch], ts2); T.Func(T.Local, T.Returns, [], [T.catch], ts2)(*FIXME*)];
            t1 <: T.seq ts1;
            T.seq ts2 <: t;
          end;
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 21c696fb2d6..5623dc2c2fa 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -42,16 +42,18 @@ let fulfillT as_seq typ = T.Func(T.Local, T.Returns, [], as_seq typ, [])
 
 let failT = T.Func(T.Local, T.Returns, [], [T.catch], [])
 
+let cleanT = T.Func(T.Local, T.Returns, [], [T.nat32(*FIXME*)], [])
+
 let t_async_fut as_seq t =
-  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT],
+  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; cleanT],
     [T.sum [
       ("suspend", T.unit);
       ("schedule", T.Func(T.Local, T.Returns, [], [], []))]])
 
 let t_async_cmp as_seq t =
-  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT], [])
+  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; cleanT], [])
 
-let new_async_ret as_seq t = [t_async_fut as_seq t; fulfillT as_seq t; failT]
+let new_async_ret as_seq t = [t_async_fut as_seq t; fulfillT as_seq t; failT; cleanT]
 
 let new_asyncT =
   T.Func (
@@ -86,7 +88,8 @@ let new_nary_async_reply ts =
         varE unary_async -*-
           (tupE [
              [v] -->* (varE k -*- varE v);
-             varE r
+             varE r;
+             varE r(*FIXME*)
           ])
       )
     in
@@ -116,10 +119,10 @@ let new_nary_async_reply ts =
     fresh_var "async" (typ nary_async),
     fresh_var "reply" (typ nary_reply),
     fresh_var "reject" (typ_of_var fail),
-    fresh_var "cleanup" (typ_of_var fail)
+    fresh_var "cleanup" (typ_of_var fail(*FIXME*))
   in
     (async, reply, reject, cleanup),
-      blockE [letP (tupP [varP unary_async; varP unary_fulfill; varP fail; varP clean]) call_new_async] 
+      blockE [letP (tupP [varP unary_async; varP unary_fulfill; varP fail; varP clean]) call_new_async]
         (tupE [nary_async; nary_reply; varE fail; varE clean])
 
 
@@ -250,21 +253,21 @@ let transform prog =
     | VarE id -> exp'
     | AssignE (exp1, exp2) ->
       AssignE (t_lexp exp1, t_exp exp2)
-    | PrimE (CPSAwait (Fut, cont_typ), [a; kr(*; c*)]) ->
+    | PrimE (CPSAwait (Fut, cont_typ), [a; krc]) ->
       begin match cont_typ with
         | Func(_, _, [], _, []) ->
           (* unit answer type, from await in `async {}` *)
-          (ensureNamed (t_exp kr) (fun vkr ->
+          (ensureNamed (t_exp krc) (fun vkrc ->
             let schedule = fresh_var "schedule" (T.Func(T.Local, T.Returns, [], [], [])) in
-            switch_variantE (t_exp a -*- varE vkr)
+            switch_variantE (t_exp a -*- varE vkrc)
               [ ("suspend", wildP,
                   unitE()); (* suspend *)
                 ("schedule", varP schedule, (* resume later *)
                   (* try await async (); schedule() catch e -> r(e) *)
                  (let v = fresh_var "call" T.unit in
                   letE v
-                    (selfcallE [] (*c*) (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkr) 1))
-                    (check_call_perform_status (varE v) (fun e -> projE (varE vkr) 1 -*- e))))
+                    (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1))
+                    (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
               ]
               T.unit
           )).it
@@ -286,14 +289,14 @@ let transform prog =
         new_nary_async_reply ts1
       in
       ( blockE [
-          letP (tupP [varP nary_async; varP nary_reply; varP reject]) def;
+          letP (tupP [varP nary_async; varP nary_reply; varP reject; varP clean]) def;
           let ic_reply = (* flatten v, here and below? *)
             let v = fresh_var "v" (T.seq ts1) in
             v --> (ic_replyE ts1 (varE v)) in
           let ic_reject =
             let e = fresh_var "e" T.catch in
             [e] -->* (ic_rejectE (errorMessageE (varE e))) in
-          let exp' = callE (t_exp exp1) [t0] (tupE [ic_reply; ic_reject]) in
+          let exp' = callE (t_exp exp1) [t0] (tupE [ic_reply; ic_reject; ic_reject(*FIXME?*)]) in
           expD (selfcallE ts1 exp' (varE nary_reply) (varE reject))
         ]
         (varE nary_async)
@@ -309,7 +312,7 @@ let transform prog =
       in
       let v_ret = fresh_var "v" t_ret in
       let v_fail = fresh_var "e" t_fail in
-      ([v_ret; v_fail] -->* (callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail]))).it
+      ([v_ret; v_fail] -->* (callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail; varE v_fail(*FIXME?*)]))).it
     | PrimE (CallPrim typs, (exp1 :: exp2 :: _)) when is_awaitable_func exp1 ->(* HERE *)
       let ts1,ts2 =
         match typ exp1 with
@@ -324,7 +327,7 @@ let transform prog =
         new_nary_async_reply ts2
       in
       (blockE (
-        letP (tupP [varP nary_async; varP nary_reply; varP reject]) def ::
+        letP (tupP [varP nary_async; varP nary_reply; varP reject; varP clean]) def ::
         let_eta exp1' (fun v1 ->
           let_seq ts1 exp2' (fun vs ->
             [expD (ic_callE v1 (seqE (List.map varE vs)) (varE nary_reply) (varE reject) (Some reject(* REALLY: Some cleanup *)))]
@@ -399,7 +402,7 @@ let transform prog =
               let r =
                 let e = fresh_var "e" T.catch in
                 [e] -->* (ic_rejectE (errorMessageE (varE e))) in
-              let exp' = callE (t_exp cps) [t0] (tupE [k;r]) in
+              let exp' = callE (t_exp cps) [t0] (tupE [k; r; r(*FIXME*)]) in
               FuncE (x, T.Shared s', Replies, typbinds', args', ret_tys, exp')
             (* oneway, always with `ignore(async _)` body *)
             | Returns,
@@ -428,7 +431,7 @@ let transform prog =
               let r =
                 let e = fresh_var "e" T.catch in
                 [e] -->* tupE [] in (* discard error *)
-              let exp' = callE (t_exp cps) [t0] (tupE [k;r]) in
+              let exp' = callE (t_exp cps) [t0] (tupE [k; r; r(*FIXME*)]) in
               FuncE (x, T.Shared s', Returns, typbinds', args', ret_tys, exp')
             | Returns, _ ->
               assert false
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 8eedda3f692..e85ea380907 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -468,13 +468,13 @@ and c_exp' context exp k =
     in
     letcont r (fun r ->
     letcont k (fun k ->
-      let kr = tupE [varE k; varE r] in
+      let krc = tupE [varE k; varE r; varE r(*FIXME*)] in
       match eff exp1 with
       | T.Triv ->
-        cps_awaitE s (typ_of_var k) (t_exp context exp1) kr
+        cps_awaitE s (typ_of_var k) (t_exp context exp1) krc
       | T.Await ->
         c_exp context exp1
-          (meta (typ exp1) (fun v1 -> (cps_awaitE s (typ_of_var k) (varE v1) kr)))
+          (meta (typ exp1) (fun v1 -> (cps_awaitE s (typ_of_var k) (varE v1) krc)))
     ))
   | DeclareE (id, typ, exp1) ->
     unary context k (fun v1 -> e (DeclareE (id, typ, varE v1))) exp1
diff --git a/src/mo_types/type.ml b/src/mo_types/type.ml
index 4fe364fbe69..613956beca9 100644
--- a/src/mo_types/type.ml
+++ b/src/mo_types/type.ml
@@ -312,6 +312,7 @@ let compare_field f1 f2 =
 let unit = Tup []
 let bool = Prim Bool
 let nat = Prim Nat
+let nat32 = Prim Nat32
 let nat64 = Prim Nat64
 let int = Prim Int
 let text = Prim Text
diff --git a/src/mo_types/type.mli b/src/mo_types/type.mli
index acc274b0bb6..fc6d3694077 100644
--- a/src/mo_types/type.mli
+++ b/src/mo_types/type.mli
@@ -89,6 +89,7 @@ val is_shared_sort : 'a shared -> bool
 val unit : typ
 val bool : typ
 val nat : typ
+val nat32 : typ
 val nat64 : typ
 val int : typ
 val text : typ
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index 92dbed83ede..0e8e7c51bf1 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -285,7 +285,7 @@ func @equal_array<T>(eq : (T, T) -> Bool, a : [T], b : [T]) : Bool {
 };
 
 type @Cont<T> = T -> () ;
-type @Async<T> = (@Cont<T>,@Cont<Error>) -> {
+type @Async<T> = (@Cont<T>, @Cont<Error>, @Cont<Nat32>) -> {
   #suspend;
   #schedule : () -> ();
 };
@@ -345,7 +345,7 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>)
   func clean(_ : Nat32) {
   };
 
-  func enqueue(k : @Cont<T>, r : @Cont<Error>) : {
+  func enqueue(k : @Cont<T>, r : @Cont<Error>, c : @Cont<Nat32>) : {
     #suspend;
     #schedule : () -> ();
   } {

From ae351330756ae95e6f392521b728019ce42f8ae6 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 29 May 2024 13:28:59 +0200
Subject: [PATCH 052/179] WIP: minimal progress

---
 src/ir_passes/async.ml   | 11 ++++++-----
 src/prelude/internals.mo |  4 ++--
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 5623dc2c2fa..d568f4eace0 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -45,7 +45,7 @@ let failT = T.Func(T.Local, T.Returns, [], [T.catch], [])
 let cleanT = T.Func(T.Local, T.Returns, [], [T.nat32(*FIXME*)], [])
 
 let t_async_fut as_seq t =
-  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; cleanT],
+  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: cleanT, actually ()->()*)],
     [T.sum [
       ("suspend", T.unit);
       ("schedule", T.Func(T.Local, T.Returns, [], [], []))]])
@@ -68,7 +68,7 @@ let new_asyncE () =
 
 let new_async t =
   let call_new_async = callE (new_asyncE ()) [t] (unitE()) in
-  let async = fresh_var "async" (typ (projE call_new_async 0)) in
+  let async = fresh_var "asyncX"(*FIXME: revert*) (typ (projE call_new_async 0)) in
   let fulfill = fresh_var "fulfill" (typ (projE call_new_async 1)) in
   let fail = fresh_var "fail" (typ (projE call_new_async 2)) in
   let clean = fresh_var "clean" (typ (projE call_new_async 3)) in
@@ -84,12 +84,13 @@ let new_nary_async_reply ts =
       let v = fresh_var "v" u in
       let k = fresh_var "k" (contT u T.unit) in
       let r = fresh_var "r" (err_contT T.unit) in
-      [k; r] -->* (
+      let c = fresh_var "c" (err_contT T.unit(*FIXME: contT T.nat32 T.unit*)) in
+      [k; r; c] -->* (
         varE unary_async -*-
           (tupE [
              [v] -->* (varE k -*- varE v);
              varE r;
-             varE r(*FIXME*)
+             varE c;
           ])
       )
     in
@@ -119,7 +120,7 @@ let new_nary_async_reply ts =
     fresh_var "async" (typ nary_async),
     fresh_var "reply" (typ nary_reply),
     fresh_var "reject" (typ_of_var fail),
-    fresh_var "cleanup" (typ_of_var fail(*FIXME*))
+    fresh_var "cleanup" (typ_of_var clean)
   in
     (async, reply, reject, cleanup),
       blockE [letP (tupP [varP unary_async; varP unary_fulfill; varP fail; varP clean]) call_new_async]
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index 0e8e7c51bf1..b8cf7ed4502 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -285,7 +285,7 @@ func @equal_array<T>(eq : (T, T) -> Bool, a : [T], b : [T]) : Bool {
 };
 
 type @Cont<T> = T -> () ;
-type @Async<T> = (@Cont<T>, @Cont<Error>, @Cont<Nat32>) -> {
+type @Async<T> = (@Cont<T>, @Cont<Error>, @Cont<Error/*FIXME: unit*/>) -> {
   #suspend;
   #schedule : () -> ();
 };
@@ -345,7 +345,7 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>)
   func clean(_ : Nat32) {
   };
 
-  func enqueue(k : @Cont<T>, r : @Cont<Error>, c : @Cont<Nat32>) : {
+  func enqueue(k : @Cont<T>, r : @Cont<Error>, c : @Cont<Error/*FIXME: unit*/>) : {
     #suspend;
     #schedule : () -> ();
   } {

From 465920559c1007224f3d82b57597154394f16422 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 29 May 2024 16:10:56 +0200
Subject: [PATCH 053/179] WIP: progress

---
 src/ir_def/check_ir.ml |  3 ++-
 src/ir_passes/async.ml | 15 ++++++++-------
 src/ir_passes/await.ml |  6 ++++--
 3 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 2410aa7d9d3..8909c4c361a 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -577,7 +577,8 @@ let rec check_exp env (exp:Ir.exp) : unit =
       (match typ exp with
         T.Func(T.Local,T.Returns, [tb],
           [T.Func(T.Local, T.Returns, [], ts1, []);
-           T.Func(T.Local, T.Returns, [], [t_error], [])],
+           T.Func(T.Local, T.Returns, [], [t_error], []);
+           T.Func(T.Local, T.Returns, [], [t_errorFIXME], [])(*FIXME*)],
           []) ->
          T.catch <: t_error;
          T.Async(s, t0, Type.open_ [t0] (T.seq ts1)) <: t
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index d568f4eace0..15aaffdc5cd 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -51,7 +51,7 @@ let t_async_fut as_seq t =
       ("schedule", T.Func(T.Local, T.Returns, [], [], []))]])
 
 let t_async_cmp as_seq t =
-  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; cleanT], [])
+  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: cleanT*)], [])
 
 let new_async_ret as_seq t = [t_async_fut as_seq t; fulfillT as_seq t; failT; cleanT]
 
@@ -274,16 +274,16 @@ let transform prog =
           )).it
         | _ -> assert false
       end
-    | PrimE (CPSAwait (Cmp, cont_typ), [a; kr]) ->
+    | PrimE (CPSAwait (Cmp, cont_typ), [a; krc]) ->
       begin match cont_typ with
       | Func(_, _, [], _, []) ->
-         (t_exp a -*- t_exp kr).it
+         (t_exp a -*- t_exp krc).it
       | _ -> assert false
       end
     | PrimE (CPSAsync (Fut, t), [exp1]) ->
       let t0 = t_typ t in
       let tb, ts1 = match typ exp1 with
-        | Func(_,_, [tb], [Func(_, _, [], ts1, []); _], []) ->
+        | Func(_,_, [tb], [Func(_, _, [], ts1, []); _; _], []) ->
           tb, List.map t_typ (List.map (T.open_ [t]) ts1)
         | t -> assert false in
       let (nary_async, nary_reply, reject, clean), def =
@@ -305,7 +305,7 @@ let transform prog =
     | PrimE (CPSAsync (Cmp, t), [exp1]) ->
       let t0 = t_typ t in
       let tb, t_ret, t_fail = match typ exp1 with
-        | Func(_,_, [tb], [t_ret; t_fail], _ ) ->
+        | Func(_,_, [tb], [t_ret; t_fail; t_clean], _ ) ->
           tb,
           t_typ (T.open_ [t] t_ret),
           t_typ (T.open_ [t] t_fail)
@@ -313,7 +313,8 @@ let transform prog =
       in
       let v_ret = fresh_var "v" t_ret in
       let v_fail = fresh_var "e" t_fail in
-      ([v_ret; v_fail] -->* (callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail; varE v_fail(*FIXME?*)]))).it
+      let v_clean = fresh_var "c" t_fail(*FIXME*) in
+      ([v_ret; v_fail; v_clean] -->* (callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail; varE v_clean]))).it
     | PrimE (CallPrim typs, (exp1 :: exp2 :: _)) when is_awaitable_func exp1 ->(* HERE *)
       let ts1,ts2 =
         match typ exp1 with
@@ -393,7 +394,7 @@ let transform prog =
               let t1, contT = match typ cps with
                 | Func (_,_,
                     [tb],
-                    [Func(_, _, [], ts1, []) as contT; _],
+                    [Func(_, _, [], ts1, []) as contT; _; _],
                     []) ->
                   (t_typ (T.seq (List.map (T.open_ [t0]) ts1)),t_typ (T.open_ [t0] contT))
                 | t -> assert false in
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index e85ea380907..c2890816664 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -81,12 +81,13 @@ let rec t_async context exp =
    (* add the implicit return label *)
    let k_ret = fresh_cont (typ exp1) T.unit in
    let k_fail = fresh_err_cont T.unit in
+   let k_clean = fresh_err_cont T.unit in
    let context' =
      LabelEnv.add Return (Cont (ContVar k_ret))
        (LabelEnv.singleton Throw (Cont (ContVar k_fail)))
    in
      cps_asyncE s typ1 (typ exp1)
-       (forall [tb] ([k_ret; k_fail] -->*
+       (forall [tb] ([k_ret; k_fail; k_clean] -->*
           (c_exp context' exp1 (ContVar k_ret))))
  |  _ -> assert false
 
@@ -442,6 +443,7 @@ and c_exp' context exp k =
     (* add the implicit return label *)
     let k_ret = fresh_cont (typ exp1) T.unit in
     let k_fail = fresh_err_cont T.unit in
+    let k_clean = fresh_err_cont T.unit(*FIXME*) in
     let context' =
       LabelEnv.add Return (Cont (ContVar k_ret))
         (LabelEnv.singleton Throw (Cont (ContVar k_fail)))
@@ -452,7 +454,7 @@ and c_exp' context exp k =
     in
     let cps_async =
       cps_asyncE T.Fut typ1 (typ exp1)
-        (forall [tb] ([k_ret; k_fail] -->*
+        (forall [tb] ([k_ret; k_fail; k_clean] -->*
           (c_exp context' exp1 (ContVar k_ret)))) in
     let k' = meta (typ cps_async)
       (fun v ->

From 4daf36776cd7a37e57a1724809c18ff250f6e48e Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 31 May 2024 12:14:38 +0200
Subject: [PATCH 054/179] WIP: unalias things

---
 src/ir_passes/async.ml | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 15aaffdc5cd..1d579237fa8 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -296,8 +296,11 @@ let transform prog =
             v --> (ic_replyE ts1 (varE v)) in
           let ic_reject =
             let e = fresh_var "e" T.catch in
-            [e] -->* (ic_rejectE (errorMessageE (varE e))) in
-          let exp' = callE (t_exp exp1) [t0] (tupE [ic_reply; ic_reject; ic_reject(*FIXME?*)]) in
+            [e] -->* ic_rejectE (errorMessageE (varE e)) in
+          let ic_cleanup =
+            let c = fresh_var "c" T.catch in
+            [c] -->* ic_rejectE (errorMessageE (varE c))(*FIXME*) in
+          let exp' = callE (t_exp exp1) [t0] (tupE [ic_reply; ic_reject; ic_cleanup]) in
           expD (selfcallE ts1 exp' (varE nary_reply) (varE reject))
         ]
         (varE nary_async)
@@ -314,7 +317,7 @@ let transform prog =
       let v_ret = fresh_var "v" t_ret in
       let v_fail = fresh_var "e" t_fail in
       let v_clean = fresh_var "c" t_fail(*FIXME*) in
-      ([v_ret; v_fail; v_clean] -->* (callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail; varE v_clean]))).it
+      ([v_ret; v_fail; v_clean] -->* callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail; varE v_clean])).it
     | PrimE (CallPrim typs, (exp1 :: exp2 :: _)) when is_awaitable_func exp1 ->(* HERE *)
       let ts1,ts2 =
         match typ exp1 with
@@ -403,8 +406,11 @@ let transform prog =
                 v --> (ic_replyE ret_tys (varE v)) in
               let r =
                 let e = fresh_var "e" T.catch in
-                [e] -->* (ic_rejectE (errorMessageE (varE e))) in
-              let exp' = callE (t_exp cps) [t0] (tupE [k; r; r(*FIXME*)]) in
+                [e] -->* ic_rejectE (errorMessageE (varE e)) in
+              let cl =
+                let c = fresh_var "c" T.catch in
+                [c] -->* ic_rejectE (errorMessageE (varE c))(*FIXME*) in
+              let exp' = callE (t_exp cps) [t0] (tupE [k; r; cl]) in
               FuncE (x, T.Shared s', Replies, typbinds', args', ret_tys, exp')
             (* oneway, always with `ignore(async _)` body *)
             | Returns,
@@ -433,7 +439,10 @@ let transform prog =
               let r =
                 let e = fresh_var "e" T.catch in
                 [e] -->* tupE [] in (* discard error *)
-              let exp' = callE (t_exp cps) [t0] (tupE [k; r; r(*FIXME*)]) in
+              let cl =
+                let e = fresh_var "e" T.catch in
+                [e] -->* tupE [](*FIXME*) in (* discard error *)
+              let exp' = callE (t_exp cps) [t0] (tupE [k; r; cl]) in
               FuncE (x, T.Shared s', Returns, typbinds', args', ret_tys, exp')
             | Returns, _ ->
               assert false

From 93a05a7ec0416e3da1327f43a59d4d0e9b442c56 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 31 May 2024 15:40:43 +0200
Subject: [PATCH 055/179] WIP: revert a few things and fix others

---
 src/ir_def/check_ir.ml |  8 +-------
 src/ir_passes/async.ml | 10 +++++-----
 src/ir_passes/await.ml |  2 +-
 3 files changed, 7 insertions(+), 13 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 8909c4c361a..e452d2fc454 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -398,7 +398,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
   | PrimE (p, es) ->
     List.iter (check_exp env) es;
     begin match p, es with
-    | CallPrim insts, (exp1 :: exp2 :: _) when List.length es <= 3 ->
+    | CallPrim insts, [exp1; exp2] ->
       begin match T.promote (typ exp1) with
         | T.Func (sort, control, tbs, arg_tys, ret_tys) ->
           check_inst_bounds env tbs insts exp.at;
@@ -410,12 +410,6 @@ let rec check_exp env (exp:Ir.exp) : unit =
           end;
           typ exp2 <: t_arg;
           t_ret <: t;
-        (* TODO: when after await.ml AND length es == 3 then check that exp3 is ()->() *)
-          if List.length es = 3 then
-            begin
-              assert (not env.flavor.has_await);
-              typ (List.nth es 2) <:  T.unit
-            end
         | T.Non -> () (* dead code, not much to check here *)
         | t1 -> error env exp1.at "expected function type, but expression produces type\n  %s"
              (T.string_of_typ_expand t1)
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 1d579237fa8..06bc135a95a 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -45,13 +45,13 @@ let failT = T.Func(T.Local, T.Returns, [], [T.catch], [])
 let cleanT = T.Func(T.Local, T.Returns, [], [T.nat32(*FIXME*)], [])
 
 let t_async_fut as_seq t =
-  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: cleanT, actually ()->()*)],
+  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: actually ()->()*)],
     [T.sum [
       ("suspend", T.unit);
       ("schedule", T.Func(T.Local, T.Returns, [], [], []))]])
 
 let t_async_cmp as_seq t =
-  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: cleanT*)], [])
+  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: finallyT*)], [])
 
 let new_async_ret as_seq t = [t_async_fut as_seq t; fulfillT as_seq t; failT; cleanT]
 
@@ -347,11 +347,11 @@ let transform prog =
       let exp3' = t_exp exp3 in
       let (nary_async, nary_reply, reject, clean), def = new_nary_async_reply [T.blob] in
       (blockE (
-        letP (tupP [varP nary_async; varP nary_reply; varP reject]) def ::
+        letP (tupP [varP nary_async; varP nary_reply; varP reject; varP clean]) def ::
           let_eta exp1' (fun v1 ->
           let_eta exp2' (fun v2 ->
           let_eta exp3' (fun v3 ->
-            [expD (ic_call_rawE v1 v2 v3 (varE nary_reply) (varE reject) (varE reject(* REALLY: Some cleanup *))) ]
+            [expD (ic_call_rawE v1 v2 v3 (varE nary_reply) (varE reject) (varE clean)) ]
             )
           ))
          )
@@ -429,7 +429,7 @@ let transform prog =
               let t1, contT = match typ cps with
                 | Func (_, _,
                     [tb],
-                    [Func(_, _, [], ts1, []) as contT; _],
+                    [Func(_, _, [], ts1, []) as contT; _; _],
                     []) ->
                   (t_typ (T.seq (List.map (T.open_ [t0]) ts1)),t_typ (T.open_ [t0] contT))
                 | t -> assert false in
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index c2890816664..c9e5dac360c 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -495,7 +495,7 @@ and c_exp' context exp k =
           (k -@- varE v)
           (fun e -> r -@- e))
     in
-    nary context k' (fun vs -> e (PrimE (p, vs))) (exps @ [unitE ()(* FOR NOW *)])
+    nary context k' (fun vs -> e (PrimE (p, vs))) exps
   | PrimE (p, exps) ->
     nary context k (fun vs -> e (PrimE (p, vs))) exps
 

From 8823455aec1130ffa3d8a9f5770215795cf186b2 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 3 Jun 2024 13:28:15 +0200
Subject: [PATCH 056/179] WIP: towards backend support for the third
 continuation

---
 src/codegen/compile.ml             | 21 ++++++++++++---------
 src/ir_def/check_ir.ml             |  3 ++-
 src/ir_def/construct.ml            |  4 ++--
 src/ir_def/construct.mli           |  2 +-
 src/ir_interpreter/interpret_ir.ml |  2 +-
 src/ir_passes/async.ml             |  2 +-
 src/prelude/internals.mo           |  1 +
 7 files changed, 20 insertions(+), 15 deletions(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index 68c65c0f74b..fe752b90bd8 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -9460,29 +9460,29 @@ module FuncDec = struct
     | _ ->
       E.trap_with env (Printf.sprintf "cannot perform %s when running locally" purpose)
 
-  let ic_call env ts1 ts2 get_meth_pair get_arg get_k get_r =
+  let ic_call env ts1 ts2 get_meth_pair get_arg get_k get_r get_c =
     ic_call_threaded
       env
       "remote call"
       get_meth_pair
-      (closures_to_reply_reject_callbacks env ts2 [get_k; get_r])
+      (closures_to_reply_reject_callbacks env ts2 [get_k; get_r; get_c])
       (fun _ -> get_arg ^^ Serialization.serialize env ts1)
 
-  let ic_call_raw env get_meth_pair get_arg get_k get_r =
+  let ic_call_raw env get_meth_pair get_arg get_k get_r get_c =
     ic_call_threaded
       env
       "raw call"
       get_meth_pair
-      (closures_to_raw_reply_reject_callbacks env [get_k; get_r])
+      (closures_to_raw_reply_reject_callbacks env [get_k; get_r; get_c])
       (fun _ -> get_arg ^^ Blob.as_ptr_len env)
 
-  let ic_self_call env ts get_meth_pair get_future get_k get_r =
+  let ic_self_call env ts get_meth_pair get_future get_k get_r get_c =
     ic_call_threaded
       env
       "self call"
       get_meth_pair
       (* Storing the tuple away, future_array_index = 2, keep in sync with rts/continuation_table.rs *)
-      (closures_to_reply_reject_callbacks env ts [get_k; get_r; get_future])
+      (closures_to_reply_reject_callbacks env ts [get_k; get_r; get_c; get_future])
       (fun get_cb_index ->
         get_cb_index ^^
         BoxedSmallWord.box env Type.Nat32 ^^
@@ -11784,7 +11784,7 @@ and compile_prim_invocation (env : E.t) ae p es at =
   | ICCallerPrim, [] ->
     SR.Vanilla, IC.caller env
 
-  | ICCallPrim _, [f;e;k;r] ->
+  | ICCallPrim _, [f;e;k;r;c] ->
     SR.unit, begin
     (* TBR: Can we do better than using the notes? *)
     let _, _, _, ts1, _ = Type.as_func f.note.Note.typ in
@@ -11793,12 +11793,14 @@ and compile_prim_invocation (env : E.t) ae p es at =
     let (set_arg, get_arg) = new_local env "arg" in
     let (set_k, get_k) = new_local env "k" in
     let (set_r, get_r) = new_local env "r" in
+    let (set_c, get_c) = new_local env "c" in
     let add_cycles = Internals.add_cycles env ae in
     compile_exp_vanilla env ae f ^^ set_meth_pair ^^
     compile_exp_vanilla env ae e ^^ set_arg ^^
     compile_exp_vanilla env ae k ^^ set_k ^^
     compile_exp_vanilla env ae r ^^ set_r ^^
-    FuncDec.ic_call env ts1 ts2 get_meth_pair get_arg get_k get_r add_cycles
+    compile_exp_vanilla env ae c ^^ set_c(*FIXME*) ^^
+    FuncDec.ic_call env ts1 ts2 get_meth_pair get_arg get_k get_r get_c add_cycles
     end
   | ICCallRawPrim, [p;m;a;k;r] ->
     SR.unit, begin
@@ -11814,7 +11816,7 @@ and compile_prim_invocation (env : E.t) ae p es at =
     compile_exp_vanilla env ae a ^^ set_arg ^^
     compile_exp_vanilla env ae k ^^ set_k ^^
     compile_exp_vanilla env ae r ^^ set_r ^^
-    FuncDec.ic_call_raw env get_meth_pair get_arg get_k get_r add_cycles
+    FuncDec.ic_call_raw env get_meth_pair get_arg get_k get_r get_r(*FIXME*) add_cycles
     end
 
   | ICMethodNamePrim, [] ->
@@ -12044,6 +12046,7 @@ and compile_exp_with_hint (env : E.t) ae sr_hint exp =
       get_future
       get_k
       get_r
+      get_r (*FIXME*)
       add_cycles
   | ActorE (ds, fs, _, _) ->
     fatal "Local actors not supported by backend"
diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index e452d2fc454..091912408bb 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -594,7 +594,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
       T.Non <: t
     | ICCallerPrim, [] ->
       T.caller <: t
-    | ICCallPrim _, [exp1; exp2; k; r] ->
+    | ICCallPrim _, [exp1; exp2; k; r; c] ->
       let t1 = T.promote (typ exp1) in
       begin match t1 with
       | T.Func (sort, T.Replies, _ (*TBR*), arg_tys, ret_tys) ->
@@ -603,6 +603,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
         check_concrete env exp.at t_arg;
         typ k <: T.Func (T.Local, T.Returns, [], ret_tys, []);
         typ r <: T.Func (T.Local, T.Returns, [], [T.error], []);
+        typ c <: T.Func (T.Local, T.Returns, [], [T.nat32], []);
       | T.Non -> () (* dead code, not much to check here *)
       | _ ->
          error env exp1.at "expected function type, but expression produces type\n  %s"
diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 854da2e583a..225a3cfdf3a 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -183,9 +183,9 @@ let ic_rejectE e =
   }
 
 let ic_callE f e k r c =
-  let es = [f; e; k; r] in
+  let es = [f; e; k; r; c] in
   let eff = List.(map eff es |> fold_left max_eff T.Triv) in
-  { it = PrimE (ICCallPrim (Option.map id_of_var c), es);
+  { it = PrimE (ICCallPrim (Option.map id_of_var None(*FIXME: revert*)), es);
     at = no_region;
     note = Note.{ def with typ = T.unit; eff }
   }
diff --git a/src/ir_def/construct.mli b/src/ir_def/construct.mli
index 93c915e316d..a0168aae052 100644
--- a/src/ir_def/construct.mli
+++ b/src/ir_def/construct.mli
@@ -55,7 +55,7 @@ val cps_asyncE : async_sort -> typ -> typ -> exp -> exp
 val cps_awaitE : async_sort -> typ -> exp -> exp -> exp
 val ic_replyE : typ list -> exp -> exp
 val ic_rejectE : exp -> exp
-val ic_callE : exp -> exp -> exp -> exp -> var option -> exp
+val ic_callE : exp -> exp -> exp -> exp -> exp -> exp
 val ic_call_rawE : exp -> exp -> exp -> exp -> exp -> exp -> exp
 val projE : exp -> int -> exp
 val optE : exp -> exp
diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index cbbbf218a48..c6fc9ffcdf5 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -446,7 +446,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
         let reject = Option.get env.rejects in
         let e = V.Tup [V.Variant ("canister_reject", V.unit); v1] in
         Scheduler.queue (fun () -> reject e)
-      | ICCallPrim _, [v1; v2; kv; rv] ->
+      | ICCallPrim _, [v1; v2; kv; rv; _(*FIXME*)] ->
         let call_conv, f = V.as_func v1 in
         check_call_conv (List.hd es) call_conv;
         check_call_conv_arg env exp v2 call_conv;
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 06bc135a95a..93c289e1fdf 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -335,7 +335,7 @@ let transform prog =
         letP (tupP [varP nary_async; varP nary_reply; varP reject; varP clean]) def ::
         let_eta exp1' (fun v1 ->
           let_seq ts1 exp2' (fun vs ->
-            [expD (ic_callE v1 (seqE (List.map varE vs)) (varE nary_reply) (varE reject) (Some reject(* REALLY: Some cleanup *)))]
+            [expD (ic_callE v1 (seqE (List.map varE vs)) (varE nary_reply) (varE reject) (varE clean))]
            )
           )
          )
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index b8cf7ed4502..74eb5f6c173 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -343,6 +343,7 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>)
   };
 
   func clean(_ : Nat32) {
+      (prim "print" : Text -> ()) "CLEANUP"
   };
 
   func enqueue(k : @Cont<T>, r : @Cont<Error>, c : @Cont<Error/*FIXME: unit*/>) : {

From 0b92793c7c3818e273a71d695d83dda5f990adf8 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 3 Jun 2024 13:45:06 +0200
Subject: [PATCH 057/179] WIP: fixup `future_array_index`

---
 rts/motoko-rts/src/continuation_table.rs | 2 +-
 src/codegen/compile.ml                   | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/rts/motoko-rts/src/continuation_table.rs b/rts/motoko-rts/src/continuation_table.rs
index b0be5f4dbda..11b124ede74 100644
--- a/rts/motoko-rts/src/continuation_table.rs
+++ b/rts/motoko-rts/src/continuation_table.rs
@@ -109,7 +109,7 @@ pub unsafe fn remember_continuation<M: Memory>(mem: &mut M, ptr: Value) -> u32 {
 
 // Position of the future in explicit self-send ContinuationTable entries
 // Invariant: keep this synchronised with compiler.ml (see future_array_index)
-const FUTURE_ARRAY_INDEX: u32 = 2;
+const FUTURE_ARRAY_INDEX: u32 = 3;
 
 #[no_mangle]
 pub unsafe extern "C" fn peek_future_continuation(idx: u32) -> Value {
diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index fe752b90bd8..4922a90487d 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -9481,7 +9481,7 @@ module FuncDec = struct
       env
       "self call"
       get_meth_pair
-      (* Storing the tuple away, future_array_index = 2, keep in sync with rts/continuation_table.rs *)
+      (* Storing the tuple away, future_array_index = 3, keep in sync with rts/continuation_table.rs *)
       (closures_to_reply_reject_callbacks env ts [get_k; get_r; get_c; get_future])
       (fun get_cb_index ->
         get_cb_index ^^

From 3a2e4bc1e777170836b96fba7efea08feb7b48cb Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 4 Jun 2024 13:34:47 +0200
Subject: [PATCH 058/179] invoke the cleanup closure

---
 src/codegen/compile.ml | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index 4922a90487d..8dc6ca898d2 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -9411,7 +9411,13 @@ module FuncDec = struct
     Func.define_built_in env name ["env", I32Type] [] (fun env ->
         G.i (LocalGet (nr 0l)) ^^
         ContinuationTable.recall env ^^
-        G.i Drop);
+        Arr.load_field env 2l ^^ (* get the cleanup closure *)
+        let set_closure, get_closure = new_local env "closure" in
+        set_closure ^^ get_closure ^^
+        Closure.prepare_closure_call env ^^
+        compile_unboxed_zero ^^
+        get_closure ^^
+        Closure.call_closure env 1 0);
     compile_unboxed_const (E.add_fun_ptr env (E.built_in env name))
 
   let ic_call_threaded env purpose get_meth_pair push_continuations

From 6ad57d775302979a9d9817cecc860a2ca719b908 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 4 Jun 2024 19:07:03 +0200
Subject: [PATCH 059/179] WIP: checkpoint

---
 src/codegen/compile.ml             | 20 +++++++++++++++++---
 src/ir_def/arrange_ir.ml           |  4 ++--
 src/ir_def/check_ir.ml             |  4 +++-
 src/ir_def/freevars.ml             |  2 +-
 src/ir_def/ir.ml                   |  2 +-
 src/ir_def/ir_effect.ml            |  5 +++--
 src/ir_def/rename.ml               |  4 ++--
 src/ir_interpreter/interpret_ir.ml |  3 ++-
 src/ir_passes/async.ml             |  8 ++++----
 src/ir_passes/const.ml             |  3 ++-
 src/ir_passes/eq.ml                |  4 ++--
 src/ir_passes/show.ml              |  4 ++--
 src/ir_passes/tailcall.ml          |  5 +++--
 test/run-drun/try-finally.mo       |  4 ++--
 14 files changed, 46 insertions(+), 26 deletions(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index 8dc6ca898d2..fc57bbbf343 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -9383,7 +9383,17 @@ module FuncDec = struct
     (* result is a function that accepts a list of closure getters, from which
        the first and second must be the reply and reject continuations. *)
     fun closure_getters ->
-      let (set_cb_index, get_cb_index) = new_local env "cb_index" in
+    let (set_cb_index, get_cb_index) = new_local env "cb_index" in
+    assert (List.length closure_getters > 2);
+
+(*
+        List.nth closure_getters 2 ^^
+        Closure.prepare_closure_call env ^^
+        compile_unboxed_zero ^^
+        List.nth closure_getters 2 ^^
+        Closure.call_closure env 1 0 ^^
+ *)
+    
       Arr.lit env closure_getters ^^
       ContinuationTable.remember env ^^
       set_cb_index ^^
@@ -9414,9 +9424,11 @@ module FuncDec = struct
         Arr.load_field env 2l ^^ (* get the cleanup closure *)
         let set_closure, get_closure = new_local env "closure" in
         set_closure ^^ get_closure ^^
+          IC._compile_static_print env "HEY" ^^
         Closure.prepare_closure_call env ^^
         compile_unboxed_zero ^^
         get_closure ^^
+          IC._compile_static_print env "HEY2" ^^
         Closure.call_closure env 1 0);
     compile_unboxed_const (E.add_fun_ptr env (E.built_in env name))
 
@@ -12031,11 +12043,12 @@ and compile_exp_with_hint (env : E.t) ae sr_hint exp =
     let return_arity = List.length return_tys in
     let mk_body env1 ae1 = compile_exp_as env1 ae1 (StackRep.of_arity return_arity) e in
     FuncDec.lit env ae x sort control captured args mk_body return_tys exp.at
-  | SelfCallE (ts, exp_f, exp_k, exp_r) ->
+  | SelfCallE (ts, exp_f, exp_k, exp_r, exp_c) ->
     SR.unit,
     let (set_future, get_future) = new_local env "future" in
     let (set_k, get_k) = new_local env "k" in
     let (set_r, get_r) = new_local env "r" in
+    let (set_c, get_c) = new_local env "c" in
     let mk_body env1 ae1 = compile_exp_as env1 ae1 SR.unit exp_f in
     let captured = Freevars.captured exp_f in
     let add_cycles = Internals.add_cycles env ae in
@@ -12045,6 +12058,7 @@ and compile_exp_with_hint (env : E.t) ae sr_hint exp =
 
     compile_exp_vanilla env ae exp_k ^^ set_k ^^
     compile_exp_vanilla env ae exp_r ^^ set_r ^^
+    compile_exp_vanilla env ae exp_c ^^ set_c ^^
 
     FuncDec.ic_self_call env ts
       IC.(get_self_reference env ^^
@@ -12052,7 +12066,7 @@ and compile_exp_with_hint (env : E.t) ae sr_hint exp =
       get_future
       get_k
       get_r
-      get_r (*FIXME*)
+      get_c
       add_cycles
   | ActorE (ds, fs, _, _) ->
     fatal "Local actors not supported by backend"
diff --git a/src/ir_def/arrange_ir.ml b/src/ir_def/arrange_ir.ml
index eccb436932d..5ae3c71db08 100644
--- a/src/ir_def/arrange_ir.ml
+++ b/src/ir_def/arrange_ir.ml
@@ -28,8 +28,8 @@ let rec exp e = match e.it with
   | DefineE (i, m, e1)  -> "DefineE" $$ [id i; mut m; exp e1]
   | FuncE (x, s, c, tp, as_, ts, e) ->
     "FuncE" $$ [Atom x; func_sort s; control c] @ List.map typ_bind tp @ args as_ @ [ typ (Type.seq ts); exp e]
-  | SelfCallE (ts, exp_f, exp_k, exp_r) ->
-    "SelfCallE" $$ [typ (Type.seq ts); exp exp_f; exp exp_k; exp exp_r]
+  | SelfCallE (ts, exp_f, exp_k, exp_r, exp_c) ->
+    "SelfCallE" $$ [typ (Type.seq ts); exp exp_f; exp exp_k; exp exp_r; exp exp_c]
   | ActorE (ds, fs, u, t) -> "ActorE"  $$ List.map dec ds @ fields fs @ [system u; typ t]
   | NewObjE (s, fs, t)  -> "NewObjE" $$ (Arrange_type.obj_sort s :: fields fs @ [typ t])
   | TryE (e, cs, _FIXME) -> "TryE" $$ [exp e] @ List.map case cs
diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 091912408bb..bbc48880e25 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -797,15 +797,17 @@ let rec check_exp env (exp:Ir.exp) : unit =
       , tbs, List.map (T.close cs) ts1, List.map (T.close cs) ret_tys
       ) in
     fun_ty <: t
-  | SelfCallE (ts, exp_f, exp_k, exp_r) ->
+  | SelfCallE (ts, exp_f, exp_k, exp_r, exp_c) ->
     check (not env.flavor.Ir.has_async_typ) "SelfCallE in async flavor";
     List.iter (check_typ env) ts;
     check_exp { env with lvl = NotTopLvl } exp_f;
     check_exp env exp_k;
     check_exp env exp_r;
+    check_exp env exp_c;
     typ exp_f <: T.unit;
     typ exp_k <: T.Func (T.Local, T.Returns, [], ts, []);
     typ exp_r <: T.Func (T.Local, T.Returns, [], [T.error], []);
+    typ exp_c <: T.Func (T.Local, T.Returns, [], [T.error(*FIXME*)], []);
   | ActorE (ds, fs,
       { preupgrade; postupgrade; meta; heartbeat; timer; inspect }, t0) ->
     (* TODO: check meta *)
diff --git a/src/ir_def/freevars.ml b/src/ir_def/freevars.ml
index 72dcd74ec06..122137d65c2 100644
--- a/src/ir_def/freevars.ml
+++ b/src/ir_def/freevars.ml
@@ -119,7 +119,7 @@ let rec exp e : f = match e.it with
   | ActorE (ds, fs, u, _)  -> actor ds fs u
   | NewObjE (_, fs, _)  -> fields fs
   | TryE (e, cs, cl)    -> exp e ++ cases cs ++ (match cl with Some e -> exp e | _ -> M.empty)
-  | SelfCallE (_, e1, e2, e3) -> under_lambda (exp e1) ++ exp e2 ++ exp e3
+  | SelfCallE (_, e1, e2, e3, e4) -> under_lambda (exp e1) ++ exps [e2; e3; e4]
 
 and actor ds fs u = close (decs ds +++ fields fs +++ system u)
 
diff --git a/src/ir_def/ir.ml b/src/ir_def/ir.ml
index 92fe490ed7a..d08658dfc4f 100644
--- a/src/ir_def/ir.ml
+++ b/src/ir_def/ir.ml
@@ -71,7 +71,7 @@ and exp' =
   | DefineE of id * mut * exp                  (* promise fulfillment *)
   | FuncE of                                   (* function *)
       string * Type.func_sort * Type.control * typ_bind list * arg list * Type.typ list * exp
-  | SelfCallE of Type.typ list * exp * exp * exp (* essentially ICCallPrim (FuncE shared…) *)
+  | SelfCallE of Type.typ list * exp * exp * exp * exp (* essentially ICCallPrim (FuncE shared…) *)
   | ActorE of dec list * field list * system * Type.typ (* actor *)
   | NewObjE of Type.obj_sort * field list * Type.typ  (* make an object *)
   | TryE of exp * case list * exp option       (* try/catch/cleanup *)
diff --git a/src/ir_def/ir_effect.ml b/src/ir_def/ir_effect.ml
index c46f766c73e..87892f14c65 100644
--- a/src/ir_def/ir_effect.ml
+++ b/src/ir_def/ir_effect.ml
@@ -77,10 +77,11 @@ and infer_effect_exp (exp: exp) : T.eff =
     effect_exp exp1
   | FuncE _ ->
     T.Triv
-  | SelfCallE (_, _, exp1, exp2) ->
+  | SelfCallE (_, _, exp1, exp2, exp3) ->
     let e1 = effect_exp exp1 in
     let e2 = effect_exp exp2 in
-    max_eff e1 e2
+    let e3 = effect_exp exp3 in
+    max_eff e1 (max_eff e2 e3)
   | ActorE _ ->
     T.Triv
   | NewObjE _ ->
diff --git a/src/ir_def/rename.ml b/src/ir_def/rename.ml
index 1ddaefe36ca..af313181973 100644
--- a/src/ir_def/rename.ml
+++ b/src/ir_def/rename.ml
@@ -64,8 +64,8 @@ and exp' rho = function
      FuncE (x, s, c, tp, p', ts, e')
   | NewObjE (s, fs, t)  -> NewObjE (s, fields rho fs, t)
   | TryE (e, cs, cl)    -> TryE (exp rho e, cases rho cs, Option.map (exp rho) cl)
-  | SelfCallE (ts, e1, e2, e3) ->
-     SelfCallE (ts, exp rho e1, exp rho e2, exp rho e3)
+  | SelfCallE (ts, e1, e2, e3, e4) ->
+     SelfCallE (ts, exp rho e1, exp rho e2, exp rho e3, exp rho e4)
 
 and lexp rho le = {le with it = lexp' rho le.it}
 and lexp' rho = function
diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index c6fc9ffcdf5..b18105971d8 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -527,7 +527,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
       define_id env id v';
       k V.unit
       )
-  | SelfCallE (ts, exp_f, exp_k, exp_r) ->
+  | SelfCallE (ts, exp_f, exp_k, exp_r, exp_c) ->
     assert (not env.flavor.has_async_typ);
     (* see code for FuncE *)
     let cc = { sort = T.Shared T.Write; control = T.Replies; n_args = 0; n_res = List.length ts } in
@@ -537,6 +537,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     (* see code for ICCallPrim *)
     interpret_exp env exp_k (fun kv ->
     interpret_exp env exp_r (fun rv ->
+    (*FIXME: interpret_exp env exp_c (fun cv ->*)
         let _call_conv, f = V.as_func v in
         last_region := exp.at; (* in case the following throws *)
         let vc = context env in
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 93c289e1fdf..4efe624c29b 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -24,8 +24,8 @@ module ConRenaming = E.Make(struct type t = T.con let compare = Cons.compare end
 
 (* Helpers *)
 
-let selfcallE ts e1 e2 e3 =
-  { it = SelfCallE (ts, e1, e2, e3);
+let selfcallE ts e1 e2 e3 e4 =
+  { it = SelfCallE (ts, e1, e2, e3, e4);
     at = no_region;
     note = Note.{ def with typ = T.unit } }
 
@@ -267,7 +267,7 @@ let transform prog =
                   (* try await async (); schedule() catch e -> r(e) *)
                  (let v = fresh_var "call" T.unit in
                   letE v
-                    (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1))
+                    (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1) (projE (varE vkrc) 2))
                     (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
               ]
               T.unit
@@ -301,7 +301,7 @@ let transform prog =
             let c = fresh_var "c" T.catch in
             [c] -->* ic_rejectE (errorMessageE (varE c))(*FIXME*) in
           let exp' = callE (t_exp exp1) [t0] (tupE [ic_reply; ic_reject; ic_cleanup]) in
-          expD (selfcallE ts1 exp' (varE nary_reply) (varE reject))
+          expD (selfcallE ts1 exp' (varE nary_reply) (varE reject) (varE clean))
         ]
         (varE nary_async)
       ).it
diff --git a/src/ir_passes/const.ml b/src/ir_passes/const.ml
index 6edd94786c9..abbb060047b 100644
--- a/src/ir_passes/const.ml
+++ b/src/ir_passes/const.ml
@@ -147,10 +147,11 @@ let rec exp lvl (env : env) e : Lbool.t =
       exp_ lvl env e2;
       exp_ lvl env e3;
       surely_false
-    | SelfCallE (_, e1, e2, e3) ->
+    | SelfCallE (_, e1, e2, e3, e4) ->
       exp_ NotTopLvl env e1;
       exp_ lvl env e2;
       exp_ lvl env e3;
+      exp_ lvl env e4;
       surely_false
     | SwitchE (e1, cs) | TryE (e1, cs, None) ->
       exp_ lvl env e1;
diff --git a/src/ir_passes/eq.ml b/src/ir_passes/eq.ml
index 3d4605f7f10..7a504ed9f57 100644
--- a/src/ir_passes/eq.ml
+++ b/src/ir_passes/eq.ml
@@ -248,8 +248,8 @@ and t_exp' env = function
     DefineE (id, mut, t_exp env exp1)
   | NewObjE (sort, ids, t) ->
     NewObjE (sort, ids, t)
-  | SelfCallE (ts, e1, e2, e3) ->
-    SelfCallE (ts, t_exp env e1, t_exp env e2, t_exp env e3)
+  | SelfCallE (ts, e1, e2, e3, e4) ->
+    SelfCallE (ts, t_exp env e1, t_exp env e2, t_exp env e3, t_exp env e4)
   | ActorE (ds, fields, {meta; preupgrade; postupgrade; heartbeat; timer; inspect}, typ) ->
     (* Until Actor expressions become their own units,
        we repeat what we do in `comp_unit` below *)
diff --git a/src/ir_passes/show.ml b/src/ir_passes/show.ml
index de351926061..0125b5cfabc 100644
--- a/src/ir_passes/show.ml
+++ b/src/ir_passes/show.ml
@@ -290,8 +290,8 @@ and t_exp' env = function
     DefineE (id, mut, t_exp env exp1)
   | NewObjE (sort, ids, t) ->
     NewObjE (sort, ids, t)
-  | SelfCallE (ts, e1, e2, e3) ->
-    SelfCallE (ts, t_exp env e1, t_exp env e2, t_exp env e3)
+  | SelfCallE (ts, e1, e2, e3, e4) ->
+    SelfCallE (ts, t_exp env e1, t_exp env e2, t_exp env e3, t_exp env e4)
   | ActorE (ds, fields, {meta; preupgrade; postupgrade; heartbeat; timer; inspect}, typ) ->
     (* Until Actor expressions become their own units,
        we repeat what we do in `comp_unit` below *)
diff --git a/src/ir_passes/tailcall.ml b/src/ir_passes/tailcall.ml
index 165df14c47e..c539ae7dd5a 100644
--- a/src/ir_passes/tailcall.ml
+++ b/src/ir_passes/tailcall.ml
@@ -120,12 +120,13 @@ and exp' env e  : exp' = match e.it with
     let env2 = args env1 as_ in
     let exp0' = tailexp env2 exp0 in
     FuncE (x, s, c, tbs, as_, ret_tys, exp0')
-  | SelfCallE (ts, exp1, exp2, exp3) ->
+  | SelfCallE (ts, exp1, exp2, exp3, exp4) ->
     let env1 = { tail_pos = true; info = None} in
     let exp1' = tailexp env1 exp1 in
     let exp2' = exp env exp2 in
     let exp3' = exp env exp3 in
-    SelfCallE (ts, exp1', exp2', exp3')
+    let exp4' = exp env exp4 in
+    SelfCallE (ts, exp1', exp2', exp3', exp4')
   | ActorE (ds, fs, u, t) ->
     let u = { u with preupgrade = exp env u.preupgrade; postupgrade = exp env u.postupgrade } in
     ActorE (snd (decs env ds), fs, u, t)
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index f67cb10bc27..9f1f3a1b5d8 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -1,12 +1,12 @@
 import { debugPrint; error } =  "mo:prim";
 
 actor A {
-    func m() : async () {
+    public func m() : async () {
     };
     
 
     func t0() : async () {
-        try { debugPrint "IN"; await m(); }
+        try { debugPrint "IN"; await m(); assert false }
         case { debugPrint "OUT" };
     };
 

From c73e61bfc62aedc75ff8c9e8f9af7477173b3ce7 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 5 Jun 2024 12:23:54 +0200
Subject: [PATCH 060/179] WIP: back to business

---
 src/ir_def/check_ir.ml | 2 +-
 src/ir_passes/async.ml | 3 ++-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index bbc48880e25..3c35568cd64 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -807,7 +807,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
     typ exp_f <: T.unit;
     typ exp_k <: T.Func (T.Local, T.Returns, [], ts, []);
     typ exp_r <: T.Func (T.Local, T.Returns, [], [T.error], []);
-    typ exp_c <: T.Func (T.Local, T.Returns, [], [T.error(*FIXME*)], []);
+    typ exp_c <: T.Func (T.Local, T.Returns, [], [T.nat32], []);
   | ActorE (ds, fs,
       { preupgrade; postupgrade; meta; heartbeat; timer; inspect }, t0) ->
     (* TODO: check meta *)
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 4efe624c29b..4f5da3385c2 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -266,8 +266,9 @@ let transform prog =
                 ("schedule", varP schedule, (* resume later *)
                   (* try await async (); schedule() catch e -> r(e) *)
                  (let v = fresh_var "call" T.unit in
+                  let n = fresh_var "nat" T.nat32 in
                   letE v
-                    (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1) (projE (varE vkrc) 2))
+                    (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1) ([n] -->* unitE ()(*projE (varE vkrc) 2*)))
                     (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
               ]
               T.unit

From 108b188ca4d86f5e3b2eb814c3f2f815f252243c Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 5 Jun 2024 13:14:41 +0200
Subject: [PATCH 061/179] WIP: twist & shout!

---
 src/codegen/compile.ml       |  2 --
 src/ir_def/check_ir.ml       |  2 +-
 src/ir_passes/async.ml       | 32 +++++++++++++++++---------------
 src/prelude/internals.mo     |  4 +++-
 test/run-drun/try-finally.mo |  3 +--
 5 files changed, 22 insertions(+), 21 deletions(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index fc57bbbf343..44c5a16df31 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -9424,11 +9424,9 @@ module FuncDec = struct
         Arr.load_field env 2l ^^ (* get the cleanup closure *)
         let set_closure, get_closure = new_local env "closure" in
         set_closure ^^ get_closure ^^
-          IC._compile_static_print env "HEY" ^^
         Closure.prepare_closure_call env ^^
         compile_unboxed_zero ^^
         get_closure ^^
-          IC._compile_static_print env "HEY2" ^^
         Closure.call_closure env 1 0);
     compile_unboxed_const (E.add_fun_ptr env (E.built_in env name))
 
diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 3c35568cd64..43ce95837f5 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -807,7 +807,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
     typ exp_f <: T.unit;
     typ exp_k <: T.Func (T.Local, T.Returns, [], ts, []);
     typ exp_r <: T.Func (T.Local, T.Returns, [], [T.error], []);
-    typ exp_c <: T.Func (T.Local, T.Returns, [], [T.nat32], []);
+    typ exp_c <: T.Func (T.Local, T.Returns, [], [T.nat32(*FIXME*)], []);
   | ActorE (ds, fs,
       { preupgrade; postupgrade; meta; heartbeat; timer; inspect }, t0) ->
     (* TODO: check meta *)
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 4f5da3385c2..1ec049e3e97 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -38,30 +38,30 @@ let unary typ = [typ]
 
 let nary typ = T.as_seq typ
 
-let fulfillT as_seq typ = T.Func(T.Local, T.Returns, [], as_seq typ, [])
+let fulfillT as_seq typ = T.(Func(Local, Returns, [], as_seq typ, []))
 
-let failT = T.Func(T.Local, T.Returns, [], [T.catch], [])
+let failT = T.(Func(Local, Returns, [], [catch], []))
 
-let cleanT = T.Func(T.Local, T.Returns, [], [T.nat32(*FIXME*)], [])
+let cleanT = T.(Func(Local, Returns, [], [nat32(*FIXME*)], []))
 
 let t_async_fut as_seq t =
-  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: actually ()->()*)],
-    [T.sum [
-      ("suspend", T.unit);
-      ("schedule", T.Func(T.Local, T.Returns, [], [], []))]])
+  T.(Func (Local, Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: actually ()->()*)],
+           [sum [
+                ("suspend", unit);
+                ("schedule", Func(Local, Returns, [], [], []))]]))
 
 let t_async_cmp as_seq t =
-  T.Func (T.Local, T.Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: finallyT*)], [])
+  T.(Func (Local, Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: finallyT*)], []))
 
 let new_async_ret as_seq t = [t_async_fut as_seq t; fulfillT as_seq t; failT; cleanT]
 
 let new_asyncT =
-  T.Func (
-    T.Local,
-    T.Returns,
-    [ { var = "T"; sort = T.Type; bound = T.Any } ],
-    [],
-    new_async_ret unary (T.Var ("T", 0)))
+  (Func (
+       Local,
+       Returns,
+       [ { var = "T"; sort = Type; bound = Any } ],
+       [],
+       new_async_ret unary (Var ("T", 0))))
 
 let new_asyncE () =
   varE (var "@new_async" new_asyncT)
@@ -267,8 +267,10 @@ let transform prog =
                   (* try await async (); schedule() catch e -> r(e) *)
                  (let v = fresh_var "call" T.unit in
                   let n = fresh_var "nat" T.nat32 in
+                  let shoutT = T.(Func (Local, Returns, [], [], [])) in
                   letE v
-                    (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1) ([n] -->* unitE ()(*projE (varE vkrc) 2*)))
+                  (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1)
+                     ([n] -->* (varE (var "@shout" shoutT) -*- unitE ())(*projE (varE vkrc) 2*)))
                     (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
               ]
               T.unit
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index 74eb5f6c173..771dfb3051d 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -307,6 +307,8 @@ func @getSystemRefund() : @Refund {
   return (prim "cyclesRefunded" : () -> Nat) ();
 };
 
+func @shout() = (prim "print" : Text -> ()) "CLEANUP";
+
 func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>) {
   let w_null = func(r : @Refund, t : T) { };
   let r_null = func(_ : Error) {};
@@ -343,7 +345,7 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>)
   };
 
   func clean(_ : Nat32) {
-      (prim "print" : Text -> ()) "CLEANUP"
+      @shout(); (prim "print" : Text -> ()) "EXTERN";
   };
 
   func enqueue(k : @Cont<T>, r : @Cont<Error>, c : @Cont<Error/*FIXME: unit*/>) : {
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 9f1f3a1b5d8..9c066cb604d 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -1,9 +1,8 @@
 import { debugPrint; error } =  "mo:prim";
 
 actor A {
-    public func m() : async () {
+    func m() : async () {
     };
-    
 
     func t0() : async () {
         try { debugPrint "IN"; await m(); assert false }

From 8efe8c9cb46b6b96b21912ef784427fedb88d615 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 6 Jun 2024 15:00:26 +0200
Subject: [PATCH 062/179] cleanup a bit

---
 src/codegen/compile.ml | 14 ++------------
 1 file changed, 2 insertions(+), 12 deletions(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index 44c5a16df31..93991dbf5a7 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -9383,17 +9383,7 @@ module FuncDec = struct
     (* result is a function that accepts a list of closure getters, from which
        the first and second must be the reply and reject continuations. *)
     fun closure_getters ->
-    let (set_cb_index, get_cb_index) = new_local env "cb_index" in
-    assert (List.length closure_getters > 2);
-
-(*
-        List.nth closure_getters 2 ^^
-        Closure.prepare_closure_call env ^^
-        compile_unboxed_zero ^^
-        List.nth closure_getters 2 ^^
-        Closure.call_closure env 1 0 ^^
- *)
-    
+      let set_cb_index, get_cb_index = new_local env "cb_index" in
       Arr.lit env closure_getters ^^
       ContinuationTable.remember env ^^
       set_cb_index ^^
@@ -11815,7 +11805,7 @@ and compile_prim_invocation (env : E.t) ae p es at =
     compile_exp_vanilla env ae e ^^ set_arg ^^
     compile_exp_vanilla env ae k ^^ set_k ^^
     compile_exp_vanilla env ae r ^^ set_r ^^
-    compile_exp_vanilla env ae c ^^ set_c(*FIXME*) ^^
+    compile_exp_vanilla env ae c ^^ set_c ^^
     FuncDec.ic_call env ts1 ts2 get_meth_pair get_arg get_k get_r get_c add_cycles
     end
   | ICCallRawPrim, [p;m;a;k;r] ->

From ab73471f6b62757594df99db8835cb3ede26b694 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 6 Jun 2024 15:15:05 +0200
Subject: [PATCH 063/179] tweak

---
 src/ir_passes/await.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index c9e5dac360c..decbc483608 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -20,7 +20,7 @@ type kont = ContVar of var
 let meta typ exp =
   let expanded = ref false in
   let exp v =
-    assert (not(!expanded));
+    assert (not !expanded);
     expanded := true;
     exp v
   in

From f515bda78f17f3284872adabcf2c4d48e830f385 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 6 Jun 2024 15:54:05 +0200
Subject: [PATCH 064/179] WIP: set up the `Cleanup` chain

---
 src/ir_passes/await.ml | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index decbc483608..d001f4b8144 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -51,7 +51,7 @@ let precont k thunk =
     MetaCont (typ, fun v -> finally (cont v))
 
 (* Named labels for break, special labels for return and throw *)
-type label = Return | Throw | Named of string
+type label = Return | Throw | Cleanup | Named of string
 
 let ( -@- ) k exp2 =
   match k with
@@ -400,8 +400,10 @@ and c_exp' context exp k =
         | Cont k -> Cont (precont k exp2)
         | Label -> assert false
       in
-      let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Throw -> fun c -> c) context in
+      let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Cleanup | Throw -> fun c -> c) context in
       let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
+      let c = match LabelEnv.find_opt Cleanup context'' with Some c -> c | None -> Cont (ContVar (var "@shout" (err_contT T.unit))) in
+      let context''' = LabelEnv.add Cleanup (lab c) context'' in
       blockE
         [ let e = fresh_var "e" T.catch in
           funcD throw e {
@@ -410,7 +412,7 @@ and c_exp' context exp k =
             note = Note.{ def with typ = typ_cases cases'; eff = T.Await; (* shouldn't matter *) }
           }
         ]
-        (c_exp context'' exp1 (ContVar k))
+        (c_exp context''' exp1 (ContVar k))
     ))
   | LoopE exp1 ->
     c_loop context k exp1
@@ -468,16 +470,22 @@ and c_exp' context exp k =
       | Some (Cont r) -> r
       | _ -> assert false
     in
+    let c = match LabelEnv.find_opt Cleanup context with
+      | Some (Cont r) -> r
+      | None -> ContVar (var "@shout" (err_contT T.unit))
+      | _ -> assert false
+    in
     letcont r (fun r ->
     letcont k (fun k ->
-      let krc = tupE [varE k; varE r; varE r(*FIXME*)] in
+    letcont c (fun c ->
+      let krc = tupE [varE k; varE r; varE c] in
       match eff exp1 with
       | T.Triv ->
         cps_awaitE s (typ_of_var k) (t_exp context exp1) krc
       | T.Await ->
         c_exp context exp1
           (meta (typ exp1) (fun v1 -> (cps_awaitE s (typ_of_var k) (varE v1) krc)))
-    ))
+    )))
   | DeclareE (id, typ, exp1) ->
     unary context k (fun v1 -> e (DeclareE (id, typ, varE v1))) exp1
   | DefineE (id, mut, exp1) ->

From 4cce7fe0708efe2c33c33399bac25716c2df0936 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 6 Jun 2024 16:04:20 +0200
Subject: [PATCH 065/179] WIP: fix typing

---
 src/ir_passes/await.ml   | 4 ++--
 src/prelude/internals.mo | 1 +
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index d001f4b8144..b4ac88dcb68 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -402,7 +402,7 @@ and c_exp' context exp k =
       in
       let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Cleanup | Throw -> fun c -> c) context in
       let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
-      let c = match LabelEnv.find_opt Cleanup context'' with Some c -> c | None -> Cont (ContVar (var "@shout" (err_contT T.unit))) in
+      let c = match LabelEnv.find_opt Cleanup context'' with Some c -> c | None -> Cont (ContVar (var "@shout2" (err_contT T.unit))) in
       let context''' = LabelEnv.add Cleanup (lab c) context'' in
       blockE
         [ let e = fresh_var "e" T.catch in
@@ -472,7 +472,7 @@ and c_exp' context exp k =
     in
     let c = match LabelEnv.find_opt Cleanup context with
       | Some (Cont r) -> r
-      | None -> ContVar (var "@shout" (err_contT T.unit))
+      | None -> ContVar (var "@shout2" (err_contT T.unit))
       | _ -> assert false
     in
     letcont r (fun r ->
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index 771dfb3051d..cf1c6e86d17 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -308,6 +308,7 @@ func @getSystemRefund() : @Refund {
 };
 
 func @shout() = (prim "print" : Text -> ()) "CLEANUP";
+func @shout2(_ : Error) = (prim "print" : Text -> ()) "CLEANUP_E";
 
 func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>) {
   let w_null = func(r : @Refund, t : T) { };

From 0a84c5d154af61caf3f3c6a5ffdfe9a7aa7a69f7 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 6 Jun 2024 16:24:40 +0200
Subject: [PATCH 066/179] WIP: store the chain on `enqueue`

---
 src/prelude/internals.mo | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index cf1c6e86d17..eadc88e614a 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -345,14 +345,20 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>)
     };
   };
 
+  var cleanup : Error -> () = @shout2;
+
   func clean(_ : Nat32) {
-      @shout(); (prim "print" : Text -> ()) "EXTERN";
+    (prim "print" : Text -> ()) "EXTERN";
+
+    cleanup ((prim "cast" : ({#call_error : {err_code : Nat32}}, Text) -> Error)
+    (#call_error {err_code = 0 : Nat32}, "HAHA"));
   };
 
   func enqueue(k : @Cont<T>, r : @Cont<Error>, c : @Cont<Error/*FIXME: unit*/>) : {
     #suspend;
     #schedule : () -> ();
   } {
+    cleanup := c;
     switch result {
       case null {
         let ws_ = ws;

From 2ca816c27bea3602396ff8a40067646590366e78 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 7 Jun 2024 12:23:31 +0200
Subject: [PATCH 067/179] introduce `finally` keyword and update parser

---
 doc/md/examples/grammar.txt        |  4 ++--
 src/gen-grammar/grammar.sed        |  1 +
 src/mo_frontend/error_reporting.ml |  1 +
 src/mo_frontend/parser.mly         |  6 +++---
 src/mo_frontend/printers.ml        |  1 +
 src/mo_frontend/source_lexer.mll   |  1 +
 src/mo_frontend/source_token.ml    |  3 +++
 test/run-drun/try-finally.mo       | 16 ++++++++--------
 test/run/try-finally.mo            | 12 ++++++------
 9 files changed, 26 insertions(+), 19 deletions(-)

diff --git a/doc/md/examples/grammar.txt b/doc/md/examples/grammar.txt
index 101ce07deaf..f73ca82ddba 100644
--- a/doc/md/examples/grammar.txt
+++ b/doc/md/examples/grammar.txt
@@ -217,8 +217,8 @@
     'if' <exp_nullary> <exp_nest>
     'if' <exp_nullary> <exp_nest> 'else' <exp_nest>
     'try' <exp_nest> <catch>
-    'try' <exp_nest> 'case' <exp_nest>
-    'try' <exp_nest> 'else' <catch> 'case' <exp_nest>
+    'try' <exp_nest> 'finally' <exp_nest>
+    'try' <exp_nest> 'else' <catch> 'finally' <exp_nest>
     'throw' <exp_nest>
     'switch' <exp_nullary> '{' <list(<case>, ';')> '}'
     'while' <exp_nullary> <exp_nest>
diff --git a/src/gen-grammar/grammar.sed b/src/gen-grammar/grammar.sed
index 66ca48c061f..ac64fe62668 100644
--- a/src/gen-grammar/grammar.sed
+++ b/src/gen-grammar/grammar.sed
@@ -53,6 +53,7 @@ s/UNDERSCORE/\'_\'/g
 s/TYPE/\'type\'/g
 s/TRY/\'try\'/g
 s/THROW/\'throw\'/g
+s/FINALLY/\'finally\'/g
 s/TEXT/<text>/g
 s/SWITCH/\'switch\'/g
 s/SUBOP/\'-\'/g
diff --git a/src/mo_frontend/error_reporting.ml b/src/mo_frontend/error_reporting.ml
index 78cf5e56ffe..6b2122d1dc1 100644
--- a/src/mo_frontend/error_reporting.ml
+++ b/src/mo_frontend/error_reporting.ml
@@ -20,6 +20,7 @@ let terminal2token (type a) (symbol : a terminal) : token =
       | T_TYPE -> TYPE
       | T_TRY -> TRY
       | T_THROW -> THROW
+      | T_FINALLY -> FINALLY
       | T_TEXT -> TEXT "..."
       | T_SWITCH -> SWITCH
       | T_SUBOP -> SUBOP
diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly
index ef62467768c..76ba6529b1f 100644
--- a/src/mo_frontend/parser.mly
+++ b/src/mo_frontend/parser.mly
@@ -210,7 +210,7 @@ and objblock s ty dec_fields =
 %token LET VAR
 %token LPAR RPAR LBRACKET RBRACKET LCURLY RCURLY
 %token AWAIT AWAITSTAR ASYNC ASYNCSTAR BREAK CASE CATCH CONTINUE DO LABEL DEBUG
-%token IF IGNORE IN ELSE SWITCH LOOP WHILE FOR RETURN TRY THROW WITH
+%token IF IGNORE IN ELSE SWITCH LOOP WHILE FOR RETURN TRY THROW FINALLY WITH
 %token ARROW ASSIGN
 %token FUNC TYPE OBJECT ACTOR CLASS PUBLIC PRIVATE SHARED SYSTEM QUERY
 %token SEMICOLON SEMICOLON_EOL COMMA COLON SUB DOT QUEST BANG
@@ -709,9 +709,9 @@ exp_un(B) :
     { IfE(b, e1, e2) @? at $sloc }
   | TRY e1=exp_nest c=catch
     { TryE(e1, [c], None) @? at $sloc }
-  | TRY e1=exp_nest CASE e2=exp_nest (* FIXME: needs a different keyword, provisional *)
+  | TRY e1=exp_nest FINALLY e2=exp_nest (* FIXME: needs a different keyword (`DO`?), provisional *)
     { TryE(e1, [], Some e2) @? at $sloc }
-  | TRY e1=exp_nest ELSE c=catch CASE e2=exp_nest (* FIXME: maximal kludge, just to avoid YACC errors *)
+  | TRY e1=exp_nest ELSE c=catch FINALLY e2=exp_nest
     { TryE(e1, [c], Some e2) @? at $sloc }
 (* TODO: enable multi-branch TRY (already supported by compiler)
   | TRY e=exp_nest LCURLY cs=seplist(case, semicolon) RCURLY
diff --git a/src/mo_frontend/printers.ml b/src/mo_frontend/printers.ml
index c0b9e5c0a3a..7105e3e7cc7 100644
--- a/src/mo_frontend/printers.ml
+++ b/src/mo_frontend/printers.ml
@@ -26,6 +26,7 @@ let string_of_symbol = function
   | X (T T_TYPE) -> "type"
   | X (T T_TRY) -> "try"
   | X (T T_THROW) -> "throw"
+  | X (T T_FINALLY) -> "finally"
   | X (T T_TEXT) -> "<text>"
   | X (T T_SWITCH) -> "switch"
   | X (T T_SUBOP) -> unop "-"
diff --git a/src/mo_frontend/source_lexer.mll b/src/mo_frontend/source_lexer.mll
index ad9de260ff0..2e527822c79 100644
--- a/src/mo_frontend/source_lexer.mll
+++ b/src/mo_frontend/source_lexer.mll
@@ -214,6 +214,7 @@ rule token mode = parse
   | "do" { DO }
   | "else" { ELSE }
   | "false" { BOOL false }
+  | "finally" { FINALLY }
   | "flexible" { FLEXIBLE }
   | "for" { FOR }
   | "from_candid" { FROM_CANDID }
diff --git a/src/mo_frontend/source_token.ml b/src/mo_frontend/source_token.ml
index 1d385c23288..b49a7071967 100644
--- a/src/mo_frontend/source_token.ml
+++ b/src/mo_frontend/source_token.ml
@@ -22,6 +22,7 @@ type token =
   | LABEL
   | DEBUG
   | DO
+  | FINALLY
   | FLEXIBLE
   | IF
   | IGNORE
@@ -163,6 +164,7 @@ let to_parser_token :
   | RETURN -> Ok Parser.RETURN
   | TRY -> Ok Parser.TRY
   | THROW -> Ok Parser.THROW
+  | FINALLY -> Ok Parser.FINALLY
   | WITH -> Ok Parser.WITH
   | ARROW -> Ok Parser.ARROW
   | ASSIGN -> Ok Parser.ASSIGN
@@ -291,6 +293,7 @@ let string_of_parser_token = function
   | Parser.RETURN -> "RETURN"
   | Parser.TRY -> "TRY"
   | Parser.THROW -> "THROW"
+  | Parser.FINALLY -> "FINALLY"
   | Parser.WITH -> "WITH"
   | Parser.ARROW -> "ARROW"
   | Parser.ASSIGN -> "ASSIGN"
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 9c066cb604d..18be95bd1be 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -6,7 +6,7 @@ actor A {
 
     func t0() : async () {
         try { debugPrint "IN"; await m(); assert false }
-        case { debugPrint "OUT" };
+        finally { debugPrint "OUT" };
     };
 
 /*  nested `try` won't work
@@ -16,7 +16,7 @@ actor A {
                 debugPrint "IN1";
                 throw error "IN1";
             }
-            case { debugPrint "OUT1" };
+            finally { debugPrint "OUT1" };
         }
         catch _ { debugPrint "CAUGHT1" }
     };
@@ -28,7 +28,7 @@ actor A {
             throw error "IN2";
         }
         else catch _ { debugPrint "CAUGHT2" }
-        case { debugPrint "OUT2" };
+        finally { debugPrint "OUT2" };
     };
 
     //TODO: func t2t() : async Int { ... }
@@ -39,7 +39,7 @@ actor A {
             await m();
             return;
         }
-        case { debugPrint "OUT3" };
+        finally { debugPrint "OUT3" };
     };
 /*
     // check that finally not running twice
@@ -47,7 +47,7 @@ actor A {
         try {
             debugPrint "IN4";
         }
-        case { debugPrint "OUT4" };
+        finally { debugPrint "OUT4" };
         return;
     };
 */
@@ -59,7 +59,7 @@ actor A {
             break out;
             debugPrint "DEAD5";
         }
-        case { debugPrint "OUT5" };
+        finally { debugPrint "OUT5" };
         debugPrint "AFTER5"
     };
 
@@ -73,10 +73,10 @@ actor A {
                 debugPrint "InnerLIVE6";
                 break out;
                 debugPrint "InnerDEAD6";
-            } case { debugPrint "InnerOUT6" };
+            } finally { debugPrint "InnerOUT6" };
             debugPrint "DEAD6";
         }
-        case { debugPrint "OUT6" };
+        finally { debugPrint "OUT6" };
         debugPrint "AFTER6"
     };
 */
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
index e417b5419c6..99246f37dae 100644
--- a/test/run/try-finally.mo
+++ b/test/run/try-finally.mo
@@ -7,7 +7,7 @@ actor A {
 
     func t0() : async () {
         try { debugPrint "IN"; await m(); }
-        case { debugPrint "OUT" };
+        finally { debugPrint "OUT" };
     };
 
 /*  nested `try` won't work
@@ -17,7 +17,7 @@ actor A {
                 debugPrint "IN1";
                 throw error "IN1";
             }
-            case { debugPrint "OUT1" };
+            finally { debugPrint "OUT1" };
         }
         catch _ { debugPrint "CAUGHT1" }
     };
@@ -29,7 +29,7 @@ actor A {
             throw error "IN2";
         }
         else catch _ { debugPrint "CAUGHT2" }
-        case { debugPrint "OUT2" };
+        finally { debugPrint "OUT2" };
     };
 
     //TODO: func t2t() : async Int { ... }
@@ -39,7 +39,7 @@ actor A {
             debugPrint "IN3";
             return;
         }
-        case { debugPrint "OUT3" };
+        finally { debugPrint "OUT3" };
     };
 
     // check that finally not running twice
@@ -47,7 +47,7 @@ actor A {
         try {
             debugPrint "IN4";
         }
-        case { debugPrint "OUT4" };
+        finally { debugPrint "OUT4" };
         return;
     };
 */
@@ -57,7 +57,7 @@ actor A {
             await m();
             break out;
         }
-        case { debugPrint "OUT5" };
+        finally { debugPrint "OUT5" };
     };
 
     // TODO: trap on happy/catch

From eb4c53c63947f5553d39635f9bd44c4f5a6392d3 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 7 Jun 2024 12:56:17 +0200
Subject: [PATCH 068/179] fix `ICCallRawPrim` and remove some obsolete changes

---
 src/codegen/compile.ml             | 16 +++++++++-------
 src/ir_def/arrange_ir.ml           |  2 +-
 src/ir_def/check_ir.ml             | 15 ++++++++-------
 src/ir_def/construct.ml            |  8 ++++----
 src/ir_def/ir.ml                   |  4 ++--
 src/ir_interpreter/interpret_ir.ml |  2 +-
 6 files changed, 25 insertions(+), 22 deletions(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index 93991dbf5a7..966bc4bf4bd 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -11790,7 +11790,7 @@ and compile_prim_invocation (env : E.t) ae p es at =
   | ICCallerPrim, [] ->
     SR.Vanilla, IC.caller env
 
-  | ICCallPrim _, [f;e;k;r;c] ->
+  | ICCallPrim, [f;e;k;r;c] ->
     SR.unit, begin
     (* TBR: Can we do better than using the notes? *)
     let _, _, _, ts1, _ = Type.as_func f.note.Note.typ in
@@ -11808,12 +11808,13 @@ and compile_prim_invocation (env : E.t) ae p es at =
     compile_exp_vanilla env ae c ^^ set_c ^^
     FuncDec.ic_call env ts1 ts2 get_meth_pair get_arg get_k get_r get_c add_cycles
     end
-  | ICCallRawPrim, [p;m;a;k;r] ->
+  | ICCallRawPrim, [p;m;a;k;r;c] ->
     SR.unit, begin
-    let (set_meth_pair, get_meth_pair) = new_local env "meth_pair" in
-    let (set_arg, get_arg) = new_local env "arg" in
-    let (set_k, get_k) = new_local env "k" in
-    let (set_r, get_r) = new_local env "r" in
+    let set_meth_pair, get_meth_pair = new_local env "meth_pair" in
+    let set_arg, get_arg = new_local env "arg" in
+    let set_k, get_k = new_local env "k" in
+    let set_r, get_r = new_local env "r" in
+    let set_c, get_c = new_local env "c" in
     let add_cycles = Internals.add_cycles env ae in
     compile_exp_vanilla env ae p ^^
     compile_exp_vanilla env ae m ^^ Text.to_blob env ^^
@@ -11822,7 +11823,8 @@ and compile_prim_invocation (env : E.t) ae p es at =
     compile_exp_vanilla env ae a ^^ set_arg ^^
     compile_exp_vanilla env ae k ^^ set_k ^^
     compile_exp_vanilla env ae r ^^ set_r ^^
-    FuncDec.ic_call_raw env get_meth_pair get_arg get_k get_r get_r(*FIXME*) add_cycles
+    compile_exp_vanilla env ae c ^^ set_c ^^
+    FuncDec.ic_call_raw env get_meth_pair get_arg get_k get_r get_c add_cycles
     end
 
   | ICMethodNamePrim, [] ->
diff --git a/src/ir_def/arrange_ir.ml b/src/ir_def/arrange_ir.ml
index 5ae3c71db08..6c3e747a293 100644
--- a/src/ir_def/arrange_ir.ml
+++ b/src/ir_def/arrange_ir.ml
@@ -111,7 +111,7 @@ and prim = function
   | ICReplyPrim ts    -> "ICReplyPrim" $$ List.map typ ts
   | ICRejectPrim      -> Atom "ICRejectPrim"
   | ICCallerPrim      -> Atom "ICCallerPrim"
-  | ICCallPrim _      -> Atom "ICCallPrim"
+  | ICCallPrim        -> Atom "ICCallPrim"
   | ICCallRawPrim     -> Atom "ICCallRawPrim"
   | ICMethodNamePrim  -> Atom "ICMethodNamePrim"
   | ICStableWrite t   -> "ICStableWrite" $$ [typ t]
diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 43ce95837f5..3b0035d0160 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -594,28 +594,29 @@ let rec check_exp env (exp:Ir.exp) : unit =
       T.Non <: t
     | ICCallerPrim, [] ->
       T.caller <: t
-    | ICCallPrim _, [exp1; exp2; k; r; c] ->
+    | ICCallPrim, [exp1; exp2; k; r; c] ->
       let t1 = T.promote (typ exp1) in
       begin match t1 with
       | T.Func (sort, T.Replies, _ (*TBR*), arg_tys, ret_tys) ->
         let t_arg = T.seq arg_tys in
         typ exp2 <: t_arg;
         check_concrete env exp.at t_arg;
-        typ k <: T.Func (T.Local, T.Returns, [], ret_tys, []);
-        typ r <: T.Func (T.Local, T.Returns, [], [T.error], []);
-        typ c <: T.Func (T.Local, T.Returns, [], [T.nat32], []);
+        typ k <: T.(Func (Local, Returns, [], ret_tys, []));
+        typ r <: T.(Func (Local, Returns, [], [error], []));
+        typ c <: T.(Func (Local, Returns, [], [nat32(*FIXME*)], []));
       | T.Non -> () (* dead code, not much to check here *)
       | _ ->
          error env exp1.at "expected function type, but expression produces type\n  %s"
            (T.string_of_typ_expand t1)
       end
       (* TODO: T.unit <: t ? *)
-    | ICCallRawPrim, [exp1; exp2; exp3; k; r] ->
+    | ICCallRawPrim, [exp1; exp2; exp3; k; r; c] ->
       typ exp1 <: T.principal;
       typ exp2 <: T.text;
       typ exp3 <: T.blob;
-      typ k <: T.Func (T.Local, T.Returns, [], [T.blob], []);
-      typ r <: T.Func (T.Local, T.Returns, [], [T.error], []);
+      typ k <: T.(Func (Local, Returns, [], [blob], []));
+      typ r <: T.(Func (Local, Returns, [], [error], []));
+      typ c <: T.(Func (Local, Returns, [], [nat32(*FIXME*)], []));
       T.unit <: t
     | ICMethodNamePrim, [] ->
       T.text <: t
diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 225a3cfdf3a..63bbc100a21 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -185,15 +185,15 @@ let ic_rejectE e =
 let ic_callE f e k r c =
   let es = [f; e; k; r; c] in
   let eff = List.(map eff es |> fold_left max_eff T.Triv) in
-  { it = PrimE (ICCallPrim (Option.map id_of_var None(*FIXME: revert*)), es);
+  { it = PrimE (ICCallPrim, es);
     at = no_region;
     note = Note.{ def with typ = T.unit; eff }
   }
 
-let ic_call_rawE p m a k r c = (* FIXME *)
-  let es = [p; m; a; k; r] in
+let ic_call_rawE p m a k r c =
+  let es = [p; m; a; k; r; c] in
   let eff = List.(map eff es |> fold_left max_eff T.Triv) in
-  { it = PrimE (ICCallRawPrim (*c*), es);
+  { it = PrimE (ICCallRawPrim, es);
     at = no_region;
     note = Note.{ def with typ = T.unit; eff }
   }
diff --git a/src/ir_def/ir.ml b/src/ir_def/ir.ml
index d08658dfc4f..c8cf014992f 100644
--- a/src/ir_def/ir.ml
+++ b/src/ir_def/ir.ml
@@ -168,7 +168,7 @@ and prim =
   | ICReplyPrim of Type.typ list
   | ICRejectPrim
   | ICCallerPrim
-  | ICCallPrim of id option
+  | ICCallPrim
   | ICCallRawPrim
   | ICMethodNamePrim
   | ICArgDataPrim
@@ -307,7 +307,7 @@ let map_prim t_typ t_id p =
   | ICPerformGC
   | ICRejectPrim
   | ICCallerPrim
-  | ICCallPrim _
+  | ICCallPrim
   | ICCallRawPrim
   | ICMethodNamePrim -> p
   | ICStableWrite t -> ICStableWrite (t_typ t)
diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index b18105971d8..c077e089c80 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -446,7 +446,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
         let reject = Option.get env.rejects in
         let e = V.Tup [V.Variant ("canister_reject", V.unit); v1] in
         Scheduler.queue (fun () -> reject e)
-      | ICCallPrim _, [v1; v2; kv; rv; _(*FIXME*)] ->
+      | ICCallPrim, [v1; v2; kv; rv; _cv(*FIXME*)] ->
         let call_conv, f = V.as_func v1 in
         check_call_conv (List.hd es) call_conv;
         check_call_conv_arg env exp v2 call_conv;

From a9e84d155d8b46efadcbbbb3265c8fe52ef7570b Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 7 Jun 2024 13:30:21 +0200
Subject: [PATCH 069/179] new keyword

---
 emacs/motoko-mode.el | 1 +
 src/idllib/escape.ml | 1 +
 2 files changed, 2 insertions(+)

diff --git a/emacs/motoko-mode.el b/emacs/motoko-mode.el
index af0aebac1cb..2ca96a52c87 100644
--- a/emacs/motoko-mode.el
+++ b/emacs/motoko-mode.el
@@ -47,6 +47,7 @@
                  "debug"
                  "debug_show"
                  "else"
+                 "finally"
                  "flexible"
                  "for"
                  "from_candid"
diff --git a/src/idllib/escape.ml b/src/idllib/escape.ml
index c5dc2e2aa8b..c2004010b23 100644
--- a/src/idllib/escape.ml
+++ b/src/idllib/escape.ml
@@ -73,6 +73,7 @@ let is_motoko_keyword = function
   | "do"
   | "else"
   | "false"
+  | "finally"
   | "flexible"
   | "for"
   | "from_candid"

From 88b3a7ea5af7a6f3ffe3b3ed4904cc9085ee646a Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 7 Jun 2024 13:32:39 +0200
Subject: [PATCH 070/179] add test for raw

---
 test/run-drun/try-finally.mo | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 18be95bd1be..65706c5bc7f 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -1,14 +1,23 @@
-import { debugPrint; error } =  "mo:prim";
+import { debugPrint; error; call_raw; principalOfActor } =  "mo:⛔";
 
 actor A {
     func m() : async () {
     };
 
+    public func raw() : async () {
+    };
+
     func t0() : async () {
         try { debugPrint "IN"; await m(); assert false }
         finally { debugPrint "OUT" };
     };
 
+    func t0r() : async () {
+        let p = principalOfActor A;
+        try { debugPrint "INr"; ignore await call_raw(p, "raw", to_candid()); assert false }
+        finally { debugPrint "OUTr" };
+    };
+
 /*  nested `try` won't work
     func t1() : async () {
         try {
@@ -83,7 +92,8 @@ actor A {
     // TODO: trap on happy/catch
 
     public func go() : async () {
-        /*ignore*/ await t0();
+        try /*ignore*/ await t0() catch _ {};
+        try await t0r() catch _ {};
         //await t1();
         /*await t2();
         await t3();

From 0b5cfeba55fc4ba22dff462b0a9efdd24784c8ac Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 7 Jun 2024 13:44:58 +0200
Subject: [PATCH 071/179] enable `t6` again

---
 test/run-drun/try-finally.mo | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 65706c5bc7f..b3af1ffc693 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -71,7 +71,7 @@ actor A {
         finally { debugPrint "OUT5" };
         debugPrint "AFTER5"
     };
-
+*/
     func t6() : async () {
         debugPrint "BEFORE6";
         label out try {
@@ -88,8 +88,9 @@ actor A {
         finally { debugPrint "OUT6" };
         debugPrint "AFTER6"
     };
-*/
+
     // TODO: trap on happy/catch
+    // TODO: trap after repeated `await`
 
     public func go() : async () {
         try /*ignore*/ await t0() catch _ {};
@@ -98,8 +99,8 @@ actor A {
         /*await t2();
         await t3();
         /*await t4();*/
-        await t5();
-        await t6();*/
+        await t5();*/
+        await t6();
     };
 };
 

From 38ebdacbf035bd798f98d297c2b7610265b35966 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Sat, 8 Jun 2024 13:55:31 +0200
Subject: [PATCH 072/179] WIP: cover the "trap after second `await`" case

---
 src/ir_passes/async.ml   |  3 +--
 src/prelude/internals.mo | 20 +++++++++++++++++---
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 1ec049e3e97..b64a2c6df63 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -267,10 +267,9 @@ let transform prog =
                   (* try await async (); schedule() catch e -> r(e) *)
                  (let v = fresh_var "call" T.unit in
                   let n = fresh_var "nat" T.nat32 in
-                  let shoutT = T.(Func (Local, Returns, [], [], [])) in
                   letE v
                   (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1)
-                     ([n] -->* (varE (var "@shout" shoutT) -*- unitE ())(*projE (varE vkrc) 2*)))
+                     ([n] -->* (projE (varE vkrc) 2 -*- varE (var "@FIXME_err" T.error) )))
                     (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
               ]
               T.unit
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index eadc88e614a..96872750453 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -308,7 +308,22 @@ func @getSystemRefund() : @Refund {
 };
 
 func @shout() = (prim "print" : Text -> ()) "CLEANUP";
-func @shout2(_ : Error) = (prim "print" : Text -> ()) "CLEANUP_E";
+
+let @FIXME_err = (prim "cast" : ({#call_error : {err_code : Nat32}}, Text) -> Error) (#call_error {err_code = 0 : Nat32}, "HAHA");
+func @shout2(e : Error) {
+    type ErrorCode = {
+        #system_fatal;
+        #system_transient;
+        #destination_invalid;
+        #canister_reject;
+        #canister_error;
+        #future : Nat32;
+        #call_error : { err_code : Nat32 };
+    };
+    func errorCode(e : Error) : ErrorCode = ((prim "cast" : Error -> (ErrorCode, Text)) e).0;
+    assert errorCode @FIXME_err == errorCode e;
+    (prim "print" : Text -> ()) "CLEANUP_E"
+};
 
 func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>) {
   let w_null = func(r : @Refund, t : T) { };
@@ -350,8 +365,7 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>)
   func clean(_ : Nat32) {
     (prim "print" : Text -> ()) "EXTERN";
 
-    cleanup ((prim "cast" : ({#call_error : {err_code : Nat32}}, Text) -> Error)
-    (#call_error {err_code = 0 : Nat32}, "HAHA"));
+    cleanup @FIXME_err;
   };
 
   func enqueue(k : @Cont<T>, r : @Cont<Error>, c : @Cont<Error/*FIXME: unit*/>) : {

From f5ed26b4d9dadd54bb987480d8b4a172b901f0e0 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 10 Jun 2024 12:16:57 +0200
Subject: [PATCH 073/179] add `t0d` test which exercises the double-`await`
 codegen

---
 test/run-drun/try-finally.mo | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index b3af1ffc693..5dc39493a61 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -18,6 +18,11 @@ actor A {
         finally { debugPrint "OUTr" };
     };
 
+    func t0d() : async () {
+        try { debugPrint "INd"; let fut = m(); await fut; debugPrint "AGAINd"; await fut; assert false }
+        finally { debugPrint "OUTd" };
+    };
+
 /*  nested `try` won't work
     func t1() : async () {
         try {
@@ -95,6 +100,7 @@ actor A {
     public func go() : async () {
         try /*ignore*/ await t0() catch _ {};
         try await t0r() catch _ {};
+        try await t0d() catch _ {};
         //await t1();
         /*await t2();
         await t3();

From fe343c15c6038a660263798594598fc891e90ac2 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 10 Jun 2024 13:45:30 +0200
Subject: [PATCH 074/179] improve comment

---
 src/ir_passes/await.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index b4ac88dcb68..2f6191165b3 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -50,7 +50,7 @@ let precont k thunk =
   | MetaCont (typ, cont) ->
     MetaCont (typ, fun v -> finally (cont v))
 
-(* Named labels for break, special labels for return and throw *)
+(* Named labels for break, special labels for return, throw and cleanup *)
 type label = Return | Throw | Cleanup | Named of string
 
 let ( -@- ) k exp2 =

From 5cc86c6dbf6c7710d155ed96d4cb26cd2a482e82 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 11 Jun 2024 15:02:40 +0200
Subject: [PATCH 075/179] add negative testcase

---
 test/fail/ok/try-finally.tc.ok     |  4 ++++
 test/fail/ok/try-finally.tc.ret.ok |  1 +
 test/fail/try-finally.mo           | 16 ++++++++++++++++
 3 files changed, 21 insertions(+)
 create mode 100644 test/fail/ok/try-finally.tc.ok
 create mode 100644 test/fail/ok/try-finally.tc.ret.ok
 create mode 100644 test/fail/try-finally.mo

diff --git a/test/fail/ok/try-finally.tc.ok b/test/fail/ok/try-finally.tc.ok
new file mode 100644
index 00000000000..4ebd750ef30
--- /dev/null
+++ b/test/fail/ok/try-finally.tc.ok
@@ -0,0 +1,4 @@
+try-finally.mo:14.19-14.21: type error [M0050], literal of type
+  Nat
+does not have expected type
+  ()
diff --git a/test/fail/ok/try-finally.tc.ret.ok b/test/fail/ok/try-finally.tc.ret.ok
new file mode 100644
index 00000000000..69becfa16f9
--- /dev/null
+++ b/test/fail/ok/try-finally.tc.ret.ok
@@ -0,0 +1 @@
+Return code 1
diff --git a/test/fail/try-finally.mo b/test/fail/try-finally.mo
new file mode 100644
index 00000000000..57095257f6e
--- /dev/null
+++ b/test/fail/try-finally.mo
@@ -0,0 +1,16 @@
+actor A {
+    func m() : async () {
+    };
+
+    func _t0() : async () {
+        try { await m() }
+        else catch _ {}
+        finally { ignore m() } // BAD: no effects allowed!
+    };
+
+    func _t1() : async () {
+        try { await m() }
+        else catch _ {}
+        finally { 42 } // BAD: should return unit.
+    }
+}

From 4a62db7fa229c935228fd5060a5c98bad82ec3a0 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 11 Jun 2024 15:25:56 +0200
Subject: [PATCH 076/179] add error for messaging from `finally`

---
 src/lang_utils/error_codes.ml       |  1 +
 src/lang_utils/error_codes/M0199.md | 13 +++++++++++++
 src/mo_frontend/typing.ml           |  5 ++++-
 test/fail/ok/try-finally.tc.ok      |  1 +
 test/fail/try-finally.mo            |  2 ++
 5 files changed, 21 insertions(+), 1 deletion(-)
 create mode 100644 src/lang_utils/error_codes/M0199.md

diff --git a/src/lang_utils/error_codes.ml b/src/lang_utils/error_codes.ml
index 71bcb2272ce..bbe8844b148 100644
--- a/src/lang_utils/error_codes.ml
+++ b/src/lang_utils/error_codes.ml
@@ -202,4 +202,5 @@ let error_codes : (string * string option) list =
     "M0196", None; (* `system` capability supplied but not required *)
     "M0197", Some([%blob "lang_utils/error_codes/M0197.md"]); (* `system` capability required *)
     "M0198", Some([%blob "lang_utils/error_codes/M0198.md"]); (* Unused field pattern warning *)
+    "M0199", Some([%blob "lang_utils/error_codes/M0199.md"]); (* Cleanup clause must have trivial effect *)
   ]
diff --git a/src/lang_utils/error_codes/M0199.md b/src/lang_utils/error_codes/M0199.md
new file mode 100644
index 00000000000..b6193fcefda
--- /dev/null
+++ b/src/lang_utils/error_codes/M0199.md
@@ -0,0 +1,13 @@
+# M0199
+
+If you get this error then you are trying to message from
+the `finally` clause of a `try` block.
+
+`finally` clauses are generally used to clean up local state
+in the event of messaging failures, and are especially invoked when
+the code doing the result processing traps. In this last-resort cleanup
+only local manipulations are allowed to (e.g.) release locks and thus
+prevent the canister from ending up in a stuck state.
+
+Should you encounter this error, so make sure that you move all messaging
+code out of the `finally` block.
diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml
index 759b159fd25..1cb9e7e1785 100644
--- a/src/mo_frontend/typing.ml
+++ b/src/mo_frontend/typing.ml
@@ -1828,7 +1828,10 @@ and check_exp' env0 t exp : T.typ =
     if not env.pre then
       begin match exp2_opt with
       | None -> ()
-      | Some exp2 -> check_exp_strong env T.unit exp2
+      | Some exp2 ->
+        check_exp_strong env T.unit exp2;
+        if exp2.note.note_eff <> T.Triv then
+          local_error env exp2.at "M0199" "a cleanup clause must not send messages";
       end;
     t
   (* TODO: allow shared with one scope par *)
diff --git a/test/fail/ok/try-finally.tc.ok b/test/fail/ok/try-finally.tc.ok
index 4ebd750ef30..aed3512ffc5 100644
--- a/test/fail/ok/try-finally.tc.ok
+++ b/test/fail/ok/try-finally.tc.ok
@@ -1,3 +1,4 @@
+try-finally.mo:8.17-8.31: type error [M0199], a cleanup clause must not send messages
 try-finally.mo:14.19-14.21: type error [M0050], literal of type
   Nat
 does not have expected type
diff --git a/test/fail/try-finally.mo b/test/fail/try-finally.mo
index 57095257f6e..708b6ee8a80 100644
--- a/test/fail/try-finally.mo
+++ b/test/fail/try-finally.mo
@@ -13,4 +13,6 @@ actor A {
         else catch _ {}
         finally { 42 } // BAD: should return unit.
     }
+
+    // TODO: Nat resulting `try`
 }

From 2d6e27e3583bbb785f3273e7939b13debacd4299 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 11 Jun 2024 15:40:32 +0200
Subject: [PATCH 077/179] another fixme

---
 src/mo_frontend/parser.mly | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly
index 76ba6529b1f..0bf5a9582ec 100644
--- a/src/mo_frontend/parser.mly
+++ b/src/mo_frontend/parser.mly
@@ -711,7 +711,7 @@ exp_un(B) :
     { TryE(e1, [c], None) @? at $sloc }
   | TRY e1=exp_nest FINALLY e2=exp_nest (* FIXME: needs a different keyword (`DO`?), provisional *)
     { TryE(e1, [], Some e2) @? at $sloc }
-  | TRY e1=exp_nest ELSE c=catch FINALLY e2=exp_nest
+  | TRY e1=exp_nest ELSE c=catch FINALLY e2=exp_nest (* FIXME: elim `else`*)
     { TryE(e1, [c], Some e2) @? at $sloc }
 (* TODO: enable multi-branch TRY (already supported by compiler)
   | TRY e=exp_nest LCURLY cs=seplist(case, semicolon) RCURLY

From 1ef333e34e3bf9e66e4d20ee44c9facc5042f498 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 11 Jun 2024 16:16:49 +0200
Subject: [PATCH 078/179] fix

---
 src/ir_def/check_ir.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 3b0035d0160..d56aa396a25 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -728,7 +728,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
     typ exp1 <: t;
     check_cases env T.catch t cases;
     Option.iter (check_exp env) exp2;
-  (*Option.iter (fun exp2 -> typ exp2 <: TODO: T.unit->unit) exp2;*)
+    Option.iter (fun exp2 -> typ exp2 <: T.(Func (Local, Returns, [], [], []))) exp2
   | LoopE exp1 ->
     check_exp { env with lvl = NotTopLvl } exp1;
     typ exp1 <: T.unit;

From f440e291866a9452072a17a01520587900f6d50d Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 11 Jun 2024 16:20:00 +0200
Subject: [PATCH 079/179] fix a syntax quirk

---
 doc/md/examples/grammar.txt  |  2 +-
 src/mo_frontend/parser.mly   | 10 +++++-----
 test/fail/try-finally.mo     |  4 ++--
 test/run-drun/try-finally.mo |  2 +-
 4 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/doc/md/examples/grammar.txt b/doc/md/examples/grammar.txt
index f73ca82ddba..24440c86f9e 100644
--- a/doc/md/examples/grammar.txt
+++ b/doc/md/examples/grammar.txt
@@ -217,8 +217,8 @@
     'if' <exp_nullary> <exp_nest>
     'if' <exp_nullary> <exp_nest> 'else' <exp_nest>
     'try' <exp_nest> <catch>
+    'try' <exp_nest> <catch> 'finally' <exp_nest>
     'try' <exp_nest> 'finally' <exp_nest>
-    'try' <exp_nest> 'else' <catch> 'finally' <exp_nest>
     'throw' <exp_nest>
     'switch' <exp_nullary> '{' <list(<case>, ';')> '}'
     'while' <exp_nullary> <exp_nest>
diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly
index 0bf5a9582ec..b68836d5660 100644
--- a/src/mo_frontend/parser.mly
+++ b/src/mo_frontend/parser.mly
@@ -244,8 +244,8 @@ and objblock s ty dec_fields =
 
 %nonassoc IMPLIES (* see assertions.mly *)
 
-%nonassoc RETURN_NO_ARG IF_NO_ELSE LOOP_NO_WHILE
-%nonassoc ELSE WHILE
+%nonassoc RETURN_NO_ARG IF_NO_ELSE LOOP_NO_WHILE TRY_CATCH_NO_FINALLY
+%nonassoc ELSE WHILE FINALLY
 
 %left COLON
 %left PIPE
@@ -707,12 +707,12 @@ exp_un(B) :
     { IfE(b, e1, TupE([]) @? at $sloc) @? at $sloc }
   | IF b=exp_nullary(ob) e1=exp_nest ELSE e2=exp_nest
     { IfE(b, e1, e2) @? at $sloc }
-  | TRY e1=exp_nest c=catch
+  | TRY e1=exp_nest c=catch %prec TRY_CATCH_NO_FINALLY
     { TryE(e1, [c], None) @? at $sloc }
+  | TRY e1=exp_nest c=catch FINALLY e2=exp_nest
+    { TryE(e1, [c], Some e2) @? at $sloc }
   | TRY e1=exp_nest FINALLY e2=exp_nest (* FIXME: needs a different keyword (`DO`?), provisional *)
     { TryE(e1, [], Some e2) @? at $sloc }
-  | TRY e1=exp_nest ELSE c=catch FINALLY e2=exp_nest (* FIXME: elim `else`*)
-    { TryE(e1, [c], Some e2) @? at $sloc }
 (* TODO: enable multi-branch TRY (already supported by compiler)
   | TRY e=exp_nest LCURLY cs=seplist(case, semicolon) RCURLY
     { TryE(e, cs) @? at $sloc }
diff --git a/test/fail/try-finally.mo b/test/fail/try-finally.mo
index 708b6ee8a80..20cb05857e3 100644
--- a/test/fail/try-finally.mo
+++ b/test/fail/try-finally.mo
@@ -4,13 +4,13 @@ actor A {
 
     func _t0() : async () {
         try { await m() }
-        else catch _ {}
+        catch _ {}
         finally { ignore m() } // BAD: no effects allowed!
     };
 
     func _t1() : async () {
         try { await m() }
-        else catch _ {}
+        catch _ {}
         finally { 42 } // BAD: should return unit.
     }
 
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 5dc39493a61..ceaf3030233 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -41,7 +41,7 @@ actor A {
             debugPrint "IN2";
             throw error "IN2";
         }
-        else catch _ { debugPrint "CAUGHT2" }
+        catch _ { debugPrint "CAUGHT2" }
         finally { debugPrint "OUT2" };
     };
 

From 027430e040354abb8c4b42d0cca80679e66b02ec Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 11 Jun 2024 16:58:58 +0200
Subject: [PATCH 080/179] remove obsolete

---
 test/run/ok/try-finally.diff-ir.ok  | 11 ----
 test/run/ok/try-finally.diff-low.ok | 11 ----
 test/run/ok/try-finally.run-ir.ok   |  9 ----
 test/run/ok/try-finally.run-low.ok  |  9 ----
 test/run/ok/try-finally.run.ok      | 11 ----
 test/run/ok/try-finally.tc.ok       | 16 ------
 test/run/try-finally.mo             | 78 -----------------------------
 7 files changed, 145 deletions(-)
 delete mode 100644 test/run/ok/try-finally.diff-ir.ok
 delete mode 100644 test/run/ok/try-finally.diff-low.ok
 delete mode 100644 test/run/ok/try-finally.run-ir.ok
 delete mode 100644 test/run/ok/try-finally.run-low.ok
 delete mode 100644 test/run/ok/try-finally.run.ok
 delete mode 100644 test/run/ok/try-finally.tc.ok
 delete mode 100644 test/run/try-finally.mo

diff --git a/test/run/ok/try-finally.diff-ir.ok b/test/run/ok/try-finally.diff-ir.ok
deleted file mode 100644
index 1f62330c482..00000000000
--- a/test/run/ok/try-finally.diff-ir.ok
+++ /dev/null
@@ -1,11 +0,0 @@
---- try-finally.run
-+++ try-finally.run-ir
-@@ -4,8 +4,6 @@
- CAUGHT2
- OUT2
- IN3
--OUT3
- IN4
- OUT4
- IN5
--OUT5
diff --git a/test/run/ok/try-finally.diff-low.ok b/test/run/ok/try-finally.diff-low.ok
deleted file mode 100644
index e5d11e46a92..00000000000
--- a/test/run/ok/try-finally.diff-low.ok
+++ /dev/null
@@ -1,11 +0,0 @@
---- try-finally.run
-+++ try-finally.run-low
-@@ -4,8 +4,6 @@
- CAUGHT2
- OUT2
- IN3
--OUT3
- IN4
- OUT4
- IN5
--OUT5
diff --git a/test/run/ok/try-finally.run-ir.ok b/test/run/ok/try-finally.run-ir.ok
deleted file mode 100644
index ac636903336..00000000000
--- a/test/run/ok/try-finally.run-ir.ok
+++ /dev/null
@@ -1,9 +0,0 @@
-IN
-OUT
-IN2
-CAUGHT2
-OUT2
-IN3
-IN4
-OUT4
-IN5
diff --git a/test/run/ok/try-finally.run-low.ok b/test/run/ok/try-finally.run-low.ok
deleted file mode 100644
index ac636903336..00000000000
--- a/test/run/ok/try-finally.run-low.ok
+++ /dev/null
@@ -1,9 +0,0 @@
-IN
-OUT
-IN2
-CAUGHT2
-OUT2
-IN3
-IN4
-OUT4
-IN5
diff --git a/test/run/ok/try-finally.run.ok b/test/run/ok/try-finally.run.ok
deleted file mode 100644
index 977a2a770df..00000000000
--- a/test/run/ok/try-finally.run.ok
+++ /dev/null
@@ -1,11 +0,0 @@
-IN
-OUT
-IN2
-CAUGHT2
-OUT2
-IN3
-OUT3
-IN4
-OUT4
-IN5
-OUT5
diff --git a/test/run/ok/try-finally.tc.ok b/test/run/ok/try-finally.tc.ok
deleted file mode 100644
index 771c58b98be..00000000000
--- a/test/run/ok/try-finally.tc.ok
+++ /dev/null
@@ -1,16 +0,0 @@
-try-finally.mo:6.9-7.34: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:31.9-35.35: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:40.9-43.35: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:48.19-52.35: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
diff --git a/test/run/try-finally.mo b/test/run/try-finally.mo
deleted file mode 100644
index 99246f37dae..00000000000
--- a/test/run/try-finally.mo
+++ /dev/null
@@ -1,78 +0,0 @@
-import { debugPrint; error } =  "mo:prim";
-
-actor A {
-    func m() : async () {
-    };
-    
-
-    func t0() : async () {
-        try { debugPrint "IN"; await m(); }
-        finally { debugPrint "OUT" };
-    };
-
-/*  nested `try` won't work
-    func t1() : async () {
-        try {
-            try {
-                debugPrint "IN1";
-                throw error "IN1";
-            }
-            finally { debugPrint "OUT1" };
-        }
-        catch _ { debugPrint "CAUGHT1" }
-    };
-*/
-/*
-    func t2() : async () {
-        try {
-            debugPrint "IN2";
-            throw error "IN2";
-        }
-        else catch _ { debugPrint "CAUGHT2" }
-        finally { debugPrint "OUT2" };
-    };
-
-    //TODO: func t2t() : async Int { ... }
-
-    func t3() : async () {
-        try {
-            debugPrint "IN3";
-            return;
-        }
-        finally { debugPrint "OUT3" };
-    };
-
-    // check that finally not running twice
-    func t4() : async () {
-        try {
-            debugPrint "IN4";
-        }
-        finally { debugPrint "OUT4" };
-        return;
-    };
-*/
-    func t5() : async () {
-        label out try {
-            debugPrint "IN5";
-            await m();
-            break out;
-        }
-        finally { debugPrint "OUT5" };
-    };
-
-    // TODO: trap on happy/catch
-
-    public func go() : async () {
-        /*ignore*/ await t0();
-        //await t1();
-        /*await t2();
-        await t3();
-        await t4();*/
-        await t5();
-    };
-};
-
-//XSKIP comp
-//SKIP ic-ref-run
-
-A.go();

From 2ff67b064658152de76a3a95ccc6d07ebab5f060 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 12 Jun 2024 13:03:38 +0200
Subject: [PATCH 081/179] accept

---
 test/run-drun/ok/try-finally.diff-ir.ok  | 18 ------------------
 test/run-drun/ok/try-finally.drun-run.ok | 19 ++++++++++---------
 test/run-drun/ok/try-finally.run-ir.ok   | 14 --------------
 test/run-drun/ok/try-finally.run-low.ok  | 24 ++++++------------------
 test/run-drun/ok/try-finally.run.ok      | 18 ------------------
 test/run-drun/ok/try-finally.tc.ok       | 11 ++++++-----
 6 files changed, 22 insertions(+), 82 deletions(-)
 delete mode 100644 test/run-drun/ok/try-finally.diff-ir.ok
 delete mode 100644 test/run-drun/ok/try-finally.run-ir.ok
 delete mode 100644 test/run-drun/ok/try-finally.run.ok

diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
deleted file mode 100644
index 19c96dd36d8..00000000000
--- a/test/run-drun/ok/try-finally.diff-ir.ok
+++ /dev/null
@@ -1,18 +0,0 @@
---- try-finally.run
-+++ try-finally.run-ir
-@@ -4,15 +4,11 @@
- CAUGHT2
- OUT2
- IN3
--OUT3
- BEFORE5
- IN5
--OUT5
- AFTER5
- BEFORE6
- IN6
- InnerIN6
- InnerLIVE6
--InnerOUT6
--OUT6
- AFTER6
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index e98009c7de8..fe81e763d18 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -1,16 +1,17 @@
 ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
 ingress Completed: Reply: 0x4449444c0000
 debug.print: IN
+debug.print: EXTERN
 debug.print: OUT
-debug.print: IN2
-debug.print: CAUGHT2
-debug.print: OUT2
-debug.print: IN3
-debug.print: OUT3
-debug.print: BEFORE5
-debug.print: IN5
-debug.print: OUT5
-debug.print: AFTER5
+debug.print: CLEANUP_E
+debug.print: INr
+debug.print: EXTERN
+debug.print: OUTr
+debug.print: CLEANUP_E
+debug.print: INd
+debug.print: AGAINd
+debug.print: OUTd
+debug.print: CLEANUP_E
 debug.print: BEFORE6
 debug.print: IN6
 debug.print: InnerIN6
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
deleted file mode 100644
index 1f770a7e031..00000000000
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ /dev/null
@@ -1,14 +0,0 @@
-IN
-OUT
-IN2
-CAUGHT2
-OUT2
-IN3
-BEFORE5
-IN5
-AFTER5
-BEFORE6
-IN6
-InnerIN6
-InnerLIVE6
-AFTER6
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index 1129288641e..13a5de2468b 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -1,18 +1,6 @@
-IN
-OUT
-IN2
-CAUGHT2
-OUT2
-IN3
-OUT3
-BEFORE5
-IN5
-OUT5
-AFTER5
-BEFORE6
-IN6
-InnerIN6
-InnerLIVE6
-InnerOUT6
-OUT6
-AFTER6
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/2/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/2/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
deleted file mode 100644
index 1129288641e..00000000000
--- a/test/run-drun/ok/try-finally.run.ok
+++ /dev/null
@@ -1,18 +0,0 @@
-IN
-OUT
-IN2
-CAUGHT2
-OUT2
-IN3
-OUT3
-BEFORE5
-IN5
-OUT5
-AFTER5
-BEFORE6
-IN6
-InnerIN6
-InnerLIVE6
-InnerOUT6
-OUT6
-AFTER6
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 1a29a98acff..9bb9362dc26 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -1,20 +1,21 @@
-try-finally.mo:9.9-10.34: warning [M0145], this try handler of type
+try-finally.mo:11.9-12.37: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:38.9-43.35: warning [M0145], this try handler of type
+try-finally.mo:17.9-18.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:57.19-63.35: warning [M0145], this try handler of type
+try-finally.mo:22.9-23.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:71.13-77.46: warning [M0145], this try handler of type
+try-finally.mo:84.13-90.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:69.19-80.35: warning [M0145], this try handler of type
+try-finally.mo:82.19-93.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
+try-finally.mo:1.22-1.27: warning [M0198], unused field error in object pattern (delete or rewrite as `error = _`)

From fe5e6af344671a441eacd60c70f1c1c9d40c311a Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 12 Jun 2024 13:11:58 +0200
Subject: [PATCH 082/179] add tests for nested last-resort cleanups

---
 test/run-drun/ok/try-finally.drun-run.ok | 16 ++++++++++
 test/run-drun/ok/try-finally.run-low.ok  | 12 ++++++++
 test/run-drun/ok/try-finally.tc.ok       | 16 ++++++++++
 test/run-drun/try-finally.mo             | 39 ++++++++++++++++++++++++
 4 files changed, 83 insertions(+)

diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index fe81e763d18..5bc606b22a3 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -19,4 +19,20 @@ debug.print: InnerLIVE6
 debug.print: InnerOUT6
 debug.print: OUT6
 debug.print: AFTER6
+debug.print: BEFORE6t
+debug.print: IN6t
+debug.print: InnerIN6t
+debug.print: InnerLIVE6t
+debug.print: EXTERN
+debug.print: InnerOUT6t
+debug.print: OUT6t
+debug.print: CLEANUP_E
+debug.print: BEFORE6d
+debug.print: IN6d
+debug.print: InnerIN6d
+debug.print: InnerLIVE6d
+debug.print: InnerLIVESTILL6d
+debug.print: InnerOUT6d
+debug.print: OUT6d
+debug.print: CLEANUP_E
 ingress Completed: Reply: 0x4449444c0000
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index 13a5de2468b..d6f7986e49b 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -4,3 +4,15 @@ IR has aliasing (or Check_ir visits nodes twice):
 (VarE $$thunk/2/0)
 IR has aliasing (or Check_ir visits nodes twice):
 (PrimE TupPrim)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/8/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/8/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/7/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/7/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 9bb9362dc26..c70fb6898b9 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -18,4 +18,20 @@ try-finally.mo:82.19-93.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
+try-finally.mo:101.13-107.50: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:99.19-110.39: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:118.13-127.50: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:116.19-130.39: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
 try-finally.mo:1.22-1.27: warning [M0198], unused field error in object pattern (delete or rewrite as `error = _`)
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index ceaf3030233..70571d53dc7 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -94,6 +94,43 @@ actor A {
         debugPrint "AFTER6"
     };
 
+    func t6t() : async () {
+        debugPrint "BEFORE6t";
+        label out try {
+            debugPrint "IN6t";
+            try {
+                debugPrint "InnerIN6t";
+                await m();
+                debugPrint "InnerLIVE6t";
+                assert false;
+                debugPrint "InnerDEAD6t";
+            } finally { debugPrint "InnerOUT6t" };
+            debugPrint "DEAD6t";
+        }
+        finally { debugPrint "OUT6t" };
+        debugPrint "AFTER6t"
+    };
+
+    func t6d() : async () {
+        debugPrint "BEFORE6d";
+        label out try {
+            debugPrint "IN6d";
+            try {
+                debugPrint "InnerIN6d";
+                let fut = m();
+                await fut;
+                debugPrint "InnerLIVE6d";
+                await fut;
+                debugPrint "InnerLIVESTILL6d";
+                assert false;
+                debugPrint "InnerDEAD6d";
+            } finally { debugPrint "InnerOUT6d" };
+            debugPrint "DEAD6d";
+        }
+        finally { debugPrint "OUT6d" };
+        debugPrint "AFTER6d"
+    };
+
     // TODO: trap on happy/catch
     // TODO: trap after repeated `await`
 
@@ -107,6 +144,8 @@ actor A {
         /*await t4();*/
         await t5();*/
         await t6();
+        try await t6t() catch _ {};
+        try await t6d() catch _ {};
     };
 };
 

From 1a6ac26f9d28418c4173f9cefa6c22c75d263a6e Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 12 Jun 2024 14:34:44 +0200
Subject: [PATCH 083/179] allow non-unit resuts for `try`

---
 src/lowering/desugar.ml                  |  2 --
 src/prelude/internals.mo                 |  2 --
 test/run-drun/ok/try-finally.drun-run.ok |  9 ++++++---
 test/run-drun/ok/try-finally.run-low.ok  |  8 ++++----
 test/run-drun/ok/try-finally.tc.ok       | 13 ++++++-------
 test/run-drun/try-finally.mo             | 19 ++++++++++++++-----
 6 files changed, 30 insertions(+), 23 deletions(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index b76fc7ccc9a..c6e7afdb302 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -218,9 +218,7 @@ and exp' at note = function
   | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs)
   | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs, None)
   | S.TryE (e1, cs, Some e2) ->
-    assert (T.is_unit note.Note.typ); (* NOPE!*)
     let thunk = T.(funcE ("$FIXME") Local Returns [] [] [] (exp e2)) in
-    (*let post e1 = blockE [expD e1] (exp e2) in*)
     assert T.(is_func thunk.note.Note.typ);
     let th = fresh_var "thunk" thunk.note.Note.typ in
     let post e1 =
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index 96872750453..09a8b908b1c 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -363,8 +363,6 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>)
   var cleanup : Error -> () = @shout2;
 
   func clean(_ : Nat32) {
-    (prim "print" : Text -> ()) "EXTERN";
-
     cleanup @FIXME_err;
   };
 
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 5bc606b22a3..1eda019d66e 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -1,17 +1,21 @@
 ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
 ingress Completed: Reply: 0x4449444c0000
 debug.print: IN
-debug.print: EXTERN
 debug.print: OUT
 debug.print: CLEANUP_E
 debug.print: INr
-debug.print: EXTERN
 debug.print: OUTr
 debug.print: CLEANUP_E
 debug.print: INd
 debug.print: AGAINd
 debug.print: OUTd
 debug.print: CLEANUP_E
+debug.print: IN2
+debug.print: CAUGHT2
+debug.print: OUT2
+debug.print: IN2i
+debug.print: CAUGHT2i
+debug.print: OUT2i
 debug.print: BEFORE6
 debug.print: IN6
 debug.print: InnerIN6
@@ -23,7 +27,6 @@ debug.print: BEFORE6t
 debug.print: IN6t
 debug.print: InnerIN6t
 debug.print: InnerLIVE6t
-debug.print: EXTERN
 debug.print: InnerOUT6t
 debug.print: OUT6t
 debug.print: CLEANUP_E
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index d6f7986e49b..92aa54faef3 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -5,14 +5,14 @@ IR has aliasing (or Check_ir visits nodes twice):
 IR has aliasing (or Check_ir visits nodes twice):
 (PrimE TupPrim)
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/8/0) (PrimE TupPrim))
+(PrimE (CallPrim) (VarE $$thunk/10/0) (PrimE TupPrim))
 IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/8/0)
+(VarE $$thunk/10/0)
 IR has aliasing (or Check_ir visits nodes twice):
 (PrimE TupPrim)
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/7/0) (PrimE TupPrim))
+(PrimE (CallPrim) (VarE $$thunk/9/0) (PrimE TupPrim))
 IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/7/0)
+(VarE $$thunk/9/0)
 IR has aliasing (or Check_ir visits nodes twice):
 (PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index c70fb6898b9..280e00e44c5 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -10,28 +10,27 @@ try-finally.mo:22.9-23.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:84.13-90.49: warning [M0145], this try handler of type
+try-finally.mo:92.13-98.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:82.19-93.38: warning [M0145], this try handler of type
+try-finally.mo:90.19-101.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:101.13-107.50: warning [M0145], this try handler of type
+try-finally.mo:109.13-115.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:99.19-110.39: warning [M0145], this try handler of type
+try-finally.mo:107.19-118.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:118.13-127.50: warning [M0145], this try handler of type
+try-finally.mo:126.13-135.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:116.19-130.39: warning [M0145], this try handler of type
+try-finally.mo:124.19-138.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:1.22-1.27: warning [M0198], unused field error in object pattern (delete or rewrite as `error = _`)
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 70571d53dc7..444ed207052 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -35,7 +35,7 @@ actor A {
         catch _ { debugPrint "CAUGHT1" }
     };
 */
-/*
+
     func t2() : async () {
         try {
             debugPrint "IN2";
@@ -45,8 +45,16 @@ actor A {
         finally { debugPrint "OUT2" };
     };
 
-    //TODO: func t2t() : async Int { ... }
-
+    func t2i() : async Int {
+        try {
+            debugPrint "IN2i";
+            await async ();
+            throw error "IN2i";
+        }
+        catch _ { debugPrint "CAUGHT2i"; 42 }
+        finally { debugPrint "OUT2i" };
+    };
+/*
     func t3() : async () {
         try {
             debugPrint "IN3";
@@ -139,8 +147,9 @@ actor A {
         try await t0r() catch _ {};
         try await t0d() catch _ {};
         //await t1();
-        /*await t2();
-        await t3();
+        await t2();
+        ignore await t2i();
+        /*await t3();
         /*await t4();*/
         await t5();*/
         await t6();

From 58a906c949b2aaf602855b45462420290a04583f Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 13 Jun 2024 11:12:48 +0200
Subject: [PATCH 084/179] WIP: reduce IR sharing by reconstructing the `VarE`

we are not done yet, and we should just pass the variable name here
---
 src/ir_passes/await.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 2f6191165b3..b18f6263060 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -373,7 +373,7 @@ and c_exp' context exp k =
         ]
         (c_exp context' exp1 (ContVar k))
     ))
-  | TryE (exp1, cases, Some exp2) ->
+  | TryE (exp1, cases, Some ({it = VarE id2; _} as exp2)) ->
     (* TODO: do we need to reify f? *)
     let f = match LabelEnv.find Throw context with Cont f -> f | _ -> assert false in
     letcont f (fun f ->
@@ -397,7 +397,7 @@ and c_exp' context exp k =
         }] in
       let throw = fresh_err_cont (answerT (typ_of_var k)) in
       let lab = function
-        | Cont k -> Cont (precont k exp2)
+        | Cont k -> Cont (precont k (varE (var id2 (typ exp2))))
         | Label -> assert false
       in
       let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Cleanup | Throw -> fun c -> c) context in

From 0c28b832eb3032831d8b4939697dc85394532c4c Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 13 Jun 2024 17:03:07 +0200
Subject: [PATCH 085/179] WIP: fix the type of the cleanup continuation

this won't typecheck just yet, there is still some kink to work out
---
 src/ir_def/check_ir.ml                   |  4 +--
 src/ir_passes/async.ml                   | 27 +++++++---------
 src/ir_passes/await.ml                   |  6 ++--
 src/prelude/internals.mo                 | 18 +++++------
 test/run-drun/ok/try-finally.drun-run.ok | 41 ------------------------
 test/run-drun/ok/try-finally.run-low.ok  | 18 -----------
 test/run-drun/ok/try-finally.tc.ok       | 36 ---------------------
 7 files changed, 26 insertions(+), 124 deletions(-)
 delete mode 100644 test/run-drun/ok/try-finally.drun-run.ok
 delete mode 100644 test/run-drun/ok/try-finally.run-low.ok
 delete mode 100644 test/run-drun/ok/try-finally.tc.ok

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index d56aa396a25..449881b7b0f 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -560,7 +560,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
            (match ts2 with
             | [] -> ()
             | _ -> error env exp.at "CPSAwait answer type error");
-           typ krc <: T.Tup [cont_typ; T.Func(T.Local, T.Returns, [], [T.catch], ts2); T.Func(T.Local, T.Returns, [], [T.catch], ts2)(*FIXME*)];
+           typ krc <: T.Tup [cont_typ; T.Func(T.Local, T.Returns, [], [T.catch], ts2); T.Func(T.Local, T.Returns, [], [], ts2)];
            t1 <: T.seq ts1;
            T.seq ts2 <: t;
          end;
@@ -572,7 +572,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
         T.Func(T.Local,T.Returns, [tb],
           [T.Func(T.Local, T.Returns, [], ts1, []);
            T.Func(T.Local, T.Returns, [], [t_error], []);
-           T.Func(T.Local, T.Returns, [], [t_errorFIXME], [])(*FIXME*)],
+           T.Func(T.Local, T.Returns, [], _(*FIXME: why not []?*), [])],
           []) ->
          T.catch <: t_error;
          T.Async(s, t0, Type.open_ [t0] (T.seq ts1)) <: t
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index b64a2c6df63..f7e77122cfb 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -45,13 +45,13 @@ let failT = T.(Func(Local, Returns, [], [catch], []))
 let cleanT = T.(Func(Local, Returns, [], [nat32(*FIXME*)], []))
 
 let t_async_fut as_seq t =
-  T.(Func (Local, Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: actually ()->()*)],
+  T.(Func (Local, Returns, [], [fulfillT as_seq t; failT; Func(Local, Returns, [], [], [])],
            [sum [
                 ("suspend", unit);
                 ("schedule", Func(Local, Returns, [], [], []))]]))
 
 let t_async_cmp as_seq t =
-  T.(Func (Local, Returns, [], [fulfillT as_seq t; failT; failT(*FIXME: finallyT*)], []))
+  T.(Func (Local, Returns, [], [fulfillT as_seq t; failT; Func(Local, Returns, [], [], [])], []))
 
 let new_async_ret as_seq t = [t_async_fut as_seq t; fulfillT as_seq t; failT; cleanT]
 
@@ -68,7 +68,7 @@ let new_asyncE () =
 
 let new_async t =
   let call_new_async = callE (new_asyncE ()) [t] (unitE()) in
-  let async = fresh_var "asyncX"(*FIXME: revert*) (typ (projE call_new_async 0)) in
+  let async = fresh_var "async" (typ (projE call_new_async 0)) in
   let fulfill = fresh_var "fulfill" (typ (projE call_new_async 1)) in
   let fail = fresh_var "fail" (typ (projE call_new_async 2)) in
   let clean = fresh_var "clean" (typ (projE call_new_async 3)) in
@@ -83,8 +83,8 @@ let new_nary_async_reply ts =
     let coerce u =
       let v = fresh_var "v" u in
       let k = fresh_var "k" (contT u T.unit) in
-      let r = fresh_var "r" (err_contT T.unit) in
-      let c = fresh_var "c" (err_contT T.unit(*FIXME: contT T.nat32 T.unit*)) in
+      let r = fresh_var "rX" (err_contT T.unit) in
+      let c = fresh_var "c" (Func(Local, Returns, [], [], [])) in
       [k; r; c] -->* (
         varE unary_async -*-
           (tupE [
@@ -269,7 +269,7 @@ let transform prog =
                   let n = fresh_var "nat" T.nat32 in
                   letE v
                   (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1)
-                     ([n] -->* (projE (varE vkrc) 2 -*- varE (var "@FIXME_err" T.error) )))
+                     ([n] -->* (projE (varE vkrc) 2 -*- unitE ())))
                     (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
               ]
               T.unit
@@ -300,8 +300,7 @@ let transform prog =
             let e = fresh_var "e" T.catch in
             [e] -->* ic_rejectE (errorMessageE (varE e)) in
           let ic_cleanup =
-            let c = fresh_var "c" T.catch in
-            [c] -->* ic_rejectE (errorMessageE (varE c))(*FIXME*) in
+            [] -->* unitE () in
           let exp' = callE (t_exp exp1) [t0] (tupE [ic_reply; ic_reject; ic_cleanup]) in
           expD (selfcallE ts1 exp' (varE nary_reply) (varE reject) (varE clean))
         ]
@@ -318,9 +317,9 @@ let transform prog =
       in
       let v_ret = fresh_var "v" t_ret in
       let v_fail = fresh_var "e" t_fail in
-      let v_clean = fresh_var "c" t_fail(*FIXME*) in
+      let v_clean = fresh_var "c" (Func(Local, Returns, [], [], [])) in
       ([v_ret; v_fail; v_clean] -->* callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail; varE v_clean])).it
-    | PrimE (CallPrim typs, (exp1 :: exp2 :: _)) when is_awaitable_func exp1 ->(* HERE *)
+    | PrimE (CallPrim typs, (exp1 :: exp2 :: _)) when is_awaitable_func exp1 ->
       let ts1,ts2 =
         match typ exp1 with
         | T.Func (T.Shared _, T.Promises, tbs, ts1, ts2) ->
@@ -410,8 +409,7 @@ let transform prog =
                 let e = fresh_var "e" T.catch in
                 [e] -->* ic_rejectE (errorMessageE (varE e)) in
               let cl =
-                let c = fresh_var "c" T.catch in
-                [c] -->* ic_rejectE (errorMessageE (varE c))(*FIXME*) in
+                [] -->* unitE () in
               let exp' = callE (t_exp cps) [t0] (tupE [k; r; cl]) in
               FuncE (x, T.Shared s', Replies, typbinds', args', ret_tys, exp')
             (* oneway, always with `ignore(async _)` body *)
@@ -440,10 +438,9 @@ let transform prog =
                 v --> tupE [] in (* discard return *)
               let r =
                 let e = fresh_var "e" T.catch in
-                [e] -->* tupE [] in (* discard error *)
+                [e] -->* tupE [] in
               let cl =
-                let e = fresh_var "e" T.catch in
-                [e] -->* tupE [](*FIXME*) in (* discard error *)
+                [] -->* unitE () in
               let exp' = callE (t_exp cps) [t0] (tupE [k; r; cl]) in
               FuncE (x, T.Shared s', Returns, typbinds', args', ret_tys, exp')
             | Returns, _ ->
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index b18f6263060..fdee78d6ab3 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -402,7 +402,7 @@ and c_exp' context exp k =
       in
       let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Cleanup | Throw -> fun c -> c) context in
       let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
-      let c = match LabelEnv.find_opt Cleanup context'' with Some c -> c | None -> Cont (ContVar (var "@shout2" (err_contT T.unit))) in
+      let c = match LabelEnv.find_opt Cleanup context'' with Some c -> c | None -> Cont (ContVar (var "@shout2" T.(contT unit unit))) in
       let context''' = LabelEnv.add Cleanup (lab c) context'' in
       blockE
         [ let e = fresh_var "e" T.catch in
@@ -445,7 +445,7 @@ and c_exp' context exp k =
     (* add the implicit return label *)
     let k_ret = fresh_cont (typ exp1) T.unit in
     let k_fail = fresh_err_cont T.unit in
-    let k_clean = fresh_err_cont T.unit(*FIXME*) in
+    let k_clean = fresh_cont T.unit T.unit in
     let context' =
       LabelEnv.add Return (Cont (ContVar k_ret))
         (LabelEnv.singleton Throw (Cont (ContVar k_fail)))
@@ -472,7 +472,7 @@ and c_exp' context exp k =
     in
     let c = match LabelEnv.find_opt Cleanup context with
       | Some (Cont r) -> r
-      | None -> ContVar (var "@shout2" (err_contT T.unit))
+      | None -> ContVar (var "@shout2" T.(contT unit unit))
       | _ -> assert false
     in
     letcont r (fun r ->
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index 09a8b908b1c..d231123b09a 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -285,7 +285,7 @@ func @equal_array<T>(eq : (T, T) -> Bool, a : [T], b : [T]) : Bool {
 };
 
 type @Cont<T> = T -> () ;
-type @Async<T> = (@Cont<T>, @Cont<Error>, @Cont<Error/*FIXME: unit*/>) -> {
+type @Async<T> = (@Cont<T>, @Cont<Error>, () -> ()) -> {
   #suspend;
   #schedule : () -> ();
 };
@@ -307,10 +307,10 @@ func @getSystemRefund() : @Refund {
   return (prim "cyclesRefunded" : () -> Nat) ();
 };
 
-func @shout() = (prim "print" : Text -> ()) "CLEANUP";
+//func @shout() = (prim "print" : Text -> ()) "CLEANUP";
 
-let @FIXME_err = (prim "cast" : ({#call_error : {err_code : Nat32}}, Text) -> Error) (#call_error {err_code = 0 : Nat32}, "HAHA");
-func @shout2(e : Error) {
+//let @FIXME_err = (prim "cast" : ({#call_error : {err_code : Nat32}}, Text) -> Error) (#call_error {err_code = 0 : Nat32}, "HAHA");
+func @shout2(/*e : Error*/) {
     type ErrorCode = {
         #system_fatal;
         #system_transient;
@@ -320,8 +320,8 @@ func @shout2(e : Error) {
         #future : Nat32;
         #call_error : { err_code : Nat32 };
     };
-    func errorCode(e : Error) : ErrorCode = ((prim "cast" : Error -> (ErrorCode, Text)) e).0;
-    assert errorCode @FIXME_err == errorCode e;
+    //func errorCode(e : Error) : ErrorCode = ((prim "cast" : Error -> (ErrorCode, Text)) e).0;
+    //assert errorCode @FIXME_err == errorCode e;
     (prim "print" : Text -> ()) "CLEANUP_E"
 };
 
@@ -360,13 +360,13 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>)
     };
   };
 
-  var cleanup : Error -> () = @shout2;
+  var cleanup : () -> () = @shout2;
 
   func clean(_ : Nat32) {
-    cleanup @FIXME_err;
+      cleanup();
   };
 
-  func enqueue(k : @Cont<T>, r : @Cont<Error>, c : @Cont<Error/*FIXME: unit*/>) : {
+  func enqueue(k : @Cont<T>, r : @Cont<Error>, c : () -> ()) : {
     #suspend;
     #schedule : () -> ();
   } {
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
deleted file mode 100644
index 1eda019d66e..00000000000
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ /dev/null
@@ -1,41 +0,0 @@
-ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
-ingress Completed: Reply: 0x4449444c0000
-debug.print: IN
-debug.print: OUT
-debug.print: CLEANUP_E
-debug.print: INr
-debug.print: OUTr
-debug.print: CLEANUP_E
-debug.print: INd
-debug.print: AGAINd
-debug.print: OUTd
-debug.print: CLEANUP_E
-debug.print: IN2
-debug.print: CAUGHT2
-debug.print: OUT2
-debug.print: IN2i
-debug.print: CAUGHT2i
-debug.print: OUT2i
-debug.print: BEFORE6
-debug.print: IN6
-debug.print: InnerIN6
-debug.print: InnerLIVE6
-debug.print: InnerOUT6
-debug.print: OUT6
-debug.print: AFTER6
-debug.print: BEFORE6t
-debug.print: IN6t
-debug.print: InnerIN6t
-debug.print: InnerLIVE6t
-debug.print: InnerOUT6t
-debug.print: OUT6t
-debug.print: CLEANUP_E
-debug.print: BEFORE6d
-debug.print: IN6d
-debug.print: InnerIN6d
-debug.print: InnerLIVE6d
-debug.print: InnerLIVESTILL6d
-debug.print: InnerOUT6d
-debug.print: OUT6d
-debug.print: CLEANUP_E
-ingress Completed: Reply: 0x4449444c0000
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
deleted file mode 100644
index 92aa54faef3..00000000000
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ /dev/null
@@ -1,18 +0,0 @@
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/2/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/2/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/10/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/10/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/9/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/9/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
deleted file mode 100644
index 280e00e44c5..00000000000
--- a/test/run-drun/ok/try-finally.tc.ok
+++ /dev/null
@@ -1,36 +0,0 @@
-try-finally.mo:11.9-12.37: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:17.9-18.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:22.9-23.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:92.13-98.49: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:90.19-101.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:109.13-115.50: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:107.19-118.39: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:126.13-135.50: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:124.19-138.39: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _

From 3b6a95639ef192afd4e2c1b0aad34a32c3c42941 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 13 Jun 2024 21:13:37 +0200
Subject: [PATCH 086/179] fixes and tweaks

---
 src/ir_def/check_ir.ml                   |  2 +-
 src/ir_passes/async.ml                   | 13 ++++----
 src/ir_passes/await.ml                   |  2 +-
 test/run-drun/ok/try-finally.comp-ref.ok | 18 +++++++++++
 test/run-drun/ok/try-finally.comp.ok     | 18 +++++++++++
 test/run-drun/ok/try-finally.diff-low.ok | 21 ++++++++++++
 test/run-drun/ok/try-finally.drun-run.ok | 41 ++++++++++++++++++++++++
 test/run-drun/ok/try-finally.run-low.ok  | 18 +++++++++++
 test/run-drun/ok/try-finally.tc.ok       | 36 +++++++++++++++++++++
 9 files changed, 161 insertions(+), 8 deletions(-)
 create mode 100644 test/run-drun/ok/try-finally.comp-ref.ok
 create mode 100644 test/run-drun/ok/try-finally.comp.ok
 create mode 100644 test/run-drun/ok/try-finally.diff-low.ok
 create mode 100644 test/run-drun/ok/try-finally.drun-run.ok
 create mode 100644 test/run-drun/ok/try-finally.run-low.ok
 create mode 100644 test/run-drun/ok/try-finally.tc.ok

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 449881b7b0f..5f12afb4515 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -572,7 +572,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
         T.Func(T.Local,T.Returns, [tb],
           [T.Func(T.Local, T.Returns, [], ts1, []);
            T.Func(T.Local, T.Returns, [], [t_error], []);
-           T.Func(T.Local, T.Returns, [], _(*FIXME: why not []?*), [])],
+           T.Func(T.Local, T.Returns, [], [], [])],
           []) ->
          T.catch <: t_error;
          T.Async(s, t0, Type.open_ [t0] (T.seq ts1)) <: t
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index f7e77122cfb..2b718557062 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -83,7 +83,7 @@ let new_nary_async_reply ts =
     let coerce u =
       let v = fresh_var "v" u in
       let k = fresh_var "k" (contT u T.unit) in
-      let r = fresh_var "rX" (err_contT T.unit) in
+      let r = fresh_var "r" (err_contT T.unit) in
       let c = fresh_var "c" (Func(Local, Returns, [], [], [])) in
       [k; r; c] -->* (
         varE unary_async -*-
@@ -259,7 +259,7 @@ let transform prog =
         | Func(_, _, [], _, []) ->
           (* unit answer type, from await in `async {}` *)
           (ensureNamed (t_exp krc) (fun vkrc ->
-            let schedule = fresh_var "schedule" (T.Func(T.Local, T.Returns, [], [], [])) in
+            let schedule = fresh_var "schedule" (Func(Local, Returns, [], [], [])) in
             switch_variantE (t_exp a -*- varE vkrc)
               [ ("suspend", wildP,
                   unitE()); (* suspend *)
@@ -308,16 +308,17 @@ let transform prog =
       ).it
     | PrimE (CPSAsync (Cmp, t), [exp1]) ->
       let t0 = t_typ t in
-      let tb, t_ret, t_fail = match typ exp1 with
+      let tb, t_ret, t_fail, t_clean = match typ exp1 with
         | Func(_,_, [tb], [t_ret; t_fail; t_clean], _ ) ->
           tb,
           t_typ (T.open_ [t] t_ret),
-          t_typ (T.open_ [t] t_fail)
+          t_typ (T.open_ [t] t_fail),
+          t_typ (T.open_ [t] t_clean)
         | t -> assert false
       in
       let v_ret = fresh_var "v" t_ret in
       let v_fail = fresh_var "e" t_fail in
-      let v_clean = fresh_var "c" (Func(Local, Returns, [], [], [])) in
+      let v_clean = fresh_var "c" t_clean in
       ([v_ret; v_fail; v_clean] -->* callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail; varE v_clean])).it
     | PrimE (CallPrim typs, (exp1 :: exp2 :: _)) when is_awaitable_func exp1 ->
       let ts1,ts2 =
@@ -396,7 +397,7 @@ let transform prog =
                 | PrimE (CPSAsync (Type.Fut, t0), [cps]) -> t_typ t0, cps
                 | _ -> assert false in
               let t1, contT = match typ cps with
-                | Func (_,_,
+                | Func (_, _,
                     [tb],
                     [Func(_, _, [], ts1, []) as contT; _; _],
                     []) ->
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index fdee78d6ab3..4f3714b89e9 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -81,7 +81,7 @@ let rec t_async context exp =
    (* add the implicit return label *)
    let k_ret = fresh_cont (typ exp1) T.unit in
    let k_fail = fresh_err_cont T.unit in
-   let k_clean = fresh_err_cont T.unit in
+   let k_clean = fresh_cont T.unit T.unit in
    let context' =
      LabelEnv.add Return (Cont (ContVar k_ret))
        (LabelEnv.singleton Throw (Cont (ContVar k_fail)))
diff --git a/test/run-drun/ok/try-finally.comp-ref.ok b/test/run-drun/ok/try-finally.comp-ref.ok
new file mode 100644
index 00000000000..92aa54faef3
--- /dev/null
+++ b/test/run-drun/ok/try-finally.comp-ref.ok
@@ -0,0 +1,18 @@
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/2/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/2/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/10/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/10/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/9/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/9/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.comp.ok b/test/run-drun/ok/try-finally.comp.ok
new file mode 100644
index 00000000000..92aa54faef3
--- /dev/null
+++ b/test/run-drun/ok/try-finally.comp.ok
@@ -0,0 +1,18 @@
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/2/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/2/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/10/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/10/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/9/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/9/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.diff-low.ok b/test/run-drun/ok/try-finally.diff-low.ok
new file mode 100644
index 00000000000..587d72c355f
--- /dev/null
+++ b/test/run-drun/ok/try-finally.diff-low.ok
@@ -0,0 +1,21 @@
+--- try-finally.run
++++ try-finally.run-low
+@@ -0,0 +1,18 @@
++IR has aliasing (or Check_ir visits nodes twice):
++(PrimE (CallPrim) (VarE $$thunk/2/0) (PrimE TupPrim))
++IR has aliasing (or Check_ir visits nodes twice):
++(VarE $$thunk/2/0)
++IR has aliasing (or Check_ir visits nodes twice):
++(PrimE TupPrim)
++IR has aliasing (or Check_ir visits nodes twice):
++(PrimE (CallPrim) (VarE $$thunk/10/0) (PrimE TupPrim))
++IR has aliasing (or Check_ir visits nodes twice):
++(VarE $$thunk/10/0)
++IR has aliasing (or Check_ir visits nodes twice):
++(PrimE TupPrim)
++IR has aliasing (or Check_ir visits nodes twice):
++(PrimE (CallPrim) (VarE $$thunk/9/0) (PrimE TupPrim))
++IR has aliasing (or Check_ir visits nodes twice):
++(VarE $$thunk/9/0)
++IR has aliasing (or Check_ir visits nodes twice):
++(PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
new file mode 100644
index 00000000000..1eda019d66e
--- /dev/null
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -0,0 +1,41 @@
+ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
+ingress Completed: Reply: 0x4449444c0000
+debug.print: IN
+debug.print: OUT
+debug.print: CLEANUP_E
+debug.print: INr
+debug.print: OUTr
+debug.print: CLEANUP_E
+debug.print: INd
+debug.print: AGAINd
+debug.print: OUTd
+debug.print: CLEANUP_E
+debug.print: IN2
+debug.print: CAUGHT2
+debug.print: OUT2
+debug.print: IN2i
+debug.print: CAUGHT2i
+debug.print: OUT2i
+debug.print: BEFORE6
+debug.print: IN6
+debug.print: InnerIN6
+debug.print: InnerLIVE6
+debug.print: InnerOUT6
+debug.print: OUT6
+debug.print: AFTER6
+debug.print: BEFORE6t
+debug.print: IN6t
+debug.print: InnerIN6t
+debug.print: InnerLIVE6t
+debug.print: InnerOUT6t
+debug.print: OUT6t
+debug.print: CLEANUP_E
+debug.print: BEFORE6d
+debug.print: IN6d
+debug.print: InnerIN6d
+debug.print: InnerLIVE6d
+debug.print: InnerLIVESTILL6d
+debug.print: InnerOUT6d
+debug.print: OUT6d
+debug.print: CLEANUP_E
+ingress Completed: Reply: 0x4449444c0000
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
new file mode 100644
index 00000000000..92aa54faef3
--- /dev/null
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -0,0 +1,18 @@
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/2/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/2/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/10/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/10/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE (CallPrim) (VarE $$thunk/9/0) (PrimE TupPrim))
+IR has aliasing (or Check_ir visits nodes twice):
+(VarE $$thunk/9/0)
+IR has aliasing (or Check_ir visits nodes twice):
+(PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
new file mode 100644
index 00000000000..280e00e44c5
--- /dev/null
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -0,0 +1,36 @@
+try-finally.mo:11.9-12.37: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:17.9-18.38: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:22.9-23.38: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:92.13-98.49: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:90.19-101.38: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:109.13-115.50: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:107.19-118.39: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:126.13-135.50: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:124.19-138.39: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _

From 4c84e413fd53309d9b7cf40ab6e79eee240c3464 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 13 Jun 2024 21:28:24 +0200
Subject: [PATCH 087/179] tweaks

---
 src/ir_passes/async.ml | 81 +++++++++++++++++++++---------------------
 1 file changed, 40 insertions(+), 41 deletions(-)

diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 2b718557062..c828532d8e7 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -20,38 +20,38 @@ open Construct
      a manifest tuple argument extended with a final reply continuation.
  *)
 
-module ConRenaming = E.Make(struct type t = T.con let compare = Cons.compare end)
+module ConRenaming = E.Make(struct type t = con let compare = Cons.compare end)
 
 (* Helpers *)
 
 let selfcallE ts e1 e2 e3 e4 =
   { it = SelfCallE (ts, e1, e2, e3, e4);
     at = no_region;
-    note = Note.{ def with typ = T.unit } }
+    note = Note.{ def with typ = unit } }
 
-let error_rep_ty = T.(Tup [Variant T.catchErrorCodes; text])
+let error_rep_ty = Tup [Variant catchErrorCodes; text]
 
 let errorMessageE e =
-  projE (primE (CastPrim (T.error, error_rep_ty)) [e]) 1
+  projE (primE (CastPrim (error, error_rep_ty)) [e]) 1
 
 let unary typ = [typ]
 
-let nary typ = T.as_seq typ
+let nary typ = as_seq typ
 
-let fulfillT as_seq typ = T.(Func(Local, Returns, [], as_seq typ, []))
+let fulfillT as_seq typ = Func(Local, Returns, [], as_seq typ, [])
 
-let failT = T.(Func(Local, Returns, [], [catch], []))
+let failT = Func (Local, Returns, [], [catch], [])
 
-let cleanT = T.(Func(Local, Returns, [], [nat32(*FIXME*)], []))
+let cleanT = Func (Local, Returns, [], [nat32(*FIXME*)], [])
 
 let t_async_fut as_seq t =
-  T.(Func (Local, Returns, [], [fulfillT as_seq t; failT; Func(Local, Returns, [], [], [])],
-           [sum [
-                ("suspend", unit);
-                ("schedule", Func(Local, Returns, [], [], []))]]))
+  Func (Local, Returns, [], [fulfillT as_seq t; failT; Func(Local, Returns, [], [], [])],
+        [sum [
+             ("suspend", unit);
+             ("schedule", Func(Local, Returns, [], [], []))]])
 
 let t_async_cmp as_seq t =
-  T.(Func (Local, Returns, [], [fulfillT as_seq t; failT; Func(Local, Returns, [], [], [])], []))
+  Func (Local, Returns, [], [fulfillT as_seq t; failT; Func(Local, Returns, [], [], [])], [])
 
 let new_async_ret as_seq t = [t_async_fut as_seq t; fulfillT as_seq t; failT; cleanT]
 
@@ -82,9 +82,9 @@ let new_nary_async_reply ts =
   let nary_async =
     let coerce u =
       let v = fresh_var "v" u in
-      let k = fresh_var "k" (contT u T.unit) in
-      let r = fresh_var "r" (err_contT T.unit) in
-      let c = fresh_var "c" (Func(Local, Returns, [], [], [])) in
+      let k = fresh_var "k" (contT u unit) in
+      let r = fresh_var "r" (err_contT unit) in
+      let c = fresh_var "c" (Func (Local, Returns, [], [], [])) in
       [k; r; c] -->* (
         varE unary_async -*-
           (tupE [
@@ -98,7 +98,7 @@ let new_nary_async_reply ts =
     | [t1] ->
       begin
       match T.normalize t1 with
-      | T.Tup _ ->
+      | Tup _ ->
         (* TODO(#3740): find a better fix than PR #3741 *)
         (* HACK *)
         coerce t1
@@ -136,7 +136,7 @@ let let_eta e scope =
 
 let is_awaitable_func exp =
   match typ exp with
-  | T.Func (T.Shared _, T.Promises, _, _, _) -> true
+  | Func (Shared _, Promises, _, _, _) -> true
   | _ -> false
 
 (* Given sequence type ts, bind e of type (seq ts) to a
@@ -188,14 +188,14 @@ let transform prog =
 
   let rec t_typ (t:T.typ) =
     match t with
-    | T.Prim _
+    | Prim _
       | Var _ -> t
     | Con (c, ts) ->
       Con (t_con c, List.map t_typ ts)
     | Array t -> Array (t_typ t)
     | Tup ts -> Tup (List.map t_typ ts)
     | Func (s, c, tbs, ts1, ts2) ->
-      let c' = match c with T.Promises -> T.Replies | _ -> c in
+      let c' = match c with Promises -> Replies | _ -> c in
       Func (s, c', List.map t_bind tbs, List.map t_typ ts1, List.map t_typ ts2)
     | Opt t -> Opt (t_typ t)
     | Variant fs -> Variant (List.map t_field fs)
@@ -215,14 +215,14 @@ let transform prog =
 
   and t_kind k =
     match k with
-    | T.Abs (typ_binds,typ) ->
-      T.Abs (t_binds typ_binds, t_typ typ)
-    | T.Def (typ_binds,typ) ->
-      T.Def (t_binds typ_binds, t_typ typ)
+    | Abs (typ_binds,typ) ->
+      Abs (t_binds typ_binds, t_typ typ)
+    | Def (typ_binds,typ) ->
+      Def (t_binds typ_binds, t_typ typ)
 
   and t_con c =
     match Cons.kind c with
-    | T.Def ([], T.Prim _) -> c
+    | Def ([], Prim _) -> c
     | _ ->
       match  ConRenaming.find_opt c (!con_renaming) with
       | Some c' -> c'
@@ -265,14 +265,14 @@ let transform prog =
                   unitE()); (* suspend *)
                 ("schedule", varP schedule, (* resume later *)
                   (* try await async (); schedule() catch e -> r(e) *)
-                 (let v = fresh_var "call" T.unit in
-                  let n = fresh_var "nat" T.nat32 in
+                 (let v = fresh_var "call" unit in
+                  let n = fresh_var "nat" nat32 in
                   letE v
                   (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1)
                      ([n] -->* (projE (varE vkrc) 2 -*- unitE ())))
                     (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
               ]
-              T.unit
+              unit
           )).it
         | _ -> assert false
       end
@@ -297,7 +297,7 @@ let transform prog =
             let v = fresh_var "v" (T.seq ts1) in
             v --> (ic_replyE ts1 (varE v)) in
           let ic_reject =
-            let e = fresh_var "e" T.catch in
+            let e = fresh_var "e" catch in
             [e] -->* ic_rejectE (errorMessageE (varE e)) in
           let ic_cleanup =
             [] -->* unitE () in
@@ -323,7 +323,7 @@ let transform prog =
     | PrimE (CallPrim typs, (exp1 :: exp2 :: _)) when is_awaitable_func exp1 ->
       let ts1,ts2 =
         match typ exp1 with
-        | T.Func (T.Shared _, T.Promises, tbs, ts1, ts2) ->
+        | Func (Shared _, Promises, tbs, ts1, ts2) ->
           List.map (fun t -> t_typ (T.open_ typs t)) ts1,
           List.map (fun t -> t_typ (T.open_ typs t)) ts2
         | _ -> assert false
@@ -347,7 +347,7 @@ let transform prog =
       let exp1' = t_exp exp1 in
       let exp2' = t_exp exp2 in
       let exp3' = t_exp exp3 in
-      let (nary_async, nary_reply, reject, clean), def = new_nary_async_reply [T.blob] in
+      let (nary_async, nary_reply, reject, clean), def = new_nary_async_reply [blob] in
       (blockE (
         letP (tupP [varP nary_async; varP nary_reply; varP reject; varP clean]) def ::
           let_eta exp1' (fun v1 ->
@@ -384,9 +384,9 @@ let transform prog =
     | FuncE (x, s, c, typbinds, args, ret_tys, exp) ->
       begin
         match s with
-        | T.Local  ->
+        | Local  ->
           FuncE (x, s, c, t_typ_binds typbinds, t_args args, List.map t_typ ret_tys, t_exp exp)
-        | T.Shared s' ->
+        | Shared s' ->
           begin
             match c, exp with
             | Promises, exp ->
@@ -407,12 +407,12 @@ let transform prog =
                 let v = fresh_var "v" t1 in
                 v --> (ic_replyE ret_tys (varE v)) in
               let r =
-                let e = fresh_var "e" T.catch in
+                let e = fresh_var "e" catch in
                 [e] -->* ic_rejectE (errorMessageE (varE e)) in
               let cl =
                 [] -->* unitE () in
               let exp' = callE (t_exp cps) [t0] (tupE [k; r; cl]) in
-              FuncE (x, T.Shared s', Replies, typbinds', args', ret_tys, exp')
+              FuncE (x, Shared s', Replies, typbinds', args', ret_tys, exp')
             (* oneway, always with `ignore(async _)` body *)
             | Returns,
               { it = BlockE (
@@ -433,20 +433,19 @@ let transform prog =
                     [Func(_, _, [], ts1, []) as contT; _; _],
                     []) ->
                   (t_typ (T.seq (List.map (T.open_ [t0]) ts1)),t_typ (T.open_ [t0] contT))
-                | t -> assert false in
+                | _ -> assert false in
               let k =
                 let v = fresh_var "v" t1 in
                 v --> tupE [] in (* discard return *)
               let r =
-                let e = fresh_var "e" T.catch in
+                let e = fresh_var "e" catch in
                 [e] -->* tupE [] in
               let cl =
                 [] -->* unitE () in
               let exp' = callE (t_exp cps) [t0] (tupE [k; r; cl]) in
-              FuncE (x, T.Shared s', Returns, typbinds', args', ret_tys, exp')
-            | Returns, _ ->
-              assert false
-            | Replies,_ -> assert false
+              FuncE (x, Shared s', Returns, typbinds', args', ret_tys, exp')
+            | Returns, _ -> assert false
+            | Replies, _ -> assert false
           end
       end
     | ActorE (ds, fs, {meta; preupgrade; postupgrade; heartbeat; timer; inspect}, typ) ->

From 76214cd9b81dcbf3f35a6c473410134d4438745c Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 14 Jun 2024 11:21:34 +0200
Subject: [PATCH 088/179] communicate intent better (not done yet)

---
 src/ir_def/check_ir.ml | 30 +++++++++++++++---------------
 src/ir_passes/async.ml |  7 ++++---
 2 files changed, 19 insertions(+), 18 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 5f12afb4515..d3dfda62a5b 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -560,7 +560,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
            (match ts2 with
             | [] -> ()
             | _ -> error env exp.at "CPSAwait answer type error");
-           typ krc <: T.Tup [cont_typ; T.Func(T.Local, T.Returns, [], [T.catch], ts2); T.Func(T.Local, T.Returns, [], [], ts2)];
+           typ krc <: T.Tup T.[cont_typ; Construct.err_contT (Tup ts2); Func(Local, Returns, [], [], ts2)];
            t1 <: T.seq ts1;
            T.seq ts2 <: t;
          end;
@@ -569,13 +569,13 @@ let rec check_exp env (exp:Ir.exp) : unit =
       check (env.flavor.has_async_typ) "CPSAwait in post-async flavor";
     | CPSAsync (s, t0), [exp] ->
       (match typ exp with
-        T.Func(T.Local,T.Returns, [tb],
-          [T.Func(T.Local, T.Returns, [], ts1, []);
-           T.Func(T.Local, T.Returns, [], [t_error], []);
-           T.Func(T.Local, T.Returns, [], [], [])],
-          []) ->
-         T.catch <: t_error;
-         T.Async(s, t0, Type.open_ [t0] (T.seq ts1)) <: t
+       | T.Func (T.Local, T.Returns, [tb],
+                 T.[Func (Local, Returns, [], ts1, []);
+                    Func (Local, Returns, [], [t_error], []);
+                    Func (Local, Returns, [], [], [])],
+                 []) ->
+          T.catch <: t_error;
+          T.Async(s, t0, T.open_ [t0] (T.seq ts1)) <: t
        | _ -> error env exp.at "CPSAsync unexpected typ");
       check (not (env.flavor.has_await)) "CPSAsync await flavor";
       check (env.flavor.has_async_typ) "CPSAsync in post-async flavor";
@@ -601,8 +601,8 @@ let rec check_exp env (exp:Ir.exp) : unit =
         let t_arg = T.seq arg_tys in
         typ exp2 <: t_arg;
         check_concrete env exp.at t_arg;
-        typ k <: T.(Func (Local, Returns, [], ret_tys, []));
-        typ r <: T.(Func (Local, Returns, [], [error], []));
+        typ k <: T.(Construct.contT (Tup ret_tys) unit);
+        typ r <: T.(Construct.err_contT unit);
         typ c <: T.(Func (Local, Returns, [], [nat32(*FIXME*)], []));
       | T.Non -> () (* dead code, not much to check here *)
       | _ ->
@@ -614,8 +614,8 @@ let rec check_exp env (exp:Ir.exp) : unit =
       typ exp1 <: T.principal;
       typ exp2 <: T.text;
       typ exp3 <: T.blob;
-      typ k <: T.(Func (Local, Returns, [], [blob], []));
-      typ r <: T.(Func (Local, Returns, [], [error], []));
+      typ k <: T.(Construct.contT blob unit);
+      typ r <: T.(Construct.err_contT unit);
       typ c <: T.(Func (Local, Returns, [], [nat32(*FIXME*)], []));
       T.unit <: t
     | ICMethodNamePrim, [] ->
@@ -728,7 +728,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
     typ exp1 <: t;
     check_cases env T.catch t cases;
     Option.iter (check_exp env) exp2;
-    Option.iter (fun exp2 -> typ exp2 <: T.(Func (Local, Returns, [], [], []))) exp2
+    Option.iter T.(fun exp2 -> typ exp2 <: Construct.contT unit unit) exp2
   | LoopE exp1 ->
     check_exp { env with lvl = NotTopLvl } exp1;
     typ exp1 <: T.unit;
@@ -806,8 +806,8 @@ let rec check_exp env (exp:Ir.exp) : unit =
     check_exp env exp_r;
     check_exp env exp_c;
     typ exp_f <: T.unit;
-    typ exp_k <: T.Func (T.Local, T.Returns, [], ts, []);
-    typ exp_r <: T.Func (T.Local, T.Returns, [], [T.error], []);
+    typ exp_k <: T.(Construct.contT (Tup ts) unit);
+    typ exp_r <: T.(Construct.err_contT unit);
     typ exp_c <: T.Func (T.Local, T.Returns, [], [T.nat32(*FIXME*)], []);
   | ActorE (ds, fs,
       { preupgrade; postupgrade; meta; heartbeat; timer; inspect }, t0) ->
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index c828532d8e7..77061ba281b 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -41,17 +41,18 @@ let nary typ = as_seq typ
 let fulfillT as_seq typ = Func(Local, Returns, [], as_seq typ, [])
 
 let failT = Func (Local, Returns, [], [catch], [])
+let bailT = Func (Local, Returns, [], [], [])
 
 let cleanT = Func (Local, Returns, [], [nat32(*FIXME*)], [])
 
 let t_async_fut as_seq t =
-  Func (Local, Returns, [], [fulfillT as_seq t; failT; Func(Local, Returns, [], [], [])],
+  Func (Local, Returns, [], [fulfillT as_seq t; failT; bailT],
         [sum [
              ("suspend", unit);
              ("schedule", Func(Local, Returns, [], [], []))]])
 
 let t_async_cmp as_seq t =
-  Func (Local, Returns, [], [fulfillT as_seq t; failT; Func(Local, Returns, [], [], [])], [])
+  Func (Local, Returns, [], [fulfillT as_seq t; failT; bailT], [])
 
 let new_async_ret as_seq t = [t_async_fut as_seq t; fulfillT as_seq t; failT; cleanT]
 
@@ -84,7 +85,7 @@ let new_nary_async_reply ts =
       let v = fresh_var "v" u in
       let k = fresh_var "k" (contT u unit) in
       let r = fresh_var "r" (err_contT unit) in
-      let c = fresh_var "c" (Func (Local, Returns, [], [], [])) in
+      let c = fresh_var "c" (contT unit unit) in
       [k; r; c] -->* (
         varE unary_async -*-
           (tupE [

From eed2ba39759fce28d1e3e4f1de7a2b5d296099ff Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 14 Jun 2024 12:48:09 +0200
Subject: [PATCH 089/179] WIP: prepare for elimination of nat32

---
 src/ir_def/check_ir.ml   | 8 ++++----
 src/ir_def/construct.ml  | 4 ++++
 src/ir_def/construct.mli | 2 ++
 src/ir_passes/async.ml   | 8 ++++----
 src/mo_types/type.ml     | 2 +-
 src/mo_types/type.mli    | 2 +-
 6 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index d3dfda62a5b..927d56f7685 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -560,7 +560,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
            (match ts2 with
             | [] -> ()
             | _ -> error env exp.at "CPSAwait answer type error");
-           typ krc <: T.Tup T.[cont_typ; Construct.err_contT (Tup ts2); Func(Local, Returns, [], [], ts2)];
+           typ krc <: T.Tup T.[cont_typ; Construct.err_contT (Tup ts2); Construct.bail_contT];
            t1 <: T.seq ts1;
            T.seq ts2 <: t;
          end;
@@ -603,7 +603,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
         check_concrete env exp.at t_arg;
         typ k <: T.(Construct.contT (Tup ret_tys) unit);
         typ r <: T.(Construct.err_contT unit);
-        typ c <: T.(Func (Local, Returns, [], [nat32(*FIXME*)], []));
+        typ c <: Construct.clean_contT;
       | T.Non -> () (* dead code, not much to check here *)
       | _ ->
          error env exp1.at "expected function type, but expression produces type\n  %s"
@@ -616,7 +616,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
       typ exp3 <: T.blob;
       typ k <: T.(Construct.contT blob unit);
       typ r <: T.(Construct.err_contT unit);
-      typ c <: T.(Func (Local, Returns, [], [nat32(*FIXME*)], []));
+      typ c <: Construct.clean_contT;
       T.unit <: t
     | ICMethodNamePrim, [] ->
       T.text <: t
@@ -808,7 +808,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
     typ exp_f <: T.unit;
     typ exp_k <: T.(Construct.contT (Tup ts) unit);
     typ exp_r <: T.(Construct.err_contT unit);
-    typ exp_c <: T.Func (T.Local, T.Returns, [], [T.nat32(*FIXME*)], []);
+    typ exp_c <: Construct.clean_contT;
   | ActorE (ds, fs,
       { preupgrade; postupgrade; meta; heartbeat; timer; inspect }, t0) ->
     (* TODO: check meta *)
diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 63bbc100a21..2ba6e06fde5 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -627,6 +627,10 @@ let contT typ ans_typ = T.(Func (Local, Returns, [], as_seq typ, as_seq ans_typ)
 
 let err_contT ans_typ =  T.(Func (Local, Returns, [], [catch], as_seq ans_typ))
 
+let bail_contT = T.(contT unit unit)
+
+let clean_contT =  T.(Func (Local, Returns, [], [nat32X(*FIXME*)], []))
+
 let answerT typ : T.typ =
   match typ with
   | T.Func (T.Local, T.Returns, [], ts1, ts2) -> T.seq ts2
diff --git a/src/ir_def/construct.mli b/src/ir_def/construct.mli
index a0168aae052..6b2db75b919 100644
--- a/src/ir_def/construct.mli
+++ b/src/ir_def/construct.mli
@@ -127,6 +127,8 @@ val let_no_shadow : var -> exp -> dec list -> dec list
 
 val contT : typ -> typ -> typ
 val err_contT : typ -> typ
+val bail_contT : typ
+val clean_contT : typ
 val answerT : typ -> typ (* answer type of a continuation type *)
 
 val cpsT : typ -> typ -> typ
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 77061ba281b..e4d41b0bea5 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -40,10 +40,10 @@ let nary typ = as_seq typ
 
 let fulfillT as_seq typ = Func(Local, Returns, [], as_seq typ, [])
 
-let failT = Func (Local, Returns, [], [catch], [])
-let bailT = Func (Local, Returns, [], [], [])
+let failT = err_contT unit
+let bailT = bail_contT
 
-let cleanT = Func (Local, Returns, [], [nat32(*FIXME*)], [])
+let cleanT = clean_contT
 
 let t_async_fut as_seq t =
   Func (Local, Returns, [], [fulfillT as_seq t; failT; bailT],
@@ -267,7 +267,7 @@ let transform prog =
                 ("schedule", varP schedule, (* resume later *)
                   (* try await async (); schedule() catch e -> r(e) *)
                  (let v = fresh_var "call" unit in
-                  let n = fresh_var "nat" nat32 in
+                  let n = fresh_var "nat" nat32X in
                   letE v
                   (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1)
                      ([n] -->* (projE (varE vkrc) 2 -*- unitE ())))
diff --git a/src/mo_types/type.ml b/src/mo_types/type.ml
index 613956beca9..6ce9768cce9 100644
--- a/src/mo_types/type.ml
+++ b/src/mo_types/type.ml
@@ -312,7 +312,7 @@ let compare_field f1 f2 =
 let unit = Tup []
 let bool = Prim Bool
 let nat = Prim Nat
-let nat32 = Prim Nat32
+let nat32X = Prim Nat32
 let nat64 = Prim Nat64
 let int = Prim Int
 let text = Prim Text
diff --git a/src/mo_types/type.mli b/src/mo_types/type.mli
index fc6d3694077..10c6b799ae8 100644
--- a/src/mo_types/type.mli
+++ b/src/mo_types/type.mli
@@ -89,7 +89,7 @@ val is_shared_sort : 'a shared -> bool
 val unit : typ
 val bool : typ
 val nat : typ
-val nat32 : typ
+val nat32X : typ
 val nat64 : typ
 val int : typ
 val text : typ

From 6338f22b1b78c99bf00b6e494fb1fcef4e23652c Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 14 Jun 2024 16:45:21 +0200
Subject: [PATCH 090/179] clean-up

---
 src/ir_passes/await.ml   |  4 ++--
 src/prelude/internals.mo | 18 ++----------------
 2 files changed, 4 insertions(+), 18 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 4f3714b89e9..d5cb46cefc7 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -402,7 +402,7 @@ and c_exp' context exp k =
       in
       let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Cleanup | Throw -> fun c -> c) context in
       let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
-      let c = match LabelEnv.find_opt Cleanup context'' with Some c -> c | None -> Cont (ContVar (var "@shout2" T.(contT unit unit))) in
+      let c = match LabelEnv.find_opt Cleanup context'' with Some c -> c | None -> Cont (ContVar (var "@cleanup" T.(contT unit unit))) in
       let context''' = LabelEnv.add Cleanup (lab c) context'' in
       blockE
         [ let e = fresh_var "e" T.catch in
@@ -472,7 +472,7 @@ and c_exp' context exp k =
     in
     let c = match LabelEnv.find_opt Cleanup context with
       | Some (Cont r) -> r
-      | None -> ContVar (var "@shout2" T.(contT unit unit))
+      | None -> ContVar (var "@cleanup" T.(contT unit unit))
       | _ -> assert false
     in
     letcont r (fun r ->
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index d231123b09a..48ce164f4d1 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -307,21 +307,7 @@ func @getSystemRefund() : @Refund {
   return (prim "cyclesRefunded" : () -> Nat) ();
 };
 
-//func @shout() = (prim "print" : Text -> ()) "CLEANUP";
-
-//let @FIXME_err = (prim "cast" : ({#call_error : {err_code : Nat32}}, Text) -> Error) (#call_error {err_code = 0 : Nat32}, "HAHA");
-func @shout2(/*e : Error*/) {
-    type ErrorCode = {
-        #system_fatal;
-        #system_transient;
-        #destination_invalid;
-        #canister_reject;
-        #canister_error;
-        #future : Nat32;
-        #call_error : { err_code : Nat32 };
-    };
-    //func errorCode(e : Error) : ErrorCode = ((prim "cast" : Error -> (ErrorCode, Text)) e).0;
-    //assert errorCode @FIXME_err == errorCode e;
+func @cleanup() {
     (prim "print" : Text -> ()) "CLEANUP_E"
 };
 
@@ -360,7 +346,7 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>)
     };
   };
 
-  var cleanup : () -> () = @shout2;
+  var cleanup : () -> () = @cleanup;
 
   func clean(_ : Nat32) {
       cleanup();

From c8ffb0c4969967cea3a5ed278773861b812ef8a3 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 14 Jun 2024 17:05:32 +0200
Subject: [PATCH 091/179] align

---
 src/ir_passes/async.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index e4d41b0bea5..0496e8bd86c 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -269,8 +269,8 @@ let transform prog =
                  (let v = fresh_var "call" unit in
                   let n = fresh_var "nat" nat32X in
                   letE v
-                  (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1)
-                     ([n] -->* (projE (varE vkrc) 2 -*- unitE ())))
+                    (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1)
+                       ([n] -->* (projE (varE vkrc) 2 -*- unitE ())))
                     (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
               ]
               unit

From 33b4e6458d0040699dd0a10b8a86d184add4a011 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 14 Jun 2024 17:16:18 +0200
Subject: [PATCH 092/179] simplify

---
 src/ir_def/check_ir.ml | 2 +-
 src/ir_passes/async.ml | 2 +-
 src/ir_passes/await.ml | 4 ++--
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 927d56f7685..3a61f2bc9ac 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -728,7 +728,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
     typ exp1 <: t;
     check_cases env T.catch t cases;
     Option.iter (check_exp env) exp2;
-    Option.iter T.(fun exp2 -> typ exp2 <: Construct.contT unit unit) exp2
+    Option.iter (fun exp2 -> typ exp2 <: Construct.bail_contT) exp2
   | LoopE exp1 ->
     check_exp { env with lvl = NotTopLvl } exp1;
     typ exp1 <: T.unit;
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 0496e8bd86c..5fe5afeaf11 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -85,7 +85,7 @@ let new_nary_async_reply ts =
       let v = fresh_var "v" u in
       let k = fresh_var "k" (contT u unit) in
       let r = fresh_var "r" (err_contT unit) in
-      let c = fresh_var "c" (contT unit unit) in
+      let c = fresh_var "c" bail_contT in
       [k; r; c] -->* (
         varE unary_async -*-
           (tupE [
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index d5cb46cefc7..09b139e42c4 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -402,7 +402,7 @@ and c_exp' context exp k =
       in
       let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Cleanup | Throw -> fun c -> c) context in
       let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
-      let c = match LabelEnv.find_opt Cleanup context'' with Some c -> c | None -> Cont (ContVar (var "@cleanup" T.(contT unit unit))) in
+      let c = match LabelEnv.find_opt Cleanup context'' with Some c -> c | None -> Cont (ContVar (var "@cleanup" bail_contT)) in
       let context''' = LabelEnv.add Cleanup (lab c) context'' in
       blockE
         [ let e = fresh_var "e" T.catch in
@@ -472,7 +472,7 @@ and c_exp' context exp k =
     in
     let c = match LabelEnv.find_opt Cleanup context with
       | Some (Cont r) -> r
-      | None -> ContVar (var "@cleanup" T.(contT unit unit))
+      | None -> ContVar (var "@cleanup" bail_contT)
       | _ -> assert false
     in
     letcont r (fun r ->

From 11f2e47cd70f7d9c950c3412562f7a297508c5ed Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 14 Jun 2024 17:20:12 +0200
Subject: [PATCH 093/179] undo

---
 src/codegen/compile.ml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index 966bc4bf4bd..dd1a880c517 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -10582,7 +10582,6 @@ and compile_prim_invocation (env : E.t) ae p es at =
 
   begin match p, es with
   (* Calls *)
-  | CallPrim _, [e1; e2; _] (* FIXME just ignore the third (cleanup stack) arg for now *)
   | CallPrim _, [e1; e2] ->
     let sort, control, _, arg_tys, ret_tys = Type.as_func e1.note.Note.typ in
     let n_args = List.length arg_tys in

From 2c7ccbe9e89d13c52ea82126ce41ac1b7610faba Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 14 Jun 2024 17:50:03 +0200
Subject: [PATCH 094/179] simplify the type for `@cleanup`

---
 src/codegen/compile.ml   | 3 +--
 src/ir_def/construct.ml  | 2 +-
 src/ir_passes/async.ml   | 3 +--
 src/mo_types/type.ml     | 1 -
 src/mo_types/type.mli    | 1 -
 src/prelude/internals.mo | 4 ++--
 6 files changed, 5 insertions(+), 9 deletions(-)

diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml
index dd1a880c517..8e4fe31b479 100644
--- a/src/codegen/compile.ml
+++ b/src/codegen/compile.ml
@@ -9415,9 +9415,8 @@ module FuncDec = struct
         let set_closure, get_closure = new_local env "closure" in
         set_closure ^^ get_closure ^^
         Closure.prepare_closure_call env ^^
-        compile_unboxed_zero ^^
         get_closure ^^
-        Closure.call_closure env 1 0);
+        Closure.call_closure env 0 0);
     compile_unboxed_const (E.add_fun_ptr env (E.built_in env name))
 
   let ic_call_threaded env purpose get_meth_pair push_continuations
diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 2ba6e06fde5..ca59af1b9ad 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -629,7 +629,7 @@ let err_contT ans_typ =  T.(Func (Local, Returns, [], [catch], as_seq ans_typ))
 
 let bail_contT = T.(contT unit unit)
 
-let clean_contT =  T.(Func (Local, Returns, [], [nat32X(*FIXME*)], []))
+let clean_contT =  T.(Func (Local, Returns, [], [], []))
 
 let answerT typ : T.typ =
   match typ with
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 5fe5afeaf11..eafe47fdaeb 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -267,10 +267,9 @@ let transform prog =
                 ("schedule", varP schedule, (* resume later *)
                   (* try await async (); schedule() catch e -> r(e) *)
                  (let v = fresh_var "call" unit in
-                  let n = fresh_var "nat" nat32X in
                   letE v
                     (selfcallE [] (ic_replyE [] (unitE())) (varE schedule) (projE (varE vkrc) 1)
-                       ([n] -->* (projE (varE vkrc) 2 -*- unitE ())))
+                       ([] -->* (projE (varE vkrc) 2 -*- unitE ())))
                     (check_call_perform_status (varE v) (fun e -> projE (varE vkrc) 1 -*- e))))
               ]
               unit
diff --git a/src/mo_types/type.ml b/src/mo_types/type.ml
index 6ce9768cce9..4fe364fbe69 100644
--- a/src/mo_types/type.ml
+++ b/src/mo_types/type.ml
@@ -312,7 +312,6 @@ let compare_field f1 f2 =
 let unit = Tup []
 let bool = Prim Bool
 let nat = Prim Nat
-let nat32X = Prim Nat32
 let nat64 = Prim Nat64
 let int = Prim Int
 let text = Prim Text
diff --git a/src/mo_types/type.mli b/src/mo_types/type.mli
index 10c6b799ae8..acc274b0bb6 100644
--- a/src/mo_types/type.mli
+++ b/src/mo_types/type.mli
@@ -89,7 +89,6 @@ val is_shared_sort : 'a shared -> bool
 val unit : typ
 val bool : typ
 val nat : typ
-val nat32X : typ
 val nat64 : typ
 val int : typ
 val text : typ
diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index 48ce164f4d1..fc1f2e5425a 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -311,7 +311,7 @@ func @cleanup() {
     (prim "print" : Text -> ()) "CLEANUP_E"
 };
 
-func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>) {
+func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, () -> ()) {
   let w_null = func(r : @Refund, t : T) { };
   let r_null = func(_ : Error) {};
   var result : ?(@Result<T>) = null;
@@ -348,7 +348,7 @@ func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, @Cont<Nat32>)
 
   var cleanup : () -> () = @cleanup;
 
-  func clean(_ : Nat32) {
+  func clean() {
       cleanup();
   };
 

From b010d403d6e7577b06cf6f63121297ecca125cc2 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 14 Jun 2024 17:53:05 +0200
Subject: [PATCH 095/179] these are equal types, but slightly different
 semantics

---
 src/ir_def/construct.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index ca59af1b9ad..21d0b7cc5ed 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -627,9 +627,9 @@ let contT typ ans_typ = T.(Func (Local, Returns, [], as_seq typ, as_seq ans_typ)
 
 let err_contT ans_typ =  T.(Func (Local, Returns, [], [catch], as_seq ans_typ))
 
-let bail_contT = T.(contT unit unit)
+let bail_contT = T.(contT unit unit) (* when `await`ing *)
 
-let clean_contT =  T.(Func (Local, Returns, [], [], []))
+let clean_contT = bail_contT (* last-resort replica callback *)
 
 let answerT typ : T.typ =
   match typ with

From 222aab806e364fca142c43ae80dceff5d2ba958c Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 14 Jun 2024 17:57:16 +0200
Subject: [PATCH 096/179] fix for completeness

---
 src/ir_def/construct.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 21d0b7cc5ed..cefb3274f89 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -636,7 +636,7 @@ let answerT typ : T.typ =
   | T.Func (T.Local, T.Returns, [], ts1, ts2) -> T.seq ts2
   | _ -> assert false
 
-let cpsT typ ans_typ = T.(Func (Local, Returns, [], [contT typ ans_typ; err_contT ans_typ], as_seq ans_typ))
+let cpsT typ ans_typ = T.(Func (Local, Returns, [], [contT typ ans_typ; err_contT ans_typ; bail_contT], as_seq ans_typ))
 
 (* Sequence expressions *)
 

From a0963569b7ec83ba3a0f7297f2b4147f17085781 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 19 Jun 2024 14:05:27 +0200
Subject: [PATCH 097/179] yet

---
 test/run-drun/try-finally.mo | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 444ed207052..eeeba75a607 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -23,10 +23,10 @@ actor A {
         finally { debugPrint "OUTd" };
     };
 
-/*  nested `try` won't work
+/*  nested `try` won't work yet
     func t1() : async () {
         try {
-            try {
+            do {
                 debugPrint "IN1";
                 throw error "IN1";
             }

From 0522458a64d4036497c81721ef2a952105861f09 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 19 Jun 2024 14:24:29 +0200
Subject: [PATCH 098/179] simplify the logic

---
 src/lowering/desugar.ml | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index c6e7afdb302..886ecd2b02d 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -218,14 +218,14 @@ and exp' at note = function
   | S.SwitchE (e1, cs) -> I.SwitchE (exp e1, cases cs)
   | S.TryE (e1, cs, None) -> I.TryE (exp e1, cases cs, None)
   | S.TryE (e1, cs, Some e2) ->
-    let thunk = T.(funcE ("$FIXME") Local Returns [] [] [] (exp e2)) in
+    let thunk = T.(funcE ("$cleanup") Local Returns [] [] [] (exp e2)) in
     assert T.(is_func thunk.note.Note.typ);
     let th = fresh_var "thunk" thunk.note.Note.typ in
-    let post e1 =
-      let v = fresh_var "res" note.Note.typ in
-      blockE [letD v e1; expD (varE th -*- unitE ())] (varE v) in
-    (blockE [letD th thunk] (* use funcD for thunk? *)
-      { e1 with it = I.TryE (exp e1 |> post, cases_map post cs, Some (varE th)); note }).it
+    let v = fresh_var "res" note.Note.typ in
+    (blockE [ letD th thunk
+            ; letD v { e1 with it = I.TryE (exp e1, cases cs, Some (varE th)); note }
+            ; expD (varE th -*- unitE ())
+            ] (varE v)).it
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it
@@ -787,8 +787,6 @@ and dec' at n = function
 
 and cases cs = List.map (case (fun x -> x)) cs
 
-and cases_map f cs = List.map (case f) cs
-
 and case f c = phrase (case' f) c
 
 and case' f c = S.{ I.pat = pat c.pat; I.exp = f (exp c.exp) }

From d5ba0c9e1f64e0649c8b8bdc225d5625b7d180bf Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 19 Jun 2024 16:16:15 +0200
Subject: [PATCH 099/179] WIP: try to pass `var` via `TryE`

but this fails mysteriously with:
```
Error: dependency cycle between modules in _build/default/ir_def:
   Rename
-> Construct
-> Construct
-> required by _build/default/ir_def/ir_def.cmxa
-> required by _build/default/exes/mo_ide.exe
```
---
 src/ir_def/check_ir.ml           | 5 ++---
 src/ir_def/construct.ml          | 2 +-
 src/ir_def/construct.mli         | 4 ++--
 src/ir_def/freevars.ml           | 2 +-
 src/ir_def/ir.ml                 | 4 ++--
 src/ir_def/rename.ml             | 2 +-
 src/ir_passes/await.ml           | 4 ++--
 src/ir_passes/const.ml           | 4 ++--
 src/ir_passes/eq.ml              | 4 ++--
 src/ir_passes/erase_typ_field.ml | 4 ++--
 src/ir_passes/show.ml            | 4 ++--
 src/ir_passes/tailcall.ml        | 4 ++--
 src/lowering/desugar.ml          | 2 +-
 13 files changed, 22 insertions(+), 23 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 3a61f2bc9ac..99ad6fc9f5a 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -721,14 +721,13 @@ let rec check_exp env (exp:Ir.exp) : unit =
         warn env exp.at "the cases in this switch do not cover all possible values";
  *)
     check_cases env t1 t cases
-  | TryE (exp1, cases, exp2) ->
+  | TryE (exp1, cases, vt) ->
     check env.flavor.has_await "try in non-await flavor";
     check (env.async <> None) "misplaced try";
     check_exp env exp1;
     typ exp1 <: t;
     check_cases env T.catch t cases;
-    Option.iter (check_exp env) exp2;
-    Option.iter (fun exp2 -> typ exp2 <: Construct.bail_contT) exp2
+    Option.iter (fun (_, t) -> t <: Construct.bail_contT) vt
   | LoopE exp1 ->
     check_exp { env with lvl = NotTopLvl } exp1;
     typ exp1 <: T.unit;
diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index cefb3274f89..06fee694794 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -15,7 +15,7 @@ let nextN = "next"
 
 (* Identifiers *)
 
-type var = (string * T.typ)
+type var = (id * T.typ)
 
 let var id typ = (id, typ)
 
diff --git a/src/ir_def/construct.mli b/src/ir_def/construct.mli
index 6b2db75b919..7431b055920 100644
--- a/src/ir_def/construct.mli
+++ b/src/ir_def/construct.mli
@@ -21,8 +21,8 @@ val nextN : Type.lab
 
 type var
 
-val var : string -> typ -> var
-val id_of_var : var -> string
+val var : id -> typ -> var
+val id_of_var : var -> id
 val typ_of_var : var -> typ
 val arg_of_var : var -> arg
 val var_of_arg : arg -> var
diff --git a/src/ir_def/freevars.ml b/src/ir_def/freevars.ml
index 122137d65c2..f48771bc638 100644
--- a/src/ir_def/freevars.ml
+++ b/src/ir_def/freevars.ml
@@ -118,7 +118,7 @@ let rec exp e : f = match e.it with
   | FuncE (x, s, c, tp, as_, t, e) -> under_lambda (exp e /// args as_)
   | ActorE (ds, fs, u, _)  -> actor ds fs u
   | NewObjE (_, fs, _)  -> fields fs
-  | TryE (e, cs, cl)    -> exp e ++ cases cs ++ (match cl with Some e -> exp e | _ -> M.empty)
+  | TryE (e, cs, cl)    -> exp e ++ cases cs ++ (match cl with Some (v, t) -> exp Construct.(var v t |> varE) | _ -> M.empty)
   | SelfCallE (_, e1, e2, e3, e4) -> under_lambda (exp e1) ++ exps [e2; e3; e4]
 
 and actor ds fs u = close (decs ds +++ fields fs +++ system u)
diff --git a/src/ir_def/ir.ml b/src/ir_def/ir.ml
index c8cf014992f..ebd3852e071 100644
--- a/src/ir_def/ir.ml
+++ b/src/ir_def/ir.ml
@@ -73,8 +73,8 @@ and exp' =
       string * Type.func_sort * Type.control * typ_bind list * arg list * Type.typ list * exp
   | SelfCallE of Type.typ list * exp * exp * exp * exp (* essentially ICCallPrim (FuncE shared…) *)
   | ActorE of dec list * field list * system * Type.typ (* actor *)
-  | NewObjE of Type.obj_sort * field list * Type.typ  (* make an object *)
-  | TryE of exp * case list * exp option       (* try/catch/cleanup *)
+  | NewObjE of Type.obj_sort * field list * Type.typ     (* make an object *)
+  | TryE of exp * case list * (id * Type.typ) option (* try/catch/cleanup *)
 
 and system = {
   meta : meta;
diff --git a/src/ir_def/rename.ml b/src/ir_def/rename.ml
index af313181973..4aea8e37ea8 100644
--- a/src/ir_def/rename.ml
+++ b/src/ir_def/rename.ml
@@ -63,7 +63,7 @@ and exp' rho = function
      let e' = exp rho' e in
      FuncE (x, s, c, tp, p', ts, e')
   | NewObjE (s, fs, t)  -> NewObjE (s, fields rho fs, t)
-  | TryE (e, cs, cl)    -> TryE (exp rho e, cases rho cs, Option.map (exp rho) cl)
+  | TryE (e, cs, cl)    -> TryE (exp rho e, cases rho cs, Option.map (fun (v, t) -> id rho v, t) cl)
   | SelfCallE (ts, e1, e2, e3, e4) ->
      SelfCallE (ts, exp rho e1, exp rho e2, exp rho e3, exp rho e4)
 
diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 09b139e42c4..cb9791944b8 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -373,7 +373,7 @@ and c_exp' context exp k =
         ]
         (c_exp context' exp1 (ContVar k))
     ))
-  | TryE (exp1, cases, Some ({it = VarE id2; _} as exp2)) ->
+  | TryE (exp1, cases, Some (id2, typ2)) ->
     (* TODO: do we need to reify f? *)
     let f = match LabelEnv.find Throw context with Cont f -> f | _ -> assert false in
     letcont f (fun f ->
@@ -397,7 +397,7 @@ and c_exp' context exp k =
         }] in
       let throw = fresh_err_cont (answerT (typ_of_var k)) in
       let lab = function
-        | Cont k -> Cont (precont k (varE (var id2 (typ exp2))))
+        | Cont k -> Cont (precont k (varE (var id2 typ2)))
         | Label -> assert false
       in
       let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Cleanup | Throw -> fun c -> c) context in
diff --git a/src/ir_passes/const.ml b/src/ir_passes/const.ml
index abbb060047b..80f8389a5a6 100644
--- a/src/ir_passes/const.ml
+++ b/src/ir_passes/const.ml
@@ -157,10 +157,10 @@ let rec exp lvl (env : env) e : Lbool.t =
       exp_ lvl env e1;
       List.iter (case_ lvl env) cs;
       surely_false
-    | TryE (e1, cs, Some e2) ->
+    | TryE (e1, cs, Some (v, t)) ->
       exp_ lvl env e1;
       List.iter (case_ lvl env) cs;
-      exp_ lvl env e2;
+      exp_ lvl env Construct.(var v t |> varE);
       surely_false
     | NewObjE _ -> (* mutable objects *)
       surely_false
diff --git a/src/ir_passes/eq.ml b/src/ir_passes/eq.ml
index 7a504ed9f57..fe2c907e841 100644
--- a/src/ir_passes/eq.ml
+++ b/src/ir_passes/eq.ml
@@ -229,14 +229,14 @@ and t_exp' env = function
         cases
     in
     SwitchE (t_exp env exp1, cases')
-  | TryE (exp1, cases, exp2) ->
+  | TryE (exp1, cases, vt) ->
     let cases' =
       List.map
         (fun {it = {pat;exp}; at; note} ->
           {it = {pat = pat; exp = t_exp env exp}; at; note})
         cases
     in
-    TryE (t_exp env exp1, cases', Option.map (t_exp env) exp2)
+    TryE (t_exp env exp1, cases', vt)
   | LoopE exp1 ->
     LoopE (t_exp env exp1)
   | LabelE (id, typ, exp1) ->
diff --git a/src/ir_passes/erase_typ_field.ml b/src/ir_passes/erase_typ_field.ml
index 7ba5f63cd0d..69a6727c3bf 100644
--- a/src/ir_passes/erase_typ_field.ml
+++ b/src/ir_passes/erase_typ_field.ml
@@ -118,8 +118,8 @@ let transform prog =
       LabelE (id, t_typ typ, t_exp exp1)
     | AsyncE (s, tb, exp1, typ) ->
       AsyncE (s, t_typ_bind tb, t_exp exp1, t_typ typ)
-    | TryE (exp1, cases, exp2) ->
-      TryE (t_exp exp1, List.map t_case cases, Option.map t_exp exp2)
+    | TryE (exp1, cases, vt) ->
+      TryE (t_exp exp1, List.map t_case cases, vt)
     | DeclareE (id, typ, exp1) ->
       DeclareE (id, t_typ typ, t_exp exp1)
     | DefineE (id, mut ,exp1) ->
diff --git a/src/ir_passes/show.ml b/src/ir_passes/show.ml
index 0125b5cfabc..379899ec0c3 100644
--- a/src/ir_passes/show.ml
+++ b/src/ir_passes/show.ml
@@ -271,14 +271,14 @@ and t_exp' env = function
         cases
     in
     SwitchE (t_exp env exp1, cases')
-  | TryE (exp1, cases, exp2) ->
+  | TryE (exp1, cases, vt) ->
     let cases' =
       List.map
         (fun {it = {pat;exp}; at; note} ->
           {it = {pat; exp = t_exp env exp}; at; note})
         cases
     in
-    TryE (t_exp env exp1, cases', Option.map (t_exp env) exp2)
+    TryE (t_exp env exp1, cases', vt)
   | LoopE exp1 ->
     LoopE (t_exp env exp1)
   | LabelE (id, typ, exp1) ->
diff --git a/src/ir_passes/tailcall.ml b/src/ir_passes/tailcall.ml
index c539ae7dd5a..4fe1646e599 100644
--- a/src/ir_passes/tailcall.ml
+++ b/src/ir_passes/tailcall.ml
@@ -92,7 +92,7 @@ and assignEs vars exp : dec list =
     List.mapi (fun i v -> expD (assignE v (projE (varE v) i))) vars
 
 and exp' env e  : exp' = match e.it with
-  | VarE _ | LitE _     -> e.it
+  | (VarE _ | LitE _) as it -> it
   | AssignE (e1, e2)    -> AssignE (lexp env e1, exp env e2)
   | PrimE (CallPrim insts, [e1; e2])  ->
     begin match e1.it, env with
@@ -106,7 +106,7 @@ and exp' env e  : exp' = match e.it with
   | BlockE (ds, e)      -> BlockE (block env ds e)
   | IfE (e1, e2, e3)    -> IfE (exp env e1, tailexp env e2, tailexp env e3)
   | SwitchE (e, cs)     -> SwitchE (exp env e, cases env cs)
-  | TryE (e, cs, e2)    -> TryE (exp env e, cases env cs, Option.map (exp env) e2) (* TBR *)
+  | TryE (e, cs, e2)    -> TryE (exp env e, cases env cs, e2) (* TBR *)
   | LoopE e1            -> LoopE (exp env e1)
   | LabelE (i, t, e)    -> let env1 = bind env i None in
                            LabelE(i, t, exp env1 e)
diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index 886ecd2b02d..93f0ddfc4f8 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -223,7 +223,7 @@ and exp' at note = function
     let th = fresh_var "thunk" thunk.note.Note.typ in
     let v = fresh_var "res" note.Note.typ in
     (blockE [ letD th thunk
-            ; letD v { e1 with it = I.TryE (exp e1, cases cs, Some (varE th)); note }
+            ; letD v { e1 with it = I.TryE (exp e1, cases cs, Some (id_of_var th, typ_of_var th)); note }
             ; expD (varE th -*- unitE ())
             ] (varE v)).it
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it

From 1afaf35e3276fac34d88d2d48abfe14ff7f91218 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 19 Jun 2024 17:14:30 +0200
Subject: [PATCH 100/179] fix the import loop

---
 src/ir_def/freevars.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_def/freevars.ml b/src/ir_def/freevars.ml
index f48771bc638..36abdb6fe0a 100644
--- a/src/ir_def/freevars.ml
+++ b/src/ir_def/freevars.ml
@@ -118,7 +118,7 @@ let rec exp e : f = match e.it with
   | FuncE (x, s, c, tp, as_, t, e) -> under_lambda (exp e /// args as_)
   | ActorE (ds, fs, u, _)  -> actor ds fs u
   | NewObjE (_, fs, _)  -> fields fs
-  | TryE (e, cs, cl)    -> exp e ++ cases cs ++ (match cl with Some (v, t) -> exp Construct.(var v t |> varE) | _ -> M.empty)
+  | TryE (e, cs, cl)    -> exp e ++ cases cs ++ (match cl with Some (v, _) -> id v | _ -> M.empty)
   | SelfCallE (_, e1, e2, e3, e4) -> under_lambda (exp e1) ++ exps [e2; e3; e4]
 
 and actor ds fs u = close (decs ds +++ fields fs +++ system u)

From 064ef7f89fd7eaf5bf7c43e6d7c8efe6fed95f91 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 20 Jun 2024 14:10:34 +0200
Subject: [PATCH 101/179] tweak

---
 src/ir_def/construct.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
index 06fee694794..5014b8848ab 100644
--- a/src/ir_def/construct.ml
+++ b/src/ir_def/construct.ml
@@ -15,7 +15,7 @@ let nextN = "next"
 
 (* Identifiers *)
 
-type var = (id * T.typ)
+type var = id * T.typ
 
 let var id typ = (id, typ)
 

From 2f5fc5e82147d20986b2e0c761ba075b421a9771 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 20 Jun 2024 16:17:25 +0200
Subject: [PATCH 102/179] WIP: improve the aliasing situation by eta-expansion

---
 src/ir_passes/await.ml                   |  2 +-
 test/run-drun/ok/try-finally.comp-ref.ok | 12 ------------
 test/run-drun/ok/try-finally.comp.ok     | 12 ------------
 test/run-drun/ok/try-finally.diff-low.ok | 14 +-------------
 test/run-drun/ok/try-finally.run-low.ok  | 12 ------------
 5 files changed, 2 insertions(+), 50 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index cb9791944b8..5a62f61fe27 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -39,7 +39,7 @@ let letcont k scope =
 
 (* pre-compose a continuation with a call to a `finally`-thunk *)
 let precont k thunk =
-  let finally = blockE [expD (thunk -*- unitE ())] in
+  let finally e = blockE [expD (thunk -*- unitE ())] e in
   match k with
   | ContVar k' ->
      let typ = match typ_of_var k' with
diff --git a/test/run-drun/ok/try-finally.comp-ref.ok b/test/run-drun/ok/try-finally.comp-ref.ok
index 92aa54faef3..17ae6cdff2f 100644
--- a/test/run-drun/ok/try-finally.comp-ref.ok
+++ b/test/run-drun/ok/try-finally.comp-ref.ok
@@ -1,18 +1,6 @@
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/2/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
 (VarE $$thunk/2/0)
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/10/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
 (VarE $$thunk/10/0)
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/9/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
 (VarE $$thunk/9/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.comp.ok b/test/run-drun/ok/try-finally.comp.ok
index 92aa54faef3..17ae6cdff2f 100644
--- a/test/run-drun/ok/try-finally.comp.ok
+++ b/test/run-drun/ok/try-finally.comp.ok
@@ -1,18 +1,6 @@
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/2/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
 (VarE $$thunk/2/0)
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/10/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
 (VarE $$thunk/10/0)
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/9/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
 (VarE $$thunk/9/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.diff-low.ok b/test/run-drun/ok/try-finally.diff-low.ok
index 587d72c355f..e5a843a4344 100644
--- a/test/run-drun/ok/try-finally.diff-low.ok
+++ b/test/run-drun/ok/try-finally.diff-low.ok
@@ -1,21 +1,9 @@
 --- try-finally.run
 +++ try-finally.run-low
-@@ -0,0 +1,18 @@
-+IR has aliasing (or Check_ir visits nodes twice):
-+(PrimE (CallPrim) (VarE $$thunk/2/0) (PrimE TupPrim))
+@@ -0,0 +1,6 @@
 +IR has aliasing (or Check_ir visits nodes twice):
 +(VarE $$thunk/2/0)
 +IR has aliasing (or Check_ir visits nodes twice):
-+(PrimE TupPrim)
-+IR has aliasing (or Check_ir visits nodes twice):
-+(PrimE (CallPrim) (VarE $$thunk/10/0) (PrimE TupPrim))
-+IR has aliasing (or Check_ir visits nodes twice):
 +(VarE $$thunk/10/0)
 +IR has aliasing (or Check_ir visits nodes twice):
-+(PrimE TupPrim)
-+IR has aliasing (or Check_ir visits nodes twice):
-+(PrimE (CallPrim) (VarE $$thunk/9/0) (PrimE TupPrim))
-+IR has aliasing (or Check_ir visits nodes twice):
 +(VarE $$thunk/9/0)
-+IR has aliasing (or Check_ir visits nodes twice):
-+(PrimE TupPrim)
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index 92aa54faef3..17ae6cdff2f 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -1,18 +1,6 @@
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/2/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
 (VarE $$thunk/2/0)
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/10/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
 (VarE $$thunk/10/0)
 IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE (CallPrim) (VarE $$thunk/9/0) (PrimE TupPrim))
-IR has aliasing (or Check_ir visits nodes twice):
 (VarE $$thunk/9/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(PrimE TupPrim)

From 09c057550d4098e63e24953fc17a0d6473727801 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 20 Jun 2024 16:22:18 +0200
Subject: [PATCH 103/179] fix the aliasing situation using `varE` just-in-time

---
 src/ir_passes/await.ml                   | 6 +++---
 test/run-drun/ok/try-finally.comp-ref.ok | 6 ------
 test/run-drun/ok/try-finally.comp.ok     | 6 ------
 test/run-drun/ok/try-finally.diff-low.ok | 9 ---------
 test/run-drun/ok/try-finally.run-low.ok  | 6 ------
 5 files changed, 3 insertions(+), 30 deletions(-)
 delete mode 100644 test/run-drun/ok/try-finally.comp-ref.ok
 delete mode 100644 test/run-drun/ok/try-finally.comp.ok
 delete mode 100644 test/run-drun/ok/try-finally.diff-low.ok
 delete mode 100644 test/run-drun/ok/try-finally.run-low.ok

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 5a62f61fe27..634cda2d39a 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -38,8 +38,8 @@ let letcont k scope =
             (scope k')
 
 (* pre-compose a continuation with a call to a `finally`-thunk *)
-let precont k thunk =
-  let finally e = blockE [expD (thunk -*- unitE ())] e in
+let precont k vthunk =
+  let finally e = blockE [expD (varE vthunk -*- unitE ())] e in
   match k with
   | ContVar k' ->
      let typ = match typ_of_var k' with
@@ -397,7 +397,7 @@ and c_exp' context exp k =
         }] in
       let throw = fresh_err_cont (answerT (typ_of_var k)) in
       let lab = function
-        | Cont k -> Cont (precont k (varE (var id2 typ2)))
+        | Cont k -> Cont (precont k (var id2 typ2))
         | Label -> assert false
       in
       let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Cleanup | Throw -> fun c -> c) context in
diff --git a/test/run-drun/ok/try-finally.comp-ref.ok b/test/run-drun/ok/try-finally.comp-ref.ok
deleted file mode 100644
index 17ae6cdff2f..00000000000
--- a/test/run-drun/ok/try-finally.comp-ref.ok
+++ /dev/null
@@ -1,6 +0,0 @@
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/2/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/10/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/9/0)
diff --git a/test/run-drun/ok/try-finally.comp.ok b/test/run-drun/ok/try-finally.comp.ok
deleted file mode 100644
index 17ae6cdff2f..00000000000
--- a/test/run-drun/ok/try-finally.comp.ok
+++ /dev/null
@@ -1,6 +0,0 @@
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/2/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/10/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/9/0)
diff --git a/test/run-drun/ok/try-finally.diff-low.ok b/test/run-drun/ok/try-finally.diff-low.ok
deleted file mode 100644
index e5a843a4344..00000000000
--- a/test/run-drun/ok/try-finally.diff-low.ok
+++ /dev/null
@@ -1,9 +0,0 @@
---- try-finally.run
-+++ try-finally.run-low
-@@ -0,0 +1,6 @@
-+IR has aliasing (or Check_ir visits nodes twice):
-+(VarE $$thunk/2/0)
-+IR has aliasing (or Check_ir visits nodes twice):
-+(VarE $$thunk/10/0)
-+IR has aliasing (or Check_ir visits nodes twice):
-+(VarE $$thunk/9/0)
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
deleted file mode 100644
index 17ae6cdff2f..00000000000
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ /dev/null
@@ -1,6 +0,0 @@
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/2/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/10/0)
-IR has aliasing (or Check_ir visits nodes twice):
-(VarE $$thunk/9/0)

From 3b21f51931a30db21fc780ef142d9483379570ea Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 20 Jun 2024 18:01:47 +0200
Subject: [PATCH 104/179] done (almost)

---
 src/mo_def/syntax.ml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/mo_def/syntax.ml b/src/mo_def/syntax.ml
index 60271ed9097..f20e2168f0d 100644
--- a/src/mo_def/syntax.ml
+++ b/src/mo_def/syntax.ml
@@ -196,7 +196,6 @@ and exp' =
   | TryE of exp * case list * exp option       (* catch exception / finally *)
   | IgnoreE of exp                             (* ignore *)
 (*
-  | FinalE of exp * exp                        (* finally *)
   | AtomE of string                            (* atom *)
 *)
 

From 16a4f844deafe27ad39820f853a75c932e2299e0 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 20 Jun 2024 21:49:25 +0200
Subject: [PATCH 105/179] WIP: first shot at the IR-interpreter

---
 src/ir_interpreter/interpret_ir.ml | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index c077e089c80..eee16385e0b 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -492,10 +492,21 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     interpret_exp env exp1 (fun v1 ->
       interpret_cases env cases exp.at v1 k
     )
-  | TryE (exp1, cases, _TODO) ->
+  | TryE (exp1, cases, None) ->
     let k' = fun v1 -> interpret_catches env cases exp.at v1 k in
     let env' = { env with throws = Some k' } in
     interpret_exp env' exp1 k
+  | TryE (exp1, cases, Some (id, ty)) ->
+    let exp2 = Construct.(varE (var id ty)) in
+    let k' v1 =
+      let cleanup v2 = interpret_exp env exp2 (fun _ -> k v2) in
+      interpret_catches env cases exp.at v1 cleanup in
+    let out ret v = interpret_exp env exp2 (fun _ -> ret v) in
+    let env' = { env with throws = Some k'
+                        ; rets = Option.map out env.rets
+                        ; labs = V.Env.map out env.labs } in
+    let k'' v2 = interpret_exp env' exp2 (fun _ -> k v2) in
+    interpret_exp env' exp1 k''
   | LoopE exp1 ->
     interpret_exp env exp1 (fun v -> V.as_unit v; interpret_exp env exp k)
   | LabelE (id, _typ, exp1) ->

From ce0c3f5d01f589de3eee3f2cdc3d76cd8bb4367c Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 10:16:21 +0200
Subject: [PATCH 106/179] WIP: activate the interpreters

---
 test/run-drun/ok/try-finally.run-ir.ok  | 2 ++
 test/run-drun/ok/try-finally.run-low.ok | 2 ++
 test/run-drun/ok/try-finally.run.ok     | 2 ++
 test/run-drun/try-finally.mo            | 2 +-
 4 files changed, 7 insertions(+), 1 deletion(-)
 create mode 100644 test/run-drun/ok/try-finally.run-ir.ok
 create mode 100644 test/run-drun/ok/try-finally.run-low.ok
 create mode 100644 test/run-drun/ok/try-finally.run.ok

diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
new file mode 100644
index 00000000000..37d6ccc5160
--- /dev/null
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -0,0 +1,2 @@
+IN
+try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
new file mode 100644
index 00000000000..37d6ccc5160
--- /dev/null
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -0,0 +1,2 @@
+IN
+try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
new file mode 100644
index 00000000000..37d6ccc5160
--- /dev/null
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -0,0 +1,2 @@
+IN
+try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index eeeba75a607..b2c8f94aa8f 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -160,4 +160,4 @@ actor A {
 
 //SKIP ic-ref-run
 
-//A.go(); //OR-CALL ingress go "DIDL\x00\x00"
+A.go(); //OR-CALL ingress go "DIDL\x00\x00"

From 3c9b32389691f4ba1959bb82e7be61617bd74893 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 10:24:16 +0200
Subject: [PATCH 107/179] more tests

---
 test/run-drun/ok/try-finally.drun-run.ok | 6 ++++++
 test/run-drun/ok/try-finally.tc.ok       | 8 ++++++++
 test/run-drun/try-finally.mo             | 8 ++++----
 3 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 1eda019d66e..61b6c48fe1f 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -16,6 +16,12 @@ debug.print: OUT2
 debug.print: IN2i
 debug.print: CAUGHT2i
 debug.print: OUT2i
+debug.print: IN3
+debug.print: OUT3
+debug.print: BEFORE5
+debug.print: IN5
+debug.print: OUT5
+debug.print: AFTER5
 debug.print: BEFORE6
 debug.print: IN6
 debug.print: InnerIN6
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 280e00e44c5..7e612904a3d 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -10,6 +10,14 @@ try-finally.mo:22.9-23.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
+try-finally.mo:59.9-64.38: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:78.19-84.38: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
 try-finally.mo:92.13-98.49: warning [M0145], this try handler of type
   Error
 does not cover value
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index b2c8f94aa8f..a0b0b15e580 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -54,7 +54,7 @@ actor A {
         catch _ { debugPrint "CAUGHT2i"; 42 }
         finally { debugPrint "OUT2i" };
     };
-/*
+
     func t3() : async () {
         try {
             debugPrint "IN3";
@@ -84,7 +84,7 @@ actor A {
         finally { debugPrint "OUT5" };
         debugPrint "AFTER5"
     };
-*/
+
     func t6() : async () {
         debugPrint "BEFORE6";
         label out try {
@@ -149,9 +149,9 @@ actor A {
         //await t1();
         await t2();
         ignore await t2i();
-        /*await t3();
+        await t3();
         /*await t4();*/
-        await t5();*/
+        await t5();
         await t6();
         try await t6t() catch _ {};
         try await t6d() catch _ {};

From ed4e6d9716b0d056a19c38a388f70fdd14dbeac2 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 10:30:09 +0200
Subject: [PATCH 108/179] WIP: arrange the non-trapping ones to the front

this way the interpreters get their chance
---
 test/run-drun/ok/try-finally.diff-ir.ok  | 20 ++++++++++++++++++++
 test/run-drun/ok/try-finally.drun-run.ok | 20 ++++++++++----------
 test/run-drun/ok/try-finally.run-ir.ok   | 15 +++++++++++++++
 test/run-drun/ok/try-finally.run-low.ok  | 19 +++++++++++++++++++
 test/run-drun/ok/try-finally.run.ok      | 19 +++++++++++++++++++
 test/run-drun/try-finally.mo             |  9 ++++++---
 6 files changed, 89 insertions(+), 13 deletions(-)
 create mode 100644 test/run-drun/ok/try-finally.diff-ir.ok

diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
new file mode 100644
index 00000000000..417a18169f0
--- /dev/null
+++ b/test/run-drun/ok/try-finally.diff-ir.ok
@@ -0,0 +1,20 @@
+--- try-finally.run
++++ try-finally.run-ir
+@@ -5,17 +5,13 @@
+ CAUGHT2i
+ OUT2i
+ IN3
+-OUT3
+ BEFORE5
+ IN5
+-OUT5
+ AFTER5
+ BEFORE6
+ IN6
+ InnerIN6
+ InnerLIVE6
+-InnerOUT6
+-OUT6
+ AFTER6
+ IN
+ try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 61b6c48fe1f..d4ab795b448 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -1,15 +1,5 @@
 ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
 ingress Completed: Reply: 0x4449444c0000
-debug.print: IN
-debug.print: OUT
-debug.print: CLEANUP_E
-debug.print: INr
-debug.print: OUTr
-debug.print: CLEANUP_E
-debug.print: INd
-debug.print: AGAINd
-debug.print: OUTd
-debug.print: CLEANUP_E
 debug.print: IN2
 debug.print: CAUGHT2
 debug.print: OUT2
@@ -29,6 +19,16 @@ debug.print: InnerLIVE6
 debug.print: InnerOUT6
 debug.print: OUT6
 debug.print: AFTER6
+debug.print: IN
+debug.print: OUT
+debug.print: CLEANUP_E
+debug.print: INr
+debug.print: OUTr
+debug.print: CLEANUP_E
+debug.print: INd
+debug.print: AGAINd
+debug.print: OUTd
+debug.print: CLEANUP_E
 debug.print: BEFORE6t
 debug.print: IN6t
 debug.print: InnerIN6t
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index 37d6ccc5160..3d504f3e9b6 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -1,2 +1,17 @@
+IN2
+CAUGHT2
+OUT2
+IN2i
+CAUGHT2i
+OUT2i
+IN3
+BEFORE5
+IN5
+AFTER5
+BEFORE6
+IN6
+InnerIN6
+InnerLIVE6
+AFTER6
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index 37d6ccc5160..2ae249b17fa 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -1,2 +1,21 @@
+IN2
+CAUGHT2
+OUT2
+IN2i
+CAUGHT2i
+OUT2i
+IN3
+OUT3
+BEFORE5
+IN5
+OUT5
+AFTER5
+BEFORE6
+IN6
+InnerIN6
+InnerLIVE6
+InnerOUT6
+OUT6
+AFTER6
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index 37d6ccc5160..2ae249b17fa 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -1,2 +1,21 @@
+IN2
+CAUGHT2
+OUT2
+IN2i
+CAUGHT2i
+OUT2i
+IN3
+OUT3
+BEFORE5
+IN5
+OUT5
+AFTER5
+BEFORE6
+IN6
+InnerIN6
+InnerLIVE6
+InnerOUT6
+OUT6
+AFTER6
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index a0b0b15e580..27a6bf788bb 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -143,9 +143,7 @@ actor A {
     // TODO: trap after repeated `await`
 
     public func go() : async () {
-        try /*ignore*/ await t0() catch _ {};
-        try await t0r() catch _ {};
-        try await t0d() catch _ {};
+        // These don't trap (for the interpreters)
         //await t1();
         await t2();
         ignore await t2i();
@@ -153,6 +151,11 @@ actor A {
         /*await t4();*/
         await t5();
         await t6();
+
+        // These trap, and only work on drun
+        try /*ignore*/ await t0() catch _ {};
+        try await t0r() catch _ {};
+        try await t0d() catch _ {};
         try await t6t() catch _ {};
         try await t6d() catch _ {};
     };

From 93e73f76373a94b351df4f9186fc05130519f5e9 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 10:40:33 +0200
Subject: [PATCH 109/179] another test

---
 test/run-drun/ok/try-finally.diff-ir.ok  |  4 +++-
 test/run-drun/ok/try-finally.drun-run.ok |  2 ++
 test/run-drun/ok/try-finally.run-ir.ok   |  2 ++
 test/run-drun/ok/try-finally.run-low.ok  |  2 ++
 test/run-drun/ok/try-finally.run.ok      |  2 ++
 test/run-drun/ok/try-finally.tc.ok       | 18 +++++++++++-------
 test/run-drun/try-finally.mo             |  9 +++++----
 7 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
index 417a18169f0..e0f92bc0569 100644
--- a/test/run-drun/ok/try-finally.diff-ir.ok
+++ b/test/run-drun/ok/try-finally.diff-ir.ok
@@ -1,10 +1,12 @@
 --- try-finally.run
 +++ try-finally.run-ir
-@@ -5,17 +5,13 @@
+@@ -5,19 +5,15 @@
  CAUGHT2i
  OUT2i
  IN3
 -OUT3
+ IN4
+ OUT4
  BEFORE5
  IN5
 -OUT5
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index d4ab795b448..f0f71491c33 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -8,6 +8,8 @@ debug.print: CAUGHT2i
 debug.print: OUT2i
 debug.print: IN3
 debug.print: OUT3
+debug.print: IN4
+debug.print: OUT4
 debug.print: BEFORE5
 debug.print: IN5
 debug.print: OUT5
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index 3d504f3e9b6..aad57d27a62 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -5,6 +5,8 @@ IN2i
 CAUGHT2i
 OUT2i
 IN3
+IN4
+OUT4
 BEFORE5
 IN5
 AFTER5
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index 2ae249b17fa..ed50aa2304e 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -6,6 +6,8 @@ CAUGHT2i
 OUT2i
 IN3
 OUT3
+IN4
+OUT4
 BEFORE5
 IN5
 OUT5
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index 2ae249b17fa..ed50aa2304e 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -6,6 +6,8 @@ CAUGHT2i
 OUT2i
 IN3
 OUT3
+IN4
+OUT4
 BEFORE5
 IN5
 OUT5
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 7e612904a3d..8cb20955d25 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -14,31 +14,35 @@ try-finally.mo:59.9-64.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:78.19-84.38: warning [M0145], this try handler of type
+try-finally.mo:69.9-73.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:92.13-98.49: warning [M0145], this try handler of type
+try-finally.mo:79.19-85.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:90.19-101.38: warning [M0145], this try handler of type
+try-finally.mo:93.13-99.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:109.13-115.50: warning [M0145], this try handler of type
+try-finally.mo:91.19-102.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:107.19-118.39: warning [M0145], this try handler of type
+try-finally.mo:110.13-116.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:126.13-135.50: warning [M0145], this try handler of type
+try-finally.mo:108.19-119.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:124.19-138.39: warning [M0145], this try handler of type
+try-finally.mo:127.13-136.50: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:125.19-139.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 27a6bf788bb..71a5a20c80d 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -63,16 +63,17 @@ actor A {
         }
         finally { debugPrint "OUT3" };
     };
-/*
-    // check that finally not running twice
+
+    // check that finally is not running twice
     func t4() : async () {
         try {
             debugPrint "IN4";
+            await m();
         }
         finally { debugPrint "OUT4" };
         return;
     };
-*/
+
     func t5() : async () {
         debugPrint "BEFORE5";
         label out try {
@@ -148,7 +149,7 @@ actor A {
         await t2();
         ignore await t2i();
         await t3();
-        /*await t4();*/
+        await t4();
         await t5();
         await t6();
 

From 54e7f937adbeb1194468b919fb8c88816d132a13 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 12:32:14 +0200
Subject: [PATCH 110/179] expose the double invocation in
 `src/mo_interpreter/interpret.ml`

---
 test/run-drun/ok/try-finally.diff-ir.ok  |  5 ++++-
 test/run-drun/ok/try-finally.drun-run.ok |  2 ++
 test/run-drun/ok/try-finally.run-ir.ok   |  2 ++
 test/run-drun/ok/try-finally.run-low.ok  |  2 ++
 test/run-drun/ok/try-finally.run.ok      |  3 +++
 test/run-drun/ok/try-finally.tc.ok       | 18 +++++++++++-------
 test/run-drun/try-finally.mo             |  9 +++++++++
 7 files changed, 33 insertions(+), 8 deletions(-)

diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
index e0f92bc0569..0e723592d92 100644
--- a/test/run-drun/ok/try-finally.diff-ir.ok
+++ b/test/run-drun/ok/try-finally.diff-ir.ok
@@ -1,12 +1,15 @@
 --- try-finally.run
 +++ try-finally.run-ir
-@@ -5,19 +5,15 @@
+@@ -5,22 +5,17 @@
  CAUGHT2i
  OUT2i
  IN3
 -OUT3
  IN4
  OUT4
+ IN4f
+ OUT4f
+-OUT4f
  BEFORE5
  IN5
 -OUT5
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index f0f71491c33..319172bb676 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -10,6 +10,8 @@ debug.print: IN3
 debug.print: OUT3
 debug.print: IN4
 debug.print: OUT4
+debug.print: IN4f
+debug.print: OUT4f
 debug.print: BEFORE5
 debug.print: IN5
 debug.print: OUT5
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index aad57d27a62..5c8cb28bf03 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -7,6 +7,8 @@ OUT2i
 IN3
 IN4
 OUT4
+IN4f
+OUT4f
 BEFORE5
 IN5
 AFTER5
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index ed50aa2304e..cd884ce4004 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -8,6 +8,8 @@ IN3
 OUT3
 IN4
 OUT4
+IN4f
+OUT4f
 BEFORE5
 IN5
 OUT5
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index ed50aa2304e..1b1442c1d4e 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -8,6 +8,9 @@ IN3
 OUT3
 IN4
 OUT4
+IN4f
+OUT4f
+OUT4f
 BEFORE5
 IN5
 OUT5
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 8cb20955d25..ce99b18ba0c 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -18,31 +18,35 @@ try-finally.mo:69.9-73.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:79.19-85.38: warning [M0145], this try handler of type
+try-finally.mo:78.9-82.47: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:93.13-99.49: warning [M0145], this try handler of type
+try-finally.mo:87.19-93.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:91.19-102.38: warning [M0145], this try handler of type
+try-finally.mo:101.13-107.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:110.13-116.50: warning [M0145], this try handler of type
+try-finally.mo:99.19-110.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:108.19-119.39: warning [M0145], this try handler of type
+try-finally.mo:118.13-124.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:127.13-136.50: warning [M0145], this try handler of type
+try-finally.mo:116.19-127.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:125.19-139.39: warning [M0145], this try handler of type
+try-finally.mo:135.13-144.50: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:133.19-147.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 71a5a20c80d..e6cf22b3552 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -74,6 +74,14 @@ actor A {
         return;
     };
 
+    func t4f() : async () {
+        try {
+            debugPrint "IN4f";
+            await m();
+        }
+        finally { debugPrint "OUT4f"; return };
+    };
+
     func t5() : async () {
         debugPrint "BEFORE5";
         label out try {
@@ -150,6 +158,7 @@ actor A {
         ignore await t2i();
         await t3();
         await t4();
+        await t4f();
         await t5();
         await t6();
 

From cbc658b3458be9988174b2a4e210ea87becf33dd Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 12:38:08 +0200
Subject: [PATCH 111/179] fix the double-invocation

---
 src/ir_interpreter/interpret_ir.ml      | 2 +-
 src/mo_interpreter/interpret.ml         | 2 +-
 test/run-drun/ok/try-finally.diff-ir.ok | 3 +--
 test/run-drun/ok/try-finally.run.ok     | 1 -
 4 files changed, 3 insertions(+), 5 deletions(-)

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index eee16385e0b..e9f2c1e59d9 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -505,7 +505,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     let env' = { env with throws = Some k'
                         ; rets = Option.map out env.rets
                         ; labs = V.Env.map out env.labs } in
-    let k'' v2 = interpret_exp env' exp2 (fun _ -> k v2) in
+    let k'' v2 = interpret_exp env exp2 (fun _ -> k v2) in
     interpret_exp env' exp1 k''
   | LoopE exp1 ->
     interpret_exp env exp1 (fun v -> V.as_unit v; interpret_exp env exp k)
diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index b2539e6ad1a..cf727344ff3 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -632,7 +632,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     let env' = { env with throws = Some k'
                         ; rets = Option.map out env.rets
                         ; labs = V.Env.map out env.labs } in
-    let k'' v2 = interpret_exp env' exp2 (fun _ -> k v2) in
+    let k'' v2 = interpret_exp env exp2 (fun _ -> k v2) in
     interpret_exp env' exp1 k''
   | WhileE (exp1, exp2) ->
     let k_continue = fun v -> V.as_unit v; interpret_exp env exp k in
diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
index 0e723592d92..01a13edcdbb 100644
--- a/test/run-drun/ok/try-finally.diff-ir.ok
+++ b/test/run-drun/ok/try-finally.diff-ir.ok
@@ -1,6 +1,6 @@
 --- try-finally.run
 +++ try-finally.run-ir
-@@ -5,22 +5,17 @@
+@@ -5,21 +5,17 @@
  CAUGHT2i
  OUT2i
  IN3
@@ -9,7 +9,6 @@
  OUT4
  IN4f
  OUT4f
--OUT4f
  BEFORE5
  IN5
 -OUT5
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index 1b1442c1d4e..cd884ce4004 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -10,7 +10,6 @@ IN4
 OUT4
 IN4f
 OUT4f
-OUT4f
 BEFORE5
 IN5
 OUT5

From 9c13b49191d7cd46ee6b4c4197ac30ad9421e07e Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 12:39:19 +0200
Subject: [PATCH 112/179] tweak

---
 src/ir_interpreter/interpret_ir.ml | 2 +-
 src/mo_interpreter/interpret.ml    | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index e9f2c1e59d9..a7490698192 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -502,10 +502,10 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
       let cleanup v2 = interpret_exp env exp2 (fun _ -> k v2) in
       interpret_catches env cases exp.at v1 cleanup in
     let out ret v = interpret_exp env exp2 (fun _ -> ret v) in
+    let k'' v2 = interpret_exp env exp2 (fun _ -> k v2) in
     let env' = { env with throws = Some k'
                         ; rets = Option.map out env.rets
                         ; labs = V.Env.map out env.labs } in
-    let k'' v2 = interpret_exp env exp2 (fun _ -> k v2) in
     interpret_exp env' exp1 k''
   | LoopE exp1 ->
     interpret_exp env exp1 (fun v -> V.as_unit v; interpret_exp env exp k)
diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index cf727344ff3..13255971a58 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -629,10 +629,10 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
       let cleanup v2 = interpret_exp env exp2 (fun _ -> k v2) in
       interpret_catches env cases exp.at v1 cleanup in
     let out ret v = interpret_exp env exp2 (fun _ -> ret v) in
+    let k'' v2 = interpret_exp env exp2 (fun _ -> k v2) in
     let env' = { env with throws = Some k'
                         ; rets = Option.map out env.rets
                         ; labs = V.Env.map out env.labs } in
-    let k'' v2 = interpret_exp env exp2 (fun _ -> k v2) in
     interpret_exp env' exp1 k''
   | WhileE (exp1, exp2) ->
     let k_continue = fun v -> V.as_unit v; interpret_exp env exp k in

From dd1dc6a11e3a331eedb7709b29c5a800a31e89e3 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 13:16:14 +0200
Subject: [PATCH 113/179] typos

---
 src/ir_interpreter/interpret_ir.ml | 2 +-
 src/mo_interpreter/interpret.ml    | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index a7490698192..8748c17c546 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -338,7 +338,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
         let id = V.as_blob v1 in
         begin match V.Env.find_opt id !(env.actor_env) with
         (* not quite correct: On the platform, you can invoke and get a reject *)
-        | None -> trap exp.at "Unkown actor \"%s\"" id
+        | None -> trap exp.at "Unknown actor \"%s\"" id
         | Some actor_value ->
           let fs = V.as_obj actor_value in
           match V.Env.find_opt n fs with
diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index 13255971a58..9bbf34958ba 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -511,7 +511,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
       | V.Blob aid when T.sub exp1.note.note_typ (T.Obj (T.Actor, [])) ->
         begin match V.Env.find_opt aid !(env.actor_env) with
         (* not quite correct: On the platform, you can invoke and get a reject *)
-        | None -> trap exp.at "Unkown actor \"%s\"" aid
+        | None -> trap exp.at "Unknown actor \"%s\"" aid
         | Some actor_value ->
           let fs = V.as_obj actor_value in
           match V.Env.find_opt id.it fs with

From 3da429064e6e5da218ca76522e687406f0a2bd41 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 15:28:24 +0200
Subject: [PATCH 114/179] interpreting `TryE` makes only sense in non-lowered
 code, as it gets eliminated in `await.ml`

---
 src/ir_interpreter/interpret_ir.ml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index 8748c17c546..afc04162ad7 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -497,6 +497,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     let env' = { env with throws = Some k' } in
     interpret_exp env' exp1 k
   | TryE (exp1, cases, Some (id, ty)) ->
+    assert env.flavor.has_await;
     let exp2 = Construct.(varE (var id ty)) in
     let k' v1 =
       let cleanup v2 = interpret_exp env exp2 (fun _ -> k v2) in

From 837dd180c5a777ef225413b70f500cf5a5e2af13 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 15:56:44 +0200
Subject: [PATCH 115/179] fix the IR interpreter

- _call_ `exp2`
- assert that the evaluation yields a unit
- remove the kludge (only needed in the AST interpreter)
  because we have already done some work in the desugarer
---
 src/ir_interpreter/interpret_ir.ml      | 10 ++++------
 test/run-drun/ok/try-finally.diff-ir.ok | 24 ------------------------
 test/run-drun/ok/try-finally.run-ir.ok  |  4 ++++
 3 files changed, 8 insertions(+), 30 deletions(-)
 delete mode 100644 test/run-drun/ok/try-finally.diff-ir.ok

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index afc04162ad7..c53cb87f8b7 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -498,16 +498,14 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     interpret_exp env' exp1 k
   | TryE (exp1, cases, Some (id, ty)) ->
     assert env.flavor.has_await;
-    let exp2 = Construct.(varE (var id ty)) in
+    let exp2 = Construct.(varE (var id ty) -*- unitE ()) in
     let k' v1 =
-      let cleanup v2 = interpret_exp env exp2 (fun _ -> k v2) in
-      interpret_catches env cases exp.at v1 cleanup in
-    let out ret v = interpret_exp env exp2 (fun _ -> ret v) in
-    let k'' v2 = interpret_exp env exp2 (fun _ -> k v2) in
+      interpret_catches env cases exp.at v1 k in
+    let out ret v = interpret_exp env exp2 (fun u -> V.as_unit u; ret v) in
     let env' = { env with throws = Some k'
                         ; rets = Option.map out env.rets
                         ; labs = V.Env.map out env.labs } in
-    interpret_exp env' exp1 k''
+    interpret_exp env' exp1 k
   | LoopE exp1 ->
     interpret_exp env exp1 (fun v -> V.as_unit v; interpret_exp env exp k)
   | LabelE (id, _typ, exp1) ->
diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
deleted file mode 100644
index 01a13edcdbb..00000000000
--- a/test/run-drun/ok/try-finally.diff-ir.ok
+++ /dev/null
@@ -1,24 +0,0 @@
---- try-finally.run
-+++ try-finally.run-ir
-@@ -5,21 +5,17 @@
- CAUGHT2i
- OUT2i
- IN3
--OUT3
- IN4
- OUT4
- IN4f
- OUT4f
- BEFORE5
- IN5
--OUT5
- AFTER5
- BEFORE6
- IN6
- InnerIN6
- InnerLIVE6
--InnerOUT6
--OUT6
- AFTER6
- IN
- try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index 5c8cb28bf03..cd884ce4004 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -5,17 +5,21 @@ IN2i
 CAUGHT2i
 OUT2i
 IN3
+OUT3
 IN4
 OUT4
 IN4f
 OUT4f
 BEFORE5
 IN5
+OUT5
 AFTER5
 BEFORE6
 IN6
 InnerIN6
 InnerLIVE6
+InnerOUT6
+OUT6
 AFTER6
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure

From 8fcfb8b448b9cc24cb2c35f4a018d48a69fe5375 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 19:41:09 +0200
Subject: [PATCH 116/179] cleanup

---
 src/prelude/internals.mo                 | 2 +-
 test/run-drun/ok/try-finally.drun-run.ok | 5 -----
 2 files changed, 1 insertion(+), 6 deletions(-)

diff --git a/src/prelude/internals.mo b/src/prelude/internals.mo
index fc1f2e5425a..5a7aee36518 100644
--- a/src/prelude/internals.mo
+++ b/src/prelude/internals.mo
@@ -308,7 +308,7 @@ func @getSystemRefund() : @Refund {
 };
 
 func @cleanup() {
-    (prim "print" : Text -> ()) "CLEANUP_E"
+    // outmost cleanup action
 };
 
 func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>, () -> ()) {
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 319172bb676..08c7f952233 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -25,21 +25,17 @@ debug.print: OUT6
 debug.print: AFTER6
 debug.print: IN
 debug.print: OUT
-debug.print: CLEANUP_E
 debug.print: INr
 debug.print: OUTr
-debug.print: CLEANUP_E
 debug.print: INd
 debug.print: AGAINd
 debug.print: OUTd
-debug.print: CLEANUP_E
 debug.print: BEFORE6t
 debug.print: IN6t
 debug.print: InnerIN6t
 debug.print: InnerLIVE6t
 debug.print: InnerOUT6t
 debug.print: OUT6t
-debug.print: CLEANUP_E
 debug.print: BEFORE6d
 debug.print: IN6d
 debug.print: InnerIN6d
@@ -47,5 +43,4 @@ debug.print: InnerLIVE6d
 debug.print: InnerLIVESTILL6d
 debug.print: InnerOUT6d
 debug.print: OUT6d
-debug.print: CLEANUP_E
 ingress Completed: Reply: 0x4449444c0000

From 89b5a081aa03a6c5863d33a33ae051d03879f6ee Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 24 Jun 2024 20:32:37 +0200
Subject: [PATCH 117/179] accept

---
 test/bench/ok/heap-32.drun-run-opt.ok | 2 +-
 test/bench/ok/heap-32.drun-run.ok     | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/test/bench/ok/heap-32.drun-run-opt.ok b/test/bench/ok/heap-32.drun-run-opt.ok
index faf3bfb29da..8a1734066bc 100644
--- a/test/bench/ok/heap-32.drun-run-opt.ok
+++ b/test/bench/ok/heap-32.drun-run-opt.ok
@@ -1,5 +1,5 @@
 ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
 ingress Completed: Reply: 0x4449444c0000
 debug.print: (50_227, +29_863_068, 708_174_952)
-debug.print: (50_070, +32_992_212, 766_613_680)
+debug.print: (50_070, +32_992_212, 766_613_640)
 ingress Completed: Reply: 0x4449444c0000
diff --git a/test/bench/ok/heap-32.drun-run.ok b/test/bench/ok/heap-32.drun-run.ok
index f51bd0ff0c3..4ee6fd2e067 100644
--- a/test/bench/ok/heap-32.drun-run.ok
+++ b/test/bench/ok/heap-32.drun-run.ok
@@ -1,5 +1,5 @@
 ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
 ingress Completed: Reply: 0x4449444c0000
 debug.print: (50_227, +29_863_068, 769_000_085)
-debug.print: (50_070, +32_992_212, 830_427_376)
+debug.print: (50_070, +32_992_212, 830_427_314)
 ingress Completed: Reply: 0x4449444c0000

From eb7c7f22edb06f5caffdf841d73b4d5263e3511e Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 25 Jun 2024 18:51:05 +0200
Subject: [PATCH 118/179] add a test that traps in `catch`

---
 test/run-drun/ok/try-finally.drun-run.ok |  3 +++
 test/run-drun/ok/try-finally.tc.ok       | 20 ++++++++++----------
 test/run-drun/try-finally.mo             | 14 +++++++++++---
 3 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 08c7f952233..c79ba457722 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -30,6 +30,9 @@ debug.print: OUTr
 debug.print: INd
 debug.print: AGAINd
 debug.print: OUTd
+debug.print: IN2t
+debug.print: CAUGHT2t
+debug.print: OUT2t
 debug.print: BEFORE6t
 debug.print: IN6t
 debug.print: InnerIN6t
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index ce99b18ba0c..8d98272f1e7 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -10,43 +10,43 @@ try-finally.mo:22.9-23.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:59.9-64.38: warning [M0145], this try handler of type
+try-finally.mo:69.9-74.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:69.9-73.38: warning [M0145], this try handler of type
+try-finally.mo:79.9-83.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:78.9-82.47: warning [M0145], this try handler of type
+try-finally.mo:88.9-92.47: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:87.19-93.38: warning [M0145], this try handler of type
+try-finally.mo:97.19-103.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:101.13-107.49: warning [M0145], this try handler of type
+try-finally.mo:111.13-117.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:99.19-110.38: warning [M0145], this try handler of type
+try-finally.mo:109.19-120.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:118.13-124.50: warning [M0145], this try handler of type
+try-finally.mo:128.13-134.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:116.19-127.39: warning [M0145], this try handler of type
+try-finally.mo:126.19-137.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:135.13-144.50: warning [M0145], this try handler of type
+try-finally.mo:145.13-154.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:133.19-147.39: warning [M0145], this try handler of type
+try-finally.mo:143.19-157.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index e6cf22b3552..b47a14500f5 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -55,6 +55,16 @@ actor A {
         finally { debugPrint "OUT2i" };
     };
 
+    func t2t() : async () {
+        try {
+            debugPrint "IN2t";
+            await m();
+            throw error "IN2t";
+        }
+        catch _ { debugPrint "CAUGHT2t"; assert false }
+        finally { debugPrint "OUT2t" };
+    };
+
     func t3() : async () {
         try {
             debugPrint "IN3";
@@ -148,9 +158,6 @@ actor A {
         debugPrint "AFTER6d"
     };
 
-    // TODO: trap on happy/catch
-    // TODO: trap after repeated `await`
-
     public func go() : async () {
         // These don't trap (for the interpreters)
         //await t1();
@@ -166,6 +173,7 @@ actor A {
         try /*ignore*/ await t0() catch _ {};
         try await t0r() catch _ {};
         try await t0d() catch _ {};
+        try await t2t() catch _ {};
         try await t6t() catch _ {};
         try await t6d() catch _ {};
     };

From aceb323ea6f0c6f108fffbb2aa9d00b3488ba065 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 25 Jun 2024 20:00:20 +0200
Subject: [PATCH 119/179] test trap in nested `catch`

---
 test/run-drun/ok/try-finally.drun-run.ok |  7 +++++++
 test/run-drun/ok/try-finally.tc.ok       |  8 ++++++--
 test/run-drun/try-finally.mo             | 21 +++++++++++++++++++++
 3 files changed, 34 insertions(+), 2 deletions(-)

diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index c79ba457722..0ef7b199703 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -33,6 +33,13 @@ debug.print: OUTd
 debug.print: IN2t
 debug.print: CAUGHT2t
 debug.print: OUT2t
+debug.print: BEFORE6c
+debug.print: IN6c
+debug.print: InnerIN6c
+debug.print: InnerLIVE6c
+debug.print: InnerCATCH6c
+debug.print: InnerOUT6c
+debug.print: OUT6c
 debug.print: BEFORE6t
 debug.print: IN6t
 debug.print: InnerIN6t
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 8d98272f1e7..fa853a21cdd 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -42,11 +42,15 @@ try-finally.mo:126.19-137.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:145.13-154.50: warning [M0145], this try handler of type
+try-finally.mo:143.19-157.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:143.19-157.39: warning [M0145], this try handler of type
+try-finally.mo:165.13-174.50: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:163.19-177.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index b47a14500f5..ae79b8b1407 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -138,6 +138,26 @@ actor A {
         debugPrint "AFTER6t"
     };
 
+    func t6c() : async () {
+        debugPrint "BEFORE6c";
+        label out try {
+            debugPrint "IN6c";
+            try {
+                debugPrint "InnerIN6c";
+                await m();
+                debugPrint "InnerLIVE6c";
+                throw error "InnerIN6c";
+            } catch _ {
+                debugPrint "InnerCATCH6c";
+                assert false;
+                debugPrint "DEADCATCH6c";
+            } finally { debugPrint "InnerOUT6c" };
+            debugPrint "DEAD6c";
+        }
+        finally { debugPrint "OUT6c" };
+        debugPrint "AFTER6c"
+    };
+
     func t6d() : async () {
         debugPrint "BEFORE6d";
         label out try {
@@ -174,6 +194,7 @@ actor A {
         try await t0r() catch _ {};
         try await t0d() catch _ {};
         try await t2t() catch _ {};
+        try await t6c() catch _ {};
         try await t6t() catch _ {};
         try await t6d() catch _ {};
     };

From 70cb14bdda8eb0946a210e5ad47740c1505bc47f Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 25 Jun 2024 20:14:09 +0200
Subject: [PATCH 120/179] first `async*` test

---
 test/run-drun/ok/try-finally.drun-run.ok |  9 ++++++++-
 test/run-drun/ok/try-finally.tc.ok       |  8 ++++++++
 test/run-drun/try-finally.mo             | 24 +++++++++++++++++++++++-
 3 files changed, 39 insertions(+), 2 deletions(-)

diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 0ef7b199703..c700666a94c 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -53,4 +53,11 @@ debug.print: InnerLIVE6d
 debug.print: InnerLIVESTILL6d
 debug.print: InnerOUT6d
 debug.print: OUT6d
-ingress Completed: Reply: 0x4449444c0000
+debug.print: BEFORE7
+debug.print: IN7
+debug.print: InnerIN7
+debug.print: InnerLIVE7
+debug.print: InnerLIVESTILL7
+debug.print: InnerOUT7
+debug.print: OUT7
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:193.17-193.29
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index fa853a21cdd..0d064517f24 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -54,3 +54,11 @@ try-finally.mo:163.19-177.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
+try-finally.mo:186.13-195.49: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:184.19-198.38: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index ae79b8b1407..b5bfd847432 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -175,7 +175,28 @@ actor A {
             debugPrint "DEAD6d";
         }
         finally { debugPrint "OUT6d" };
-        debugPrint "AFTER6d"
+        debugPrint "AFTERDEAD6d"
+    };
+
+    // `await*` tests
+    func t7() : async* () {
+        debugPrint "BEFORE7";
+        label out try {
+            debugPrint "IN7";
+            try {
+                debugPrint "InnerIN7";
+                let fut = m();
+                await fut;
+                debugPrint "InnerLIVE7";
+                await fut;
+                debugPrint "InnerLIVESTILL7";
+                assert false;
+                debugPrint "InnerDEAD7";
+            } finally { debugPrint "InnerOUT7" };
+            debugPrint "DEAD7";
+        }
+        finally { debugPrint "OUT7" };
+        debugPrint "AFTERDEAD7"
     };
 
     public func go() : async () {
@@ -197,6 +218,7 @@ actor A {
         try await t6c() catch _ {};
         try await t6t() catch _ {};
         try await t6d() catch _ {};
+        try await* t7() catch _ {};
     };
 };
 

From b3c0a602c19cc449af76c3d9d5a8bd45175b35c1 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 25 Jun 2024 20:28:52 +0200
Subject: [PATCH 121/179] add `Changelog.md` entry for `finally`

---
 Changelog.md | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/Changelog.md b/Changelog.md
index 549a7eed718..402331eda8f 100644
--- a/Changelog.md
+++ b/Changelog.md
@@ -1,5 +1,22 @@
 # Motoko compiler changelog
 
+* motoko (`moc`)
+
+  * feat: `finally` clauses for `try` expressions (#4507).
+
+    A trailing `finally` clause to `try`/`catch` expressions facilitates structured
+    resource deallocation (e.g. acquired locks, etc.) in the presence of control-flow
+    expressions (`return`, `break`, `continue`, `throw`).
+
+    Note: `finally`-expressions that are in scope will be executed even if an execution
+    path _following_ an `await`-expression traps. This behaviour, not available before,
+    allows programmers writing last-resort cleanups. For trapping execution paths _without_ an
+    intervening `await`, the replica-provided state rewinding mechanism stays in charge of
+    the cleanup.
+
+    BREAKING CHANGE (Minor): `finally` is now a reserved keyword,
+    programs using this identifier will break.
+
 ## 0.11.1 (2024-03-15)
 
 * motoko (`moc`)

From d727380295d768d86f5877f6b7691143481a02c4 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 26 Jun 2024 12:28:07 +0200
Subject: [PATCH 122/179] add another `await*` testcase

caveat: https://github.com/dfinity/motoko/issues/4578
---
 test/run-drun/ok/try-finally.drun-run.ok |  3 +++
 test/run-drun/ok/try-finally.run-ir.ok   |  3 +++
 test/run-drun/ok/try-finally.run-low.ok  |  3 +++
 test/run-drun/ok/try-finally.run.ok      |  3 +++
 test/run-drun/try-finally.mo             | 12 ++++++++++++
 5 files changed, 24 insertions(+)

diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index c700666a94c..52216e4f1c3 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -23,6 +23,9 @@ debug.print: InnerLIVE6
 debug.print: InnerOUT6
 debug.print: OUT6
 debug.print: AFTER6
+debug.print: IN8
+debug.print: CAUGHT8
+debug.print: OUT8
 debug.print: IN
 debug.print: OUT
 debug.print: INr
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index cd884ce4004..b7be4613a3c 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -21,5 +21,8 @@ InnerLIVE6
 InnerOUT6
 OUT6
 AFTER6
+IN8
+CAUGHT8
+OUT8
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index cd884ce4004..b7be4613a3c 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -21,5 +21,8 @@ InnerLIVE6
 InnerOUT6
 OUT6
 AFTER6
+IN8
+CAUGHT8
+OUT8
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index cd884ce4004..b7be4613a3c 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -21,5 +21,8 @@ InnerLIVE6
 InnerOUT6
 OUT6
 AFTER6
+IN8
+CAUGHT8
+OUT8
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index b5bfd847432..8cd37b3cf46 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -199,6 +199,17 @@ actor A {
         debugPrint "AFTERDEAD7"
     };
 
+    func t8() : async () {
+        try {
+            debugPrint "IN8";
+            // await* async* throw error "IN8"
+            // https://github.com/dfinity/motoko/issues/4578
+            await* async* { throw error "IN8"; () }
+        }
+        catch _ { debugPrint "CAUGHT8" }
+        finally { debugPrint "OUT8" };
+    };
+
     public func go() : async () {
         // These don't trap (for the interpreters)
         //await t1();
@@ -209,6 +220,7 @@ actor A {
         await t4f();
         await t5();
         await t6();
+        await t8();
 
         // These trap, and only work on drun
         try /*ignore*/ await t0() catch _ {};

From 606a945915cc0beeb707896a8ebe62e177798f2f Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 26 Jun 2024 12:52:40 +0200
Subject: [PATCH 123/179] more `await*` tests

---
 src/mo_frontend/typing.ml                |  2 ++
 test/run-drun/ok/try-finally.drun-run.ok |  6 ++++++
 test/run-drun/ok/try-finally.run-ir.ok   |  3 +++
 test/run-drun/ok/try-finally.run-low.ok  |  3 +++
 test/run-drun/ok/try-finally.run.ok      |  3 +++
 test/run-drun/ok/try-finally.tc.ok       |  4 ++++
 test/run-drun/try-finally.mo             | 27 +++++++++++++++++++++++-
 7 files changed, 47 insertions(+), 1 deletion(-)

diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml
index 1cb9e7e1785..1632b958ef8 100644
--- a/src/mo_frontend/typing.ml
+++ b/src/mo_frontend/typing.ml
@@ -1832,6 +1832,8 @@ and check_exp' env0 t exp : T.typ =
         check_exp_strong env T.unit exp2;
         if exp2.note.note_eff <> T.Triv then
           local_error env exp2.at "M0199" "a cleanup clause must not send messages";
+        if exp1.note.note_eff <> T.Await then
+          warn env exp2.at "M0299" "why cleanup clause";
       end;
     t
   (* TODO: allow shared with one scope par *)
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 52216e4f1c3..42c18ec0dbf 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -26,6 +26,9 @@ debug.print: AFTER6
 debug.print: IN8
 debug.print: CAUGHT8
 debug.print: OUT8
+debug.print: IN8i
+debug.print: CAUGHT8i
+debug.print: OUT8i
 debug.print: IN
 debug.print: OUT
 debug.print: INr
@@ -56,6 +59,9 @@ debug.print: InnerLIVE6d
 debug.print: InnerLIVESTILL6d
 debug.print: InnerOUT6d
 debug.print: OUT6d
+debug.print: IN8t
+debug.print: InnerIN8t
+debug.print: OUT8t
 debug.print: BEFORE7
 debug.print: IN7
 debug.print: InnerIN7
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index b7be4613a3c..c1cd8e65655 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -24,5 +24,8 @@ AFTER6
 IN8
 CAUGHT8
 OUT8
+IN8i
+CAUGHT8i
+OUT8i
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index b7be4613a3c..c1cd8e65655 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -24,5 +24,8 @@ AFTER6
 IN8
 CAUGHT8
 OUT8
+IN8i
+CAUGHT8i
+OUT8i
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index b7be4613a3c..c1cd8e65655 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -24,5 +24,8 @@ AFTER6
 IN8
 CAUGHT8
 OUT8
+IN8i
+CAUGHT8i
+OUT8i
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 0d064517f24..65c82f0ccf8 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -62,3 +62,7 @@ try-finally.mo:184.19-198.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
+try-finally.mo:228.9-232.39: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 8cd37b3cf46..9e79ea45a5e 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -210,6 +210,28 @@ actor A {
         finally { debugPrint "OUT8" };
     };
 
+    func t8i() : async () {
+        // see: https://github.com/dfinity/motoko/issues/4578
+        func inner() : async* () = async* { throw error "IN8i" };
+
+        try {
+            debugPrint "IN8i";
+            await* inner()
+        }
+        catch _ { debugPrint "CAUGHT8i" }
+        finally { debugPrint "OUT8i" };
+    };
+
+    func t8t() : async () {
+        func inner() : async* () = async* { debugPrint "InnerIN8t"; await m(); assert true };
+
+        try {
+            debugPrint "IN8t";
+            await* inner()
+        }
+        finally { debugPrint "OUT8t" };
+    };
+
     public func go() : async () {
         // These don't trap (for the interpreters)
         //await t1();
@@ -221,6 +243,7 @@ actor A {
         await t5();
         await t6();
         await t8();
+        await t8i();
 
         // These trap, and only work on drun
         try /*ignore*/ await t0() catch _ {};
@@ -230,7 +253,9 @@ actor A {
         try await t6c() catch _ {};
         try await t6t() catch _ {};
         try await t6d() catch _ {};
-        try await* t7() catch _ {};
+        try await t8t() catch _ {};
+        /// caveat: t7 won't return!
+        try await* t7() catch _ {} finally debugPrint "It's over";
     };
 };
 

From 65e585eab25cbb378c28eae7320544f960ad2f5f Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 09:19:34 +0200
Subject: [PATCH 124/179] arrange the finally thunk

---
 src/ir_def/arrange_ir.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/ir_def/arrange_ir.ml b/src/ir_def/arrange_ir.ml
index 6c3e747a293..7a8fb9afd67 100644
--- a/src/ir_def/arrange_ir.ml
+++ b/src/ir_def/arrange_ir.ml
@@ -32,7 +32,8 @@ let rec exp e = match e.it with
     "SelfCallE" $$ [typ (Type.seq ts); exp exp_f; exp exp_k; exp exp_r; exp exp_c]
   | ActorE (ds, fs, u, t) -> "ActorE"  $$ List.map dec ds @ fields fs @ [system u; typ t]
   | NewObjE (s, fs, t)  -> "NewObjE" $$ (Arrange_type.obj_sort s :: fields fs @ [typ t])
-  | TryE (e, cs, _FIXME) -> "TryE" $$ [exp e] @ List.map case cs
+  | TryE (e, cs, None) -> "TryE" $$ [exp e] @ List.map case cs
+  | TryE (e, cs, Some (i, _)) -> "TryE" $$ [exp e] @ List.map case cs @ Atom ";" :: [id i]
 
 and system { meta; preupgrade; postupgrade; heartbeat; timer; inspect} = (* TODO: show meta? *)
   "System" $$ [

From 813ede98430e179bf61d6ac19acdbe4ed546e4db Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 09:53:03 +0200
Subject: [PATCH 125/179] arrange the finally expression

---
 src/mo_def/arrange.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/mo_def/arrange.ml b/src/mo_def/arrange.ml
index e297c553e12..6af9b0bbd4e 100644
--- a/src/mo_def/arrange.ml
+++ b/src/mo_def/arrange.ml
@@ -126,7 +126,7 @@ module Make (Cfg : Config) = struct
     | ImportE (f, _fp)    -> "ImportE" $$ [Atom f]
     | ThrowE e            -> "ThrowE"  $$ [exp e]
     | TryE (e, cs, None)  -> "TryE"    $$ [exp e] @ List.map catch cs
-    | TryE (e, cs, Some _)-> "TryE FINALLY" $$ [exp e] @ List.map catch cs (* FIXME *)
+    | TryE (e, cs, Some f)-> "TryE"    $$ [exp e] @ List.map catch cs @ Atom ";" :: [exp f]
     | IgnoreE e           -> "IgnoreE" $$ [exp e]))
 
   and exps es = List.map exp es

From 62c298d940be925850f1d797e19d43e55cd8aafd Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 09:59:21 +0200
Subject: [PATCH 126/179] elim a FIXME

in a slightly hacky way
---
 src/mo_frontend/typing.ml | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml
index 1632b958ef8..198fc76ed0d 100644
--- a/src/mo_frontend/typing.ml
+++ b/src/mo_frontend/typing.ml
@@ -942,9 +942,12 @@ let rec is_explicit_exp e =
   | ObjBlockE (_, _, dfs) ->
     List.for_all (fun (df : dec_field) -> is_explicit_dec df.it.dec) dfs
   | ArrayE (_, es) -> List.exists is_explicit_exp es
-  | SwitchE (e1, cs) | TryE (e1, cs, _ (*FIXME?*)) ->
+  | SwitchE (e1, cs) | TryE (e1, cs, None) ->
     is_explicit_exp e1 &&
     List.exists (fun (c : case) -> is_explicit_exp c.it.exp) cs
+  | TryE (e1, cs, Some e2) ->
+    is_explicit_exp { e with it = TryE (e1, cs, None) } &&
+    is_explicit_exp e2
   | BlockE ds -> List.for_all is_explicit_dec ds
   | FuncE (_, _, _, p, t_opt, _, _) -> is_explicit_pat p && t_opt <> None
   | LoopE (_, e_opt) -> e_opt <> None

From ae686d6d5900d7f0b06f70005958807ff0e3254f Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 15:12:38 +0200
Subject: [PATCH 127/179] preserve the `Cleanup` chain for `await` and `await*`

---
 src/ir_passes/await.ml                   | 10 ++++++----
 test/run-drun/ok/try-finally.drun-run.ok |  1 +
 2 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 634cda2d39a..e3aaf558672 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -83,8 +83,9 @@ let rec t_async context exp =
    let k_fail = fresh_err_cont T.unit in
    let k_clean = fresh_cont T.unit T.unit in
    let context' =
-     LabelEnv.add Return (Cont (ContVar k_ret))
-       (LabelEnv.singleton Throw (Cont (ContVar k_fail)))
+     LabelEnv.add Cleanup (Cont (ContVar k_clean))
+       (LabelEnv.add Return (Cont (ContVar k_ret))
+          (LabelEnv.singleton Throw (Cont (ContVar k_fail))))
    in
      cps_asyncE s typ1 (typ exp1)
        (forall [tb] ([k_ret; k_fail; k_clean] -->*
@@ -447,8 +448,9 @@ and c_exp' context exp k =
     let k_fail = fresh_err_cont T.unit in
     let k_clean = fresh_cont T.unit T.unit in
     let context' =
-      LabelEnv.add Return (Cont (ContVar k_ret))
-        (LabelEnv.singleton Throw (Cont (ContVar k_fail)))
+      LabelEnv.add Cleanup (Cont (ContVar k_clean))
+        (LabelEnv.add Return (Cont (ContVar k_ret))
+           (LabelEnv.singleton Throw (Cont (ContVar k_fail))))
     in
     let r = match LabelEnv.find_opt Throw context with
       | Some (Cont r) -> r
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 42c18ec0dbf..36c4f4a7f71 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -69,4 +69,5 @@ debug.print: InnerLIVE7
 debug.print: InnerLIVESTILL7
 debug.print: InnerOUT7
 debug.print: OUT7
+debug.print: It's over
 ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:193.17-193.29

From 560cbca5af9f57e0112f3ae7b1c6118c71780025 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 15:56:56 +0200
Subject: [PATCH 128/179] test `async* { ... }` trapping too

---
 test/run-drun/ok/try-finally.drun-run.ok |  3 +++
 test/run-drun/try-finally.mo             | 11 +++++++++++
 2 files changed, 14 insertions(+)

diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 36c4f4a7f71..80644da331a 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -71,3 +71,6 @@ debug.print: InnerOUT7
 debug.print: OUT7
 debug.print: It's over
 ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:193.17-193.29
+debug.print: go2
+debug.print: It's so over
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:266.13-266.25
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 9e79ea45a5e..cbcc2a66b5a 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -257,8 +257,19 @@ actor A {
         /// caveat: t7 won't return!
         try await* t7() catch _ {} finally debugPrint "It's over";
     };
+
+    public func go2() : async () {
+        /// caveat: the `await*` won't return!
+        try await* async* {
+            await m();
+            debugPrint "go2";
+            assert false }
+        catch _ {}
+        finally debugPrint "It's so over";
+    }
 };
 
 //SKIP ic-ref-run
 
 A.go(); //OR-CALL ingress go "DIDL\x00\x00"
+//CALL ingress go2 "DIDL\x00\x00"

From da124b24e771f88225ec25284e36b04906aa73ff Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 16:55:31 +0200
Subject: [PATCH 129/179] reverts

---
 src/ir_def/ir_effect.ml | 2 +-
 src/ir_passes/async.ml  | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/ir_def/ir_effect.ml b/src/ir_def/ir_effect.ml
index 87892f14c65..32f86094cd8 100644
--- a/src/ir_def/ir_effect.ml
+++ b/src/ir_def/ir_effect.ml
@@ -22,7 +22,7 @@ let effect_exp (exp: exp) : T.eff = eff exp
 
 let is_async_call p exps =
   match p, exps with
-  | CallPrim _, (exp1 :: _ :: _) ->
+  | CallPrim _, [exp1; _] ->
     T.is_shared_func (typ exp1) ||
     T.is_local_async_func (typ exp1)
   | OtherPrim "call_raw", _ ->
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index eafe47fdaeb..4688b98e1f4 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -320,7 +320,7 @@ let transform prog =
       let v_fail = fresh_var "e" t_fail in
       let v_clean = fresh_var "c" t_clean in
       ([v_ret; v_fail; v_clean] -->* callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail; varE v_clean])).it
-    | PrimE (CallPrim typs, (exp1 :: exp2 :: _)) when is_awaitable_func exp1 ->
+    | PrimE (CallPrim typs, [exp1; exp2]) when is_awaitable_func exp1 ->
       let ts1,ts2 =
         match typ exp1 with
         | Func (Shared _, Promises, tbs, ts1, ts2) ->

From f39b9662a1568acb1b9a7596e78a91d68654df7d Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 17:02:40 +0200
Subject: [PATCH 130/179] tweaks

---
 src/ir_passes/async.ml | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 4688b98e1f4..2fde258618c 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -316,10 +316,8 @@ let transform prog =
           t_typ (T.open_ [t] t_clean)
         | t -> assert false
       in
-      let v_ret = fresh_var "v" t_ret in
-      let v_fail = fresh_var "e" t_fail in
-      let v_clean = fresh_var "c" t_clean in
-      ([v_ret; v_fail; v_clean] -->* callE (t_exp exp1) [t0] (tupE [varE v_ret; varE v_fail; varE v_clean])).it
+      let v_ret, v_fail, v_clean = fresh_var "v" t_ret, fresh_var "e" t_fail, fresh_var "c" t_clean in
+      ([v_ret; v_fail; v_clean] -->* callE (t_exp exp1) [t0] (List.map varE [v_ret; v_fail; v_clean] |> tupE)).it
     | PrimE (CallPrim typs, [exp1; exp2]) when is_awaitable_func exp1 ->
       let ts1,ts2 =
         match typ exp1 with

From 5938acadaf390886a14626db8cdd2bdee8415f7d Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 17:04:57 +0200
Subject: [PATCH 131/179] point to security best practices

---
 Changelog.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/Changelog.md b/Changelog.md
index 402331eda8f..0ee37b570e3 100644
--- a/Changelog.md
+++ b/Changelog.md
@@ -14,6 +14,8 @@
     intervening `await`, the replica-provided state rewinding mechanism stays in charge of
     the cleanup.
 
+    The relevant security best practices are accessible at https://internetcomputer.org/docs/current/developer-docs/security/security-best-practices/inter-canister-calls#recommendation
+
     BREAKING CHANGE (Minor): `finally` is now a reserved keyword,
     programs using this identifier will break.
 

From d47e9781b1572418b39fd9cdeed0d8f19be0c136 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 17:08:55 +0200
Subject: [PATCH 132/179] tweak

---
 Changelog.md | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/Changelog.md b/Changelog.md
index 0ee37b570e3..d85596b1e39 100644
--- a/Changelog.md
+++ b/Changelog.md
@@ -14,7 +14,8 @@
     intervening `await`, the replica-provided state rewinding mechanism stays in charge of
     the cleanup.
 
-    The relevant security best practices are accessible at https://internetcomputer.org/docs/current/developer-docs/security/security-best-practices/inter-canister-calls#recommendation
+    The relevant security best practices are accessible at
+    https://internetcomputer.org/docs/current/developer-docs/security/security-best-practices/inter-canister-calls#recommendation
 
     BREAKING CHANGE (Minor): `finally` is now a reserved keyword,
     programs using this identifier will break.

From 24cab3708388c9b4fd1fd48faf643af17156d16f Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 17:11:19 +0200
Subject: [PATCH 133/179] words

---
 Changelog.md | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Changelog.md b/Changelog.md
index d85596b1e39..f730308735d 100644
--- a/Changelog.md
+++ b/Changelog.md
@@ -5,8 +5,8 @@
   * feat: `finally` clauses for `try` expressions (#4507).
 
     A trailing `finally` clause to `try`/`catch` expressions facilitates structured
-    resource deallocation (e.g. acquired locks, etc.) in the presence of control-flow
-    expressions (`return`, `break`, `continue`, `throw`).
+    resource deallocation (e.g. acquired locks, etc.) and similar cleanups in the
+    presence of control-flow expressions (`return`, `break`, `continue`, `throw`).
 
     Note: `finally`-expressions that are in scope will be executed even if an execution
     path _following_ an `await`-expression traps. This behaviour, not available before,

From 2f6b6ef635f041621590b80e0fa75eac624e5daf Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 17:14:16 +0200
Subject: [PATCH 134/179] italic

---
 Changelog.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Changelog.md b/Changelog.md
index f730308735d..4ee24b246ae 100644
--- a/Changelog.md
+++ b/Changelog.md
@@ -8,7 +8,7 @@
     resource deallocation (e.g. acquired locks, etc.) and similar cleanups in the
     presence of control-flow expressions (`return`, `break`, `continue`, `throw`).
 
-    Note: `finally`-expressions that are in scope will be executed even if an execution
+    _Note_: `finally`-expressions that are in scope will be executed even if an execution
     path _following_ an `await`-expression traps. This behaviour, not available before,
     allows programmers writing last-resort cleanups. For trapping execution paths _without_ an
     intervening `await`, the replica-provided state rewinding mechanism stays in charge of

From f1faeabd3e0274bc22a9d1d81dc3e2c3a6eed5e6 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 27 Jun 2024 17:15:19 +0200
Subject: [PATCH 135/179] smith

---
 Changelog.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Changelog.md b/Changelog.md
index 4ee24b246ae..e6a006ad6c0 100644
--- a/Changelog.md
+++ b/Changelog.md
@@ -9,7 +9,7 @@
     presence of control-flow expressions (`return`, `break`, `continue`, `throw`).
 
     _Note_: `finally`-expressions that are in scope will be executed even if an execution
-    path _following_ an `await`-expression traps. This behaviour, not available before,
+    path _following_ an `await`-expression traps. This behaviour, not available before in Motoko,
     allows programmers writing last-resort cleanups. For trapping execution paths _without_ an
     intervening `await`, the replica-provided state rewinding mechanism stays in charge of
     the cleanup.

From bf934087580d879829155030a90881986e9123d5 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 28 Jun 2024 14:15:28 +0200
Subject: [PATCH 136/179] this needs to be done

---
 src/ir_passes/await.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index e3aaf558672..2d492219c87 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -380,7 +380,7 @@ and c_exp' context exp k =
     letcont f (fun f ->
     letcont k (fun k ->
     match eff exp1 with
-    | T.Triv -> assert false (* TODO: maybe lift this later? *)
+    | T.Triv -> assert false (* FIXME: maybe lift this later? *)
     | T.Await ->
       let error = fresh_var "v" T.catch in
       let cases' =

From b1480db5b54cefaf4df9f03edaf6c047a8b62aaf Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 28 Jun 2024 14:33:53 +0200
Subject: [PATCH 137/179] IR-interpreter: pass through the _cleanup_
 continuation

but don't use it yet
---
 src/ir_interpreter/interpret_ir.ml | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index c53cb87f8b7..fc062f2cc80 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -446,13 +446,13 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
         let reject = Option.get env.rejects in
         let e = V.Tup [V.Variant ("canister_reject", V.unit); v1] in
         Scheduler.queue (fun () -> reject e)
-      | ICCallPrim, [v1; v2; kv; rv; _cv(*FIXME*)] ->
+      | ICCallPrim, [v1; v2; kv; rv; cv] ->
         let call_conv, f = V.as_func v1 in
         check_call_conv (List.hd es) call_conv;
         check_call_conv_arg env exp v2 call_conv;
         last_region := exp.at; (* in case the following throws *)
         let vc = context env in
-        f (V.Tup[vc; kv; rv]) v2 k
+        f (V.Tup[vc; kv; rv; cv]) v2 k
       | ICCallerPrim, [] ->
         k env.caller
       | ICStableRead t, [] ->
@@ -547,11 +547,11 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     (* see code for ICCallPrim *)
     interpret_exp env exp_k (fun kv ->
     interpret_exp env exp_r (fun rv ->
-    (*FIXME: interpret_exp env exp_c (fun cv ->*)
+    interpret_exp env exp_c (fun cv ->
         let _call_conv, f = V.as_func v in
         last_region := exp.at; (* in case the following throws *)
         let vc = context env in
-        f (V.Tup[vc; kv; rv]) (V.Tup []) k))
+        f (V.Tup[vc; kv; rv; cv]) (V.Tup []) k)))
   | FuncE (x, (T.Shared _ as sort), (T.Replies as control), _typbinds, args, ret_typs, e) ->
     assert (not env.flavor.has_async_typ);
     let cc = { sort; control; n_args = List.length args; n_res = List.length ret_typs } in
@@ -833,7 +833,7 @@ and interpret_func env at sort x args f c v (k : V.value V.cont) =
 
 and interpret_message env at x args f c v (k : V.value V.cont) =
   let v_caller, v_reply, v_reject = match V.as_tup c with
-    | [v_caller; v_reply; v_reject] -> v_caller, v_reply, v_reject
+    | [v_caller; v_reply; v_reject; _v_cleanup] -> v_caller, v_reply, v_reject
     | _ -> assert false
   in
   if env.flags.trace then trace "%s%s" x (string_of_arg env v);

From f058d4025b67e6e9bfeecb9288da767e14ca82c4 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 28 Jun 2024 18:44:22 +0200
Subject: [PATCH 138/179] refactor

---
 src/ir_passes/await.ml | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 2d492219c87..23b0844502f 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -397,14 +397,17 @@ and c_exp' context exp k =
              note = ()
         }] in
       let throw = fresh_err_cont (answerT (typ_of_var k)) in
-      let lab = function
+      let pre = function
         | Cont k -> Cont (precont k (var id2 typ2))
         | Label -> assert false
       in
-      let context' = LabelEnv.mapi (function | Return | Named _ -> lab | Cleanup | Throw -> fun c -> c) context in
+      let context' = LabelEnv.mapi (function | Return | Named _ | Cleanup -> pre
+                                             | Throw -> fun c -> c) context in
       let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
-      let c = match LabelEnv.find_opt Cleanup context'' with Some c -> c | None -> Cont (ContVar (var "@cleanup" bail_contT)) in
-      let context''' = LabelEnv.add Cleanup (lab c) context'' in
+      let c = match LabelEnv.find_opt Cleanup context'' with
+        | None -> Cont (ContVar (var "@cleanup" bail_contT))
+        | Some c -> c in
+      let context''' = LabelEnv.add Cleanup c context'' in
       blockE
         [ let e = fresh_var "e" T.catch in
           funcD throw e {

From f3dadd308f6a61bd9552c24051a08edf5bb4d6dd Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 28 Jun 2024 19:32:05 +0200
Subject: [PATCH 139/179] simplify by assuming that `Cleanup` cont exists
 already

---
 src/ir_passes/await.ml                   | 8 +++-----
 test/run-drun/ok/try-finally.drun-run.ok | 4 +++-
 test/run-drun/ok/try-finally.run-ir.ok   | 2 ++
 test/run-drun/ok/try-finally.run-low.ok  | 2 ++
 test/run-drun/ok/try-finally.run.ok      | 2 ++
 test/run-drun/ok/try-finally.tc.ok       | 4 ++++
 test/run-drun/try-finally.mo             | 9 +++++++++
 7 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 23b0844502f..85da286fbb5 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -375,6 +375,8 @@ and c_exp' context exp k =
         (c_exp context' exp1 (ContVar k))
     ))
   | TryE (exp1, cases, Some (id2, typ2)) ->
+    (* assert that a surrounding `AwaitPrim _` has set up a `Cleanup` cont *)
+    ignore (LabelEnv.find Cleanup context);
     (* TODO: do we need to reify f? *)
     let f = match LabelEnv.find Throw context with Cont f -> f | _ -> assert false in
     letcont f (fun f ->
@@ -404,10 +406,6 @@ and c_exp' context exp k =
       let context' = LabelEnv.mapi (function | Return | Named _ | Cleanup -> pre
                                              | Throw -> fun c -> c) context in
       let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
-      let c = match LabelEnv.find_opt Cleanup context'' with
-        | None -> Cont (ContVar (var "@cleanup" bail_contT))
-        | Some c -> c in
-      let context''' = LabelEnv.add Cleanup c context'' in
       blockE
         [ let e = fresh_var "e" T.catch in
           funcD throw e {
@@ -416,7 +414,7 @@ and c_exp' context exp k =
             note = Note.{ def with typ = typ_cases cases'; eff = T.Await; (* shouldn't matter *) }
           }
         ]
-        (c_exp context''' exp1 (ContVar k))
+        (c_exp context'' exp1 (ContVar k))
     ))
   | LoopE exp1 ->
     c_loop context k exp1
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 80644da331a..e4c694f6ba9 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -29,6 +29,8 @@ debug.print: OUT8
 debug.print: IN8i
 debug.print: CAUGHT8i
 debug.print: OUT8i
+debug.print: IN9
+debug.print: OUT9
 debug.print: IN
 debug.print: OUT
 debug.print: INr
@@ -73,4 +75,4 @@ debug.print: It's over
 ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:193.17-193.29
 debug.print: go2
 debug.print: It's so over
-ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:266.13-266.25
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:275.13-275.25
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index c1cd8e65655..e0d23c7c274 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -27,5 +27,7 @@ OUT8
 IN8i
 CAUGHT8i
 OUT8i
+IN9
+OUT9
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index c1cd8e65655..e0d23c7c274 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -27,5 +27,7 @@ OUT8
 IN8i
 CAUGHT8i
 OUT8i
+IN9
+OUT9
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index c1cd8e65655..e0d23c7c274 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -27,5 +27,7 @@ OUT8
 IN8i
 CAUGHT8i
 OUT8i
+IN9
+OUT9
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 65c82f0ccf8..47c33d2aa33 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -66,3 +66,7 @@ try-finally.mo:228.9-232.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
+try-finally.mo:236.9-240.38: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index cbcc2a66b5a..2443b31084b 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -232,6 +232,14 @@ actor A {
         finally { debugPrint "OUT8t" };
     };
 
+    func t9() : async* () {
+        try {
+            debugPrint "IN9";
+            await m()
+        }
+        finally { debugPrint "OUT9" };
+    };
+
     public func go() : async () {
         // These don't trap (for the interpreters)
         //await t1();
@@ -244,6 +252,7 @@ actor A {
         await t6();
         await t8();
         await t8i();
+        await* t9();
 
         // These trap, and only work on drun
         try /*ignore*/ await t0() catch _ {};

From 3b956641c7057afa62757c6d9f53fecb04fd2b40 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 28 Jun 2024 20:16:25 +0200
Subject: [PATCH 140/179] tweaks

---
 src/ir_passes/await.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 85da286fbb5..55428e3bd6c 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -478,10 +478,10 @@ and c_exp' context exp k =
       | None -> ContVar (var "@cleanup" bail_contT)
       | _ -> assert false
     in
+    letcont c (fun c ->
     letcont r (fun r ->
     letcont k (fun k ->
-    letcont c (fun c ->
-      let krc = tupE [varE k; varE r; varE c] in
+      let krc = List.map varE [k; r; c] |> tupE in
       match eff exp1 with
       | T.Triv ->
         cps_awaitE s (typ_of_var k) (t_exp context exp1) krc

From 0a1e759b90a6d46342831a8b9607312ad62706e2 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Fri, 28 Jun 2024 21:30:43 +0200
Subject: [PATCH 141/179] reject `throw` from `finally`

---
 test/fail/ok/try-finally.tc.ok | 5 +++--
 test/fail/try-finally.mo       | 8 ++++++++
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/test/fail/ok/try-finally.tc.ok b/test/fail/ok/try-finally.tc.ok
index aed3512ffc5..9e658100d1f 100644
--- a/test/fail/ok/try-finally.tc.ok
+++ b/test/fail/ok/try-finally.tc.ok
@@ -1,5 +1,6 @@
-try-finally.mo:8.17-8.31: type error [M0199], a cleanup clause must not send messages
-try-finally.mo:14.19-14.21: type error [M0050], literal of type
+try-finally.mo:10.17-10.31: type error [M0199], a cleanup clause must not send messages
+try-finally.mo:16.17-16.39: type error [M0199], a cleanup clause must not send messages
+try-finally.mo:22.19-22.21: type error [M0050], literal of type
   Nat
 does not have expected type
   ()
diff --git a/test/fail/try-finally.mo b/test/fail/try-finally.mo
index 20cb05857e3..d48d17a0c20 100644
--- a/test/fail/try-finally.mo
+++ b/test/fail/try-finally.mo
@@ -1,3 +1,5 @@
+import { error } =  "mo:⛔";
+
 actor A {
     func m() : async () {
     };
@@ -9,6 +11,12 @@ actor A {
     };
 
     func _t1() : async () {
+        try { await m() }
+        catch _ {}
+        finally { throw error "Nope" } // BAD: has effect.
+    };
+
+    func _t2() : async () {
         try { await m() }
         catch _ {}
         finally { 42 } // BAD: should return unit.

From d8ef2920b9d9fc376eff2a91602463f239e33276 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 1 Jul 2024 13:12:32 +0200
Subject: [PATCH 142/179] prohibit `return` and accessing external labels

---
 src/mo_frontend/typing.ml      |  8 ++------
 test/fail/ok/try-finally.tc.ok |  2 ++
 test/fail/try-finally.mo       | 15 +++++++++++++--
 3 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml
index 198fc76ed0d..c06b3bbaf3b 100644
--- a/src/mo_frontend/typing.ml
+++ b/src/mo_frontend/typing.ml
@@ -1520,14 +1520,10 @@ and infer_exp'' env exp : T.typ =
     let t1 = infer_exp env exp1 in
     let t2 = infer_cases env T.catch T.Non cases in
     if not env.pre then begin
+      Option.iter (check_exp_strong { env with rets = None; labs = T.Env.empty } T.unit) exp2_opt;
       check_ErrorCap env "try" exp.at;
       coverage_cases "try handler" env cases T.catch exp.at
     end;
-    if not env.pre then
-      begin match exp2_opt with
-      | None -> ()
-      | Some exp2 -> check_exp_strong env T.unit exp2
-      end;
     T.lub t1 t2
   | WhileE (exp1, exp2) ->
     if not env.pre then begin
@@ -1832,7 +1828,7 @@ and check_exp' env0 t exp : T.typ =
       begin match exp2_opt with
       | None -> ()
       | Some exp2 ->
-        check_exp_strong env T.unit exp2;
+        check_exp_strong { env with rets = None; labs = T.Env.empty } T.unit exp2;
         if exp2.note.note_eff <> T.Triv then
           local_error env exp2.at "M0199" "a cleanup clause must not send messages";
         if exp1.note.note_eff <> T.Await then
diff --git a/test/fail/ok/try-finally.tc.ok b/test/fail/ok/try-finally.tc.ok
index 9e658100d1f..54d555f3a04 100644
--- a/test/fail/ok/try-finally.tc.ok
+++ b/test/fail/ok/try-finally.tc.ok
@@ -4,3 +4,5 @@ try-finally.mo:22.19-22.21: type error [M0050], literal of type
   Nat
 does not have expected type
   ()
+try-finally.mo:28.19-28.25: type error [M0085], misplaced return
+try-finally.mo:34.25-34.28: type error [M0083], unbound label out
diff --git a/test/fail/try-finally.mo b/test/fail/try-finally.mo
index d48d17a0c20..8ecd9b47e96 100644
--- a/test/fail/try-finally.mo
+++ b/test/fail/try-finally.mo
@@ -20,7 +20,18 @@ actor A {
         try { await m() }
         catch _ {}
         finally { 42 } // BAD: should return unit.
-    }
+    };
+
+    func _t3r() : async () {
+        try { await m() }
+        catch _ {}
+        finally { return } // BAD: no outward edges allowed!
+    };
+
+    func _t3l() : async () {
+        label out try { await m() }
+        catch _ {}
+        finally { break out } // BAD: no outward edges allowed!
+    };
 
-    // TODO: Nat resulting `try`
 }

From 40aab57fb7ad7d821c402a4d335d175b16fbf870 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 1 Jul 2024 15:16:00 +0200
Subject: [PATCH 143/179] WIP: start implementing the `Triv` block

---
 src/ir_passes/await.ml                   |  3 ++-
 src/mo_frontend/typing.ml                |  2 --
 test/run-drun/ok/try-finally.drun-run.ok |  8 +++---
 test/run-drun/ok/try-finally.run-ir.ok   |  4 +--
 test/run-drun/ok/try-finally.run-low.ok  |  4 +--
 test/run-drun/ok/try-finally.run.ok      |  4 +--
 test/run-drun/ok/try-finally.tc.ok       | 32 ++++++++++++------------
 test/run-drun/try-finally.mo             | 15 +++++------
 8 files changed, 34 insertions(+), 38 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 55428e3bd6c..a10823305e3 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -382,7 +382,8 @@ and c_exp' context exp k =
     letcont f (fun f ->
     letcont k (fun k ->
     match eff exp1 with
-    | T.Triv -> assert false (* FIXME: maybe lift this later? *)
+    | T.Triv ->
+      varE k -*- t_exp context exp1
     | T.Await ->
       let error = fresh_var "v" T.catch in
       let cases' =
diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml
index c06b3bbaf3b..550b936849c 100644
--- a/src/mo_frontend/typing.ml
+++ b/src/mo_frontend/typing.ml
@@ -1831,8 +1831,6 @@ and check_exp' env0 t exp : T.typ =
         check_exp_strong { env with rets = None; labs = T.Env.empty } T.unit exp2;
         if exp2.note.note_eff <> T.Triv then
           local_error env exp2.at "M0199" "a cleanup clause must not send messages";
-        if exp1.note.note_eff <> T.Await then
-          warn env exp2.at "M0299" "why cleanup clause";
       end;
     t
   (* TODO: allow shared with one scope par *)
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index e4c694f6ba9..b3b2c78c10a 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -1,5 +1,7 @@
 ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
 ingress Completed: Reply: 0x4449444c0000
+debug.print: INt
+debug.print: OUTt
 debug.print: IN2
 debug.print: CAUGHT2
 debug.print: OUT2
@@ -10,8 +12,6 @@ debug.print: IN3
 debug.print: OUT3
 debug.print: IN4
 debug.print: OUT4
-debug.print: IN4f
-debug.print: OUT4f
 debug.print: BEFORE5
 debug.print: IN5
 debug.print: OUT5
@@ -72,7 +72,7 @@ debug.print: InnerLIVESTILL7
 debug.print: InnerOUT7
 debug.print: OUT7
 debug.print: It's over
-ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:193.17-193.29
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:190.17-190.29
 debug.print: go2
 debug.print: It's so over
-ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:275.13-275.25
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:272.13-272.25
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index e0d23c7c274..d49476d15ed 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -1,3 +1,5 @@
+INt
+OUTt
 IN2
 CAUGHT2
 OUT2
@@ -8,8 +10,6 @@ IN3
 OUT3
 IN4
 OUT4
-IN4f
-OUT4f
 BEFORE5
 IN5
 OUT5
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index e0d23c7c274..d49476d15ed 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -1,3 +1,5 @@
+INt
+OUTt
 IN2
 CAUGHT2
 OUT2
@@ -8,8 +10,6 @@ IN3
 OUT3
 IN4
 OUT4
-IN4f
-OUT4f
 BEFORE5
 IN5
 OUT5
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index e0d23c7c274..d49476d15ed 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -1,3 +1,5 @@
+INt
+OUTt
 IN2
 CAUGHT2
 OUT2
@@ -8,8 +10,6 @@ IN3
 OUT3
 IN4
 OUT4
-IN4f
-OUT4f
 BEFORE5
 IN5
 OUT5
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 47c33d2aa33..588ff2b3c15 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -2,7 +2,7 @@ try-finally.mo:11.9-12.37: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:17.9-18.38: warning [M0145], this try handler of type
+try-finally.mo:16.9-17.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
@@ -10,63 +10,63 @@ try-finally.mo:22.9-23.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:69.9-74.38: warning [M0145], this try handler of type
+try-finally.mo:27.9-28.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:79.9-83.38: warning [M0145], this try handler of type
+try-finally.mo:74.9-79.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:88.9-92.47: warning [M0145], this try handler of type
+try-finally.mo:84.9-88.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:97.19-103.38: warning [M0145], this try handler of type
+try-finally.mo:94.19-100.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:111.13-117.49: warning [M0145], this try handler of type
+try-finally.mo:108.13-114.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:109.19-120.38: warning [M0145], this try handler of type
+try-finally.mo:106.19-117.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:128.13-134.50: warning [M0145], this try handler of type
+try-finally.mo:125.13-131.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:126.19-137.39: warning [M0145], this try handler of type
+try-finally.mo:123.19-134.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:143.19-157.39: warning [M0145], this try handler of type
+try-finally.mo:140.19-154.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:165.13-174.50: warning [M0145], this try handler of type
+try-finally.mo:162.13-171.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:163.19-177.39: warning [M0145], this try handler of type
+try-finally.mo:160.19-174.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:186.13-195.49: warning [M0145], this try handler of type
+try-finally.mo:183.13-192.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:184.19-198.38: warning [M0145], this try handler of type
+try-finally.mo:181.19-195.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:228.9-232.39: warning [M0145], this try handler of type
+try-finally.mo:225.9-229.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:236.9-240.38: warning [M0145], this try handler of type
+try-finally.mo:233.9-237.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 2443b31084b..876e280f986 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -12,6 +12,11 @@ actor A {
         finally { debugPrint "OUT" };
     };
 
+    func t0t() : async () {
+        try { debugPrint "INt" }
+        finally { debugPrint "OUTt" };
+    };
+
     func t0r() : async () {
         let p = principalOfActor A;
         try { debugPrint "INr"; ignore await call_raw(p, "raw", to_candid()); assert false }
@@ -84,14 +89,6 @@ actor A {
         return;
     };
 
-    func t4f() : async () {
-        try {
-            debugPrint "IN4f";
-            await m();
-        }
-        finally { debugPrint "OUT4f"; return };
-    };
-
     func t5() : async () {
         debugPrint "BEFORE5";
         label out try {
@@ -242,12 +239,12 @@ actor A {
 
     public func go() : async () {
         // These don't trap (for the interpreters)
+        await t0t();
         //await t1();
         await t2();
         ignore await t2i();
         await t3();
         await t4();
-        await t4f();
         await t5();
         await t6();
         await t8();

From aaf7f17f6addeebf12ad05c5c0f5d65e4cb365e9 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 1 Jul 2024 15:38:20 +0200
Subject: [PATCH 144/179] pre-massage the continuations

also prepare for deduplication
---
 src/ir_passes/await.ml                   | 30 +++++++++---------
 test/run-drun/ok/try-finally.drun-run.ok |  8 +++--
 test/run-drun/ok/try-finally.run-ir.ok   |  4 +++
 test/run-drun/ok/try-finally.run-low.ok  |  4 +++
 test/run-drun/ok/try-finally.run.ok      |  4 +++
 test/run-drun/ok/try-finally.tc.ok       | 40 ++++++++++++++----------
 test/run-drun/try-finally.mo             | 12 +++++++
 7 files changed, 69 insertions(+), 33 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index a10823305e3..bedc095fba1 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -351,14 +351,14 @@ and c_exp' context exp k =
       let error = fresh_var "v" T.catch  in
       let cases' =
         List.map
-          (fun {it = {pat;exp}; at; note} ->
+          (fun {it = { pat; exp }; at; note} ->
             let exp' = match eff exp with
-              | T.Triv -> varE k -*- (t_exp context exp)
+              | T.Triv -> varE k -*- t_exp context exp
               | T.Await -> c_exp context exp (ContVar k)
             in
-            { it = {pat;exp = exp' }; at; note })
+            { it = { pat; exp = exp' }; at; note })
           cases
-        @ [{ it = {pat = varP error; exp = varE f -*- varE error};
+        @ [{ it = { pat = varP error; exp = varE f -*- varE error };
              at = no_region;
              note = ()
         }] in
@@ -375,6 +375,12 @@ and c_exp' context exp k =
         (c_exp context' exp1 (ContVar k))
     ))
   | TryE (exp1, cases, Some (id2, typ2)) ->
+    let pre = function
+      | Cont k -> Cont (precont k (var id2 typ2))
+      | Label -> assert false in
+    (* All control-flow out must pass through the `finally` thunk *)
+    let context = LabelEnv.mapi (function | Return | Named _ | Cleanup -> pre
+                                          | Throw -> fun c -> c) context in
     (* assert that a surrounding `AwaitPrim _` has set up a `Cleanup` cont *)
     ignore (LabelEnv.find Cleanup context);
     (* TODO: do we need to reify f? *)
@@ -388,25 +394,19 @@ and c_exp' context exp k =
       let error = fresh_var "v" T.catch in
       let cases' =
         List.map
-          (fun {it = {pat;exp}; at; note} ->
+          (fun {it = { pat; exp }; at; note} ->
             let exp' = match eff exp with
-              | T.Triv -> varE k -*- (t_exp context exp)
+              | T.Triv -> varE k -*- t_exp context exp
               | T.Await -> c_exp context exp (ContVar k)
             in
             { it = { pat; exp = exp' }; at; note })
           cases
-        @ [{ it = {pat = varP error; exp = varE f -*- varE error};
+        @ [{ it = { pat = varP error; exp = varE f -*- varE error };
              at = no_region;
              note = ()
         }] in
       let throw = fresh_err_cont (answerT (typ_of_var k)) in
-      let pre = function
-        | Cont k -> Cont (precont k (var id2 typ2))
-        | Label -> assert false
-      in
-      let context' = LabelEnv.mapi (function | Return | Named _ | Cleanup -> pre
-                                             | Throw -> fun c -> c) context in
-      let context'' = LabelEnv.add Throw (Cont (ContVar throw)) context' in
+      let context' = LabelEnv.add Throw (Cont (ContVar throw)) context in
       blockE
         [ let e = fresh_var "e" T.catch in
           funcD throw e {
@@ -415,7 +415,7 @@ and c_exp' context exp k =
             note = Note.{ def with typ = typ_cases cases'; eff = T.Await; (* shouldn't matter *) }
           }
         ]
-        (c_exp context'' exp1 (ContVar k))
+        (c_exp context' exp1 (ContVar k))
     ))
   | LoopE exp1 ->
     c_loop context k exp1
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index b3b2c78c10a..fa95cf6546b 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -2,6 +2,10 @@ ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a000000000000000001
 ingress Completed: Reply: 0x4449444c0000
 debug.print: INt
 debug.print: OUTt
+debug.print: INl
+debug.print: OUTl
+debug.print: INe
+debug.print: OUTe
 debug.print: IN2
 debug.print: CAUGHT2
 debug.print: OUT2
@@ -72,7 +76,7 @@ debug.print: InnerLIVESTILL7
 debug.print: InnerOUT7
 debug.print: OUT7
 debug.print: It's over
-ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:190.17-190.29
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:200.17-200.29
 debug.print: go2
 debug.print: It's so over
-ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:272.13-272.25
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:284.13-284.25
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index d49476d15ed..f938970a513 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -1,5 +1,9 @@
 INt
 OUTt
+INl
+OUTl
+INe
+OUTe
 IN2
 CAUGHT2
 OUT2
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index d49476d15ed..f938970a513 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -1,5 +1,9 @@
 INt
 OUTt
+INl
+OUTl
+INe
+OUTe
 IN2
 CAUGHT2
 OUT2
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index d49476d15ed..f938970a513 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -1,5 +1,9 @@
 INt
 OUTt
+INl
+OUTl
+INe
+OUTe
 IN2
 CAUGHT2
 OUT2
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index 588ff2b3c15..a8b3cee6881 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -6,67 +6,75 @@ try-finally.mo:16.9-17.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:22.9-23.38: warning [M0145], this try handler of type
+try-finally.mo:21.19-22.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:27.9-28.38: warning [M0145], this try handler of type
+try-finally.mo:26.19-27.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:74.9-79.38: warning [M0145], this try handler of type
+try-finally.mo:32.9-33.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:84.9-88.38: warning [M0145], this try handler of type
+try-finally.mo:37.9-38.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:94.19-100.38: warning [M0145], this try handler of type
+try-finally.mo:84.9-89.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:108.13-114.49: warning [M0145], this try handler of type
+try-finally.mo:94.9-98.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:106.19-117.38: warning [M0145], this try handler of type
+try-finally.mo:104.19-110.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:125.13-131.50: warning [M0145], this try handler of type
+try-finally.mo:118.13-124.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:123.19-134.39: warning [M0145], this try handler of type
+try-finally.mo:116.19-127.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:140.19-154.39: warning [M0145], this try handler of type
+try-finally.mo:135.13-141.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:162.13-171.50: warning [M0145], this try handler of type
+try-finally.mo:133.19-144.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:160.19-174.39: warning [M0145], this try handler of type
+try-finally.mo:150.19-164.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:183.13-192.49: warning [M0145], this try handler of type
+try-finally.mo:172.13-181.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:181.19-195.38: warning [M0145], this try handler of type
+try-finally.mo:170.19-184.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:225.9-229.39: warning [M0145], this try handler of type
+try-finally.mo:193.13-202.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:233.9-237.38: warning [M0145], this try handler of type
+try-finally.mo:191.19-205.38: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:235.9-239.39: warning [M0145], this try handler of type
+  Error
+does not cover value
+  _
+try-finally.mo:243.9-247.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 876e280f986..7aada82785d 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -17,6 +17,16 @@ actor A {
         finally { debugPrint "OUTt" };
     };
 
+    func t0l() : async () {
+        label out try { debugPrint "INl"; break out }
+        finally { debugPrint "OUTl" };
+    };
+
+    func t0e() : async () {
+        label out try { debugPrint "INe"; return () }
+        finally { debugPrint "OUTe" };
+    };
+
     func t0r() : async () {
         let p = principalOfActor A;
         try { debugPrint "INr"; ignore await call_raw(p, "raw", to_candid()); assert false }
@@ -240,6 +250,8 @@ actor A {
     public func go() : async () {
         // These don't trap (for the interpreters)
         await t0t();
+        await t0l();
+        await t0e();
         //await t1();
         await t2();
         ignore await t2i();

From 0775cd385f0816a9b9ee04a0adcdc32b75eb6d28 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Mon, 1 Jul 2024 16:18:04 +0200
Subject: [PATCH 145/179] use builtin

---
 src/lib/lib.ml | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/lib/lib.ml b/src/lib/lib.ml
index e4517cc22f3..ee6c5b0c2f3 100644
--- a/src/lib/lib.ml
+++ b/src/lib/lib.ml
@@ -502,10 +502,7 @@ end
 
 module Option =
 struct
-  let get o x =
-    match o with
-    | Some y -> y
-    | None -> x
+  let get o x = Option.value o ~default:x
 
   let map2 (f : 'a -> 'b -> 'c) (a : 'a option) (b : 'b option) =
     match a, b with

From 1ea9792be4f0b8da5b9003e80d119e33f3c06776 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 3 Jul 2024 10:55:35 +0200
Subject: [PATCH 146/179] out-edge from `catch`

exposes a bug
---
 test/run-drun/try-finally.mo | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 7aada82785d..90d7725b5f6 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -60,6 +60,26 @@ actor A {
         finally { debugPrint "OUT2" };
     };
 
+    func t2r() : async () {
+        try {
+            debugPrint "IN2r";
+            throw error "IN2r";
+        }
+        catch _ { debugPrint "CAUGHT2r"; return }
+        finally { debugPrint "OUT2r" };
+        debugPrint "DEAD2r"
+    };
+
+    func t2b() : async () {
+        label out try {
+            debugPrint "IN2b";
+            throw error "IN2b";
+        }
+        catch _ { debugPrint "CAUGHT2b"; break out }
+        finally { debugPrint "OUT2b" };
+        debugPrint "AFTER2b"
+    };
+
     func t2i() : async Int {
         try {
             debugPrint "IN2i";
@@ -254,6 +274,8 @@ actor A {
         await t0e();
         //await t1();
         await t2();
+        await t2r();
+        await t2b();
         ignore await t2i();
         await t3();
         await t4();

From 3f041f500b3118bbbf7ac4006815595ff3b24546 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 3 Jul 2024 16:35:24 +0200
Subject: [PATCH 147/179] step towards deduplication

and a comprehensivity tweak
---
 src/ir_passes/await.ml | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index bedc095fba1..7acd8e5468f 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -12,6 +12,8 @@ let fresh_cont typ ans_typ = fresh_var "k" (contT typ ans_typ)
 
 let fresh_err_cont ans_typ  = fresh_var "r" (err_contT ans_typ)
 
+let fresh_bail_cont ans_typ = fresh_var "b" bail_contT
+
 (* continuations, syntactic and meta-level *)
 
 type kont = ContVar of var
@@ -81,7 +83,7 @@ let rec t_async context exp =
    (* add the implicit return label *)
    let k_ret = fresh_cont (typ exp1) T.unit in
    let k_fail = fresh_err_cont T.unit in
-   let k_clean = fresh_cont T.unit T.unit in
+   let k_clean = fresh_bail_cont T.unit in
    let context' =
      LabelEnv.add Cleanup (Cont (ContVar k_clean))
        (LabelEnv.add Return (Cont (ContVar k_ret))
@@ -374,15 +376,18 @@ and c_exp' context exp k =
         ]
         (c_exp context' exp1 (ContVar k))
     ))
-  | TryE (exp1, cases, Some (id2, typ2)) ->
+  | TryE (exp1, cases, finally_opt) ->
     let pre = function
-      | Cont k -> Cont (precont k (var id2 typ2))
+      | Cont k -> (match finally_opt with
+                   | Some (id2, typ2) -> Cont (precont k (var id2 typ2))
+                   | None -> Cont k)
       | Label -> assert false in
     (* All control-flow out must pass through the `finally` thunk *)
     let context = LabelEnv.mapi (function | Return | Named _ | Cleanup -> pre
                                           | Throw -> fun c -> c) context in
     (* assert that a surrounding `AwaitPrim _` has set up a `Cleanup` cont *)
-    ignore (LabelEnv.find Cleanup context);
+    if finally_opt <> None
+    then ignore (LabelEnv.find Cleanup context);
     (* TODO: do we need to reify f? *)
     let f = match LabelEnv.find Throw context with Cont f -> f | _ -> assert false in
     letcont f (fun f ->
@@ -448,7 +453,7 @@ and c_exp' context exp k =
     (* add the implicit return label *)
     let k_ret = fresh_cont (typ exp1) T.unit in
     let k_fail = fresh_err_cont T.unit in
-    let k_clean = fresh_cont T.unit T.unit in
+    let k_clean = fresh_bail_cont T.unit in
     let context' =
       LabelEnv.add Cleanup (Cont (ContVar k_clean))
         (LabelEnv.add Return (Cont (ContVar k_ret))

From 1c95539bf7245095e02c522334d11d9c52296f1b Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Wed, 3 Jul 2024 16:37:49 +0200
Subject: [PATCH 148/179] now we can deduplicate

---
 src/ir_passes/await.ml | 35 -----------------------------------
 1 file changed, 35 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 7acd8e5468f..9e74d9b3955 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -341,41 +341,6 @@ and c_exp' context exp k =
                at = exp.at;
                note = Note.{ exp.note with typ = typ' } }))
     end)
-  | TryE (exp1, cases, None) ->
-    (* TODO: do we need to reify f? *)
-    let f = match LabelEnv.find Throw context with Cont f -> f | _ -> assert false in
-    letcont f (fun f ->
-    letcont k (fun k ->
-    match eff exp1 with
-    | T.Triv ->
-      varE k -*- t_exp context exp1
-    | T.Await ->
-      let error = fresh_var "v" T.catch  in
-      let cases' =
-        List.map
-          (fun {it = { pat; exp }; at; note} ->
-            let exp' = match eff exp with
-              | T.Triv -> varE k -*- t_exp context exp
-              | T.Await -> c_exp context exp (ContVar k)
-            in
-            { it = { pat; exp = exp' }; at; note })
-          cases
-        @ [{ it = { pat = varP error; exp = varE f -*- varE error };
-             at = no_region;
-             note = ()
-        }] in
-      let throw = fresh_err_cont (answerT (typ_of_var k)) in
-      let context' = LabelEnv.add Throw (Cont (ContVar throw)) context in
-      blockE
-        [ let e = fresh_var "e" T.catch in
-          funcD throw e {
-            it = SwitchE (varE e, cases');
-            at = exp.at;
-            note = Note.{ def with typ = typ_cases cases'; eff = T.Await; (* shouldn't matter *) }
-          }
-        ]
-        (c_exp context' exp1 (ContVar k))
-    ))
   | TryE (exp1, cases, finally_opt) ->
     let pre = function
       | Cont k -> (match finally_opt with

From 8d1245fca65aa2c83be67248d68ca1b91e4e40f0 Mon Sep 17 00:00:00 2001
From: luc-blaeser <luc.blaeser@dfinity.org>
Date: Thu, 4 Jul 2024 09:52:48 +0200
Subject: [PATCH 149/179] Manual merge conflict resolution

---
 test/bench/ok/bignum.drun-run.ok | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/test/bench/ok/bignum.drun-run.ok b/test/bench/ok/bignum.drun-run.ok
index dcab51a7f2e..b7ccbbf2d34 100644
--- a/test/bench/ok/bignum.drun-run.ok
+++ b/test/bench/ok/bignum.drun-run.ok
@@ -1,6 +1,6 @@
 ingress Completed: Reply: 0x4449444c016c01b3c4b1f204680100010a00000000000000000101
 ingress Completed: Reply: 0x4449444c0000
-debug.print: {cycles = 2_626_820; size = +60_128}
+debug.print: {cycles = 2_626_730; size = +60_128}
 ingress Completed: Reply: 0x4449444c0000
-debug.print: {cycles = 107_960_464; size = +1_826_952}
+debug.print: {cycles = 107_960_494; size = +1_826_952}
 ingress Completed: Reply: 0x4449444c0000

From 0084937b380c9758c524120caeab75924ff904ac Mon Sep 17 00:00:00 2001
From: luc-blaeser <luc.blaeser@dfinity.org>
Date: Thu, 4 Jul 2024 10:34:39 +0200
Subject: [PATCH 150/179] Merge try-finally to classical persistence backend

---
 src/codegen/compile_classical.ml | 91 ++++++++++++++++++--------------
 1 file changed, 51 insertions(+), 40 deletions(-)

diff --git a/src/codegen/compile_classical.ml b/src/codegen/compile_classical.ml
index 0a03b81fef0..061d195f9a9 100644
--- a/src/codegen/compile_classical.ml
+++ b/src/codegen/compile_classical.ml
@@ -9220,39 +9220,39 @@ module FuncDec = struct
     ))
 
   let message_start env sort = match sort with
-      | Type.Shared Type.Write ->
-        Lifecycle.trans env Lifecycle.InUpdate
-      | Type.Shared Type.Query ->
-        Lifecycle.trans env Lifecycle.InQuery
-      | Type.Shared Type.Composite ->
-        Lifecycle.trans env Lifecycle.InComposite
+      | Type.(Shared Write) ->
+        Lifecycle.(trans env InUpdate)
+      | Type.(Shared Query) ->
+        Lifecycle.(trans env InQuery)
+      | Type.(Shared Composite) ->
+        Lifecycle.(trans env InComposite)
       | _ -> assert false
 
   let message_cleanup env sort = match sort with
-      | Type.Shared Type.Write ->
+      | Type.(Shared Write) ->
         GC.collect_garbage env ^^
-        Lifecycle.trans env Lifecycle.Idle
-      | Type.Shared Type.Query ->
-        Lifecycle.trans env Lifecycle.PostQuery
-      | Type.Shared Type.Composite ->
+        Lifecycle.(trans env Idle)
+      | Type.(Shared Query) ->
+        Lifecycle.(trans env PostQuery)
+      | Type.(Shared Composite) ->
         (* Stay in composite query state such that callbacks of 
         composite queries can also use the memory reserve. 
         The state is isolated since memory changes of queries 
         are rolled back by the IC runtime system. *)
-        Lifecycle.trans env Lifecycle.InComposite
+        Lifecycle.(trans env InComposite)
       | _ -> assert false
 
   let callback_start env =
-    Lifecycle.is_in env Lifecycle.InComposite ^^
+    Lifecycle.(is_in env InComposite) ^^
     G.if0
       (G.nop)
-      (message_start env (Type.Shared Type.Write))
+      (message_start env Type.(Shared Write))
 
   let callback_cleanup env =
-    Lifecycle.is_in env Lifecycle.InComposite ^^
+    Lifecycle.(is_in env InComposite) ^^
     G.if0
       (G.nop)
-      (message_cleanup env (Type.Shared Type.Write))
+      (message_cleanup env Type.(Shared Write))
   
   let compile_const_message outer_env outer_ae sort control args mk_body ret_tys at : E.func_with_names =
     let ae0 = VarEnv.mk_fun_ae outer_ae in
@@ -9454,7 +9454,7 @@ module FuncDec = struct
     (* result is a function that accepts a list of closure getters, from which
        the first and second must be the reply and reject continuations. *)
     fun closure_getters ->
-      let (set_cb_index, get_cb_index) = new_local env "cb_index" in
+      let set_cb_index, get_cb_index = new_local env "cb_index" in
       Arr.lit env Tagged.T closure_getters ^^
       ContinuationTable.remember env ^^
       set_cb_index ^^
@@ -9482,7 +9482,12 @@ module FuncDec = struct
     Func.define_built_in env name ["env", I32Type] [] (fun env ->
         G.i (LocalGet (nr 0l)) ^^
         ContinuationTable.recall env ^^
-        G.i Drop);
+        Arr.load_field env 2l ^^ (* get the cleanup closure *)
+        let set_closure, get_closure = new_local env "closure" in
+        set_closure ^^ get_closure ^^
+        Closure.prepare_closure_call env ^^
+        get_closure ^^
+        Closure.call_closure env 0 0);
     compile_unboxed_const (E.add_fun_ptr env (E.built_in env name))
 
   let ic_call_threaded env purpose get_meth_pair push_continuations
@@ -9531,29 +9536,29 @@ module FuncDec = struct
     | _ ->
       E.trap_with env (Printf.sprintf "cannot perform %s when running locally" purpose)
 
-  let ic_call env ts1 ts2 get_meth_pair get_arg get_k get_r =
+  let ic_call env ts1 ts2 get_meth_pair get_arg get_k get_r get_c =
     ic_call_threaded
       env
       "remote call"
       get_meth_pair
-      (closures_to_reply_reject_callbacks env ts2 [get_k; get_r])
+      (closures_to_reply_reject_callbacks env ts2 [get_k; get_r; get_c])
       (fun _ -> get_arg ^^ Serialization.serialize env ts1)
 
-  let ic_call_raw env get_meth_pair get_arg get_k get_r =
+  let ic_call_raw env get_meth_pair get_arg get_k get_r get_c =
     ic_call_threaded
       env
       "raw call"
       get_meth_pair
-      (closures_to_raw_reply_reject_callbacks env [get_k; get_r])
+      (closures_to_raw_reply_reject_callbacks env [get_k; get_r; get_c])
       (fun _ -> get_arg ^^ Blob.as_ptr_len env)
 
-  let ic_self_call env ts get_meth_pair get_future get_k get_r =
+  let ic_self_call env ts get_meth_pair get_future get_k get_r get_c =
     ic_call_threaded
       env
       "self call"
       get_meth_pair
-      (* Storing the tuple away, future_array_index = 2, keep in sync with rts/continuation_table.rs *)
-      (closures_to_reply_reject_callbacks env ts [get_k; get_r; get_future])
+      (* Storing the tuple away, future_array_index = 3, keep in sync with rts/continuation_table.rs *)
+      (closures_to_reply_reject_callbacks env ts [get_k; get_r; get_c; get_future])
       (fun get_cb_index ->
         get_cb_index ^^
         BoxedSmallWord.box env Type.Nat32 ^^
@@ -11865,7 +11870,7 @@ and compile_prim_invocation (env : E.t) ae p es at =
   | ICCallerPrim, [] ->
     SR.Vanilla, IC.caller env
 
-  | ICCallPrim, [f;e;k;r] ->
+  | ICCallPrim, [f;e;k;r;c] ->
     SR.unit, begin
     (* TBR: Can we do better than using the notes? *)
     let _, _, _, ts1, _ = Type.as_func f.note.Note.typ in
@@ -11874,19 +11879,22 @@ and compile_prim_invocation (env : E.t) ae p es at =
     let (set_arg, get_arg) = new_local env "arg" in
     let (set_k, get_k) = new_local env "k" in
     let (set_r, get_r) = new_local env "r" in
+    let (set_c, get_c) = new_local env "c" in
     let add_cycles = Internals.add_cycles env ae in
     compile_exp_vanilla env ae f ^^ set_meth_pair ^^
     compile_exp_vanilla env ae e ^^ set_arg ^^
     compile_exp_vanilla env ae k ^^ set_k ^^
     compile_exp_vanilla env ae r ^^ set_r ^^
-    FuncDec.ic_call env ts1 ts2 get_meth_pair get_arg get_k get_r add_cycles
+    compile_exp_vanilla env ae c ^^ set_c ^^
+    FuncDec.ic_call env ts1 ts2 get_meth_pair get_arg get_k get_r get_c add_cycles
     end
-  | ICCallRawPrim, [p;m;a;k;r] ->
+  | ICCallRawPrim, [p;m;a;k;r;c] ->
     SR.unit, begin
-    let (set_meth_pair, get_meth_pair) = new_local env "meth_pair" in
-    let (set_arg, get_arg) = new_local env "arg" in
-    let (set_k, get_k) = new_local env "k" in
-    let (set_r, get_r) = new_local env "r" in
+    let set_meth_pair, get_meth_pair = new_local env "meth_pair" in
+    let set_arg, get_arg = new_local env "arg" in
+    let set_k, get_k = new_local env "k" in
+    let set_r, get_r = new_local env "r" in
+    let set_c, get_c = new_local env "c" in
     let add_cycles = Internals.add_cycles env ae in
     compile_exp_vanilla env ae p ^^
     compile_exp_vanilla env ae m ^^ Text.to_blob env ^^
@@ -11895,7 +11903,8 @@ and compile_prim_invocation (env : E.t) ae p es at =
     compile_exp_vanilla env ae a ^^ set_arg ^^
     compile_exp_vanilla env ae k ^^ set_k ^^
     compile_exp_vanilla env ae r ^^ set_r ^^
-    FuncDec.ic_call_raw env get_meth_pair get_arg get_k get_r add_cycles
+    compile_exp_vanilla env ae c ^^ set_c ^^
+    FuncDec.ic_call_raw env get_meth_pair get_arg get_k get_r get_c add_cycles
     end
 
   | ICMethodNamePrim, [] ->
@@ -12104,11 +12113,12 @@ and compile_exp_with_hint (env : E.t) ae sr_hint exp =
     let return_arity = List.length return_tys in
     let mk_body env1 ae1 = compile_exp_as env1 ae1 (StackRep.of_arity return_arity) e in
     FuncDec.lit env ae x sort control captured args mk_body return_tys exp.at
-  | SelfCallE (ts, exp_f, exp_k, exp_r) ->
+  | SelfCallE (ts, exp_f, exp_k, exp_r, exp_c) ->
     SR.unit,
     let (set_future, get_future) = new_local env "future" in
     let (set_k, get_k) = new_local env "k" in
     let (set_r, get_r) = new_local env "r" in
+    let (set_c, get_c) = new_local env "c" in
     let mk_body env1 ae1 = compile_exp_as env1 ae1 SR.unit exp_f in
     let captured = Freevars.captured exp_f in
     let add_cycles = Internals.add_cycles env ae in
@@ -12118,6 +12128,7 @@ and compile_exp_with_hint (env : E.t) ae sr_hint exp =
 
     compile_exp_vanilla env ae exp_k ^^ set_k ^^
     compile_exp_vanilla env ae exp_r ^^ set_r ^^
+    compile_exp_vanilla env ae exp_c ^^ set_c ^^
 
     FuncDec.ic_self_call env ts
       IC.(get_self_reference env ^^
@@ -12125,8 +12136,9 @@ and compile_exp_with_hint (env : E.t) ae sr_hint exp =
       get_future
       get_k
       get_r
+      get_c
       add_cycles
-  | ActorE (ds, fs, _, _) ->
+  | ActorE (ds, fs, _, _, _) ->
     fatal "Local actors not supported by backend"
   | NewObjE (Type.(Object | Module | Memory) as _sort, fs, _) ->
     (*
@@ -12668,8 +12680,8 @@ and compile_init_func mod_env ((cu, flavor) : Ir.prog) =
       let _ae, codeW = compile_decs env VarEnv.empty_ae ds Freevars.S.empty in
       codeW G.nop
     )
-  | ActorU (as_opt, ds, fs, up, t) ->
-    main_actor as_opt mod_env ds fs up
+  | ActorU (as_opt, ds, fs, up, _t, build_stable_actor) ->
+    main_actor as_opt mod_env ds fs up build_stable_actor
 
 and export_actor_field env  ae (f : Ir.field) =
   (* A public actor field is guaranteed to be compiled as a PublicMethod *)
@@ -12695,12 +12707,11 @@ and export_actor_field env  ae (f : Ir.field) =
   })
 
 (* Main actor *)
-and main_actor as_opt mod_env ds fs up =
+and main_actor as_opt mod_env ds fs up build_stable_actor =
   Func.define_built_in mod_env "init" [] [] (fun env ->
-    let build_stable_actor = up.stable_record in
     let ae0 = VarEnv.empty_ae in
 
-    let captured = Freevars.captured_vars (Freevars.actor ds fs up) in
+    let captured = Freevars.captured_vars (Freevars.actor ds fs up build_stable_actor) in
     (* Add any params to the environment *)
     (* Captured ones need to go into static memory, the rest into locals *)
     let args = match as_opt with None -> [] | Some as_ -> as_ in

From 7e4581e72c3433f2b90a3548831dd3517d402539 Mon Sep 17 00:00:00 2001
From: luc-blaeser <luc.blaeser@dfinity.org>
Date: Thu, 4 Jul 2024 10:42:49 +0200
Subject: [PATCH 151/179] Manual merge conflict resolution

---
 src/codegen/compile_classical.ml | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/src/codegen/compile_classical.ml b/src/codegen/compile_classical.ml
index 061d195f9a9..b90c6ada973 100644
--- a/src/codegen/compile_classical.ml
+++ b/src/codegen/compile_classical.ml
@@ -12138,7 +12138,7 @@ and compile_exp_with_hint (env : E.t) ae sr_hint exp =
       get_r
       get_c
       add_cycles
-  | ActorE (ds, fs, _, _, _) ->
+  | ActorE (ds, fs, _, _) ->
     fatal "Local actors not supported by backend"
   | NewObjE (Type.(Object | Module | Memory) as _sort, fs, _) ->
     (*
@@ -12680,8 +12680,8 @@ and compile_init_func mod_env ((cu, flavor) : Ir.prog) =
       let _ae, codeW = compile_decs env VarEnv.empty_ae ds Freevars.S.empty in
       codeW G.nop
     )
-  | ActorU (as_opt, ds, fs, up, _t, build_stable_actor) ->
-    main_actor as_opt mod_env ds fs up build_stable_actor
+  | ActorU (as_opt, ds, fs, up, t) ->
+    main_actor as_opt mod_env ds fs up
 
 and export_actor_field env  ae (f : Ir.field) =
   (* A public actor field is guaranteed to be compiled as a PublicMethod *)
@@ -12707,11 +12707,12 @@ and export_actor_field env  ae (f : Ir.field) =
   })
 
 (* Main actor *)
-and main_actor as_opt mod_env ds fs up build_stable_actor =
+and main_actor as_opt mod_env ds fs up =
+  let build_stable_actor = up.stable_record in
   Func.define_built_in mod_env "init" [] [] (fun env ->
     let ae0 = VarEnv.empty_ae in
 
-    let captured = Freevars.captured_vars (Freevars.actor ds fs up build_stable_actor) in
+    let captured = Freevars.captured_vars (Freevars.actor ds fs up) in
     (* Add any params to the environment *)
     (* Captured ones need to go into static memory, the rest into locals *)
     let args = match as_opt with None -> [] | Some as_ -> as_ in

From f83da8b65cddfdd3f733e185a4220507ee8fe842 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 12:39:08 +0200
Subject: [PATCH 152/179] WIP: remove the `finally`-insertion from `desugar.ml`
 and add it to `await.ml`

there is some fallout:
- the AST and (unlowered) IR-interpreter both miss the success continuation's cleanup
- the new testcase shows that the re-`throw` still ignores a `finally`
---
 src/ir_passes/await.ml                   | 16 +++++----
 src/lowering/desugar.ml                  |  8 ++---
 test/run-drun/ok/try-finally.diff-ir.ok  | 44 ++++++++++++++++++++++++
 test/run-drun/ok/try-finally.diff-low.ok | 13 +++++++
 test/run-drun/ok/try-finally.drun-run.ok | 18 ++++++++--
 test/run-drun/ok/try-finally.run-ir.ok   | 18 ++++++----
 test/run-drun/ok/try-finally.run-low.ok  | 14 ++++++++
 test/run-drun/ok/try-finally.run.ok      | 12 +++++++
 test/run-drun/ok/try-finally.tc.ok       | 28 +++++++--------
 test/run-drun/try-finally.mo             | 17 +++++++++
 10 files changed, 153 insertions(+), 35 deletions(-)
 create mode 100644 test/run-drun/ok/try-finally.diff-ir.ok
 create mode 100644 test/run-drun/ok/try-finally.diff-low.ok

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 9e74d9b3955..db19b3aaf4d 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -342,13 +342,15 @@ and c_exp' context exp k =
                note = Note.{ exp.note with typ = typ' } }))
     end)
   | TryE (exp1, cases, finally_opt) ->
-    let pre = function
-      | Cont k -> (match finally_opt with
-                   | Some (id2, typ2) -> Cont (precont k (var id2 typ2))
-                   | None -> Cont k)
+     let pre k =
+       match finally_opt with
+       | Some (id2, typ2) -> precont k (var id2 typ2)
+       | None -> k in
+    let pre' = function
+      | Cont k -> Cont (pre k)
       | Label -> assert false in
-    (* All control-flow out must pass through the `finally` thunk *)
-    let context = LabelEnv.mapi (function | Return | Named _ | Cleanup -> pre
+    (* All control-flow out must pass through the potential `finally` thunk *)
+    let context = LabelEnv.mapi (function | Return | Named _ | Cleanup -> pre'
                                           | Throw -> fun c -> c) context in
     (* assert that a surrounding `AwaitPrim _` has set up a `Cleanup` cont *)
     if finally_opt <> None
@@ -356,7 +358,7 @@ and c_exp' context exp k =
     (* TODO: do we need to reify f? *)
     let f = match LabelEnv.find Throw context with Cont f -> f | _ -> assert false in
     letcont f (fun f ->
-    letcont k (fun k ->
+    letcont (pre k) (fun k ->
     match eff exp1 with
     | T.Triv ->
       varE k -*- t_exp context exp1
diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
index 93f0ddfc4f8..f360aece8b6 100644
--- a/src/lowering/desugar.ml
+++ b/src/lowering/desugar.ml
@@ -221,11 +221,9 @@ and exp' at note = function
     let thunk = T.(funcE ("$cleanup") Local Returns [] [] [] (exp e2)) in
     assert T.(is_func thunk.note.Note.typ);
     let th = fresh_var "thunk" thunk.note.Note.typ in
-    let v = fresh_var "res" note.Note.typ in
-    (blockE [ letD th thunk
-            ; letD v { e1 with it = I.TryE (exp e1, cases cs, Some (id_of_var th, typ_of_var th)); note }
-            ; expD (varE th -*- unitE ())
-            ] (varE v)).it
+    (blockE
+       [ letD th thunk ]
+       { e1 with it = I.TryE (exp e1, cases cs, Some (id_of_var th, typ_of_var th)); note }).it
   | S.WhileE (e1, e2) -> (whileE (exp e1) (exp e2)).it
   | S.LoopE (e1, None) -> I.LoopE (exp e1)
   | S.LoopE (e1, Some e2) -> (loopWhileE (exp e1) (exp e2)).it
diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
new file mode 100644
index 00000000000..d3d3328867e
--- /dev/null
+++ b/test/run-drun/ok/try-finally.diff-ir.ok
@@ -0,0 +1,44 @@
+--- try-finally.run
++++ try-finally.run-ir
+@@ -1,5 +1,4 @@
+ INt
+-OUTt
+ INl
+ OUTl
+ INe
+@@ -9,11 +8,9 @@
+ IN1tInner
+ CAUGHT1tInner
+ CAUGHT1t
+-OUT1t
+ AFTER1t
+ IN2
+ CAUGHT2
+-OUT2
+ IN2r
+ CAUGHT2r
+ IN2b
+@@ -21,11 +18,9 @@
+ AFTER2b
+ IN2i
+ CAUGHT2i
+-OUT2i
+ IN3
+ OUT3
+ IN4
+-OUT4
+ BEFORE5
+ IN5
+ OUT5
+@@ -39,11 +34,8 @@
+ AFTER6
+ IN8
+ CAUGHT8
+-OUT8
+ IN8i
+ CAUGHT8i
+-OUT8i
+ IN9
+-OUT9
+ IN
+ try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.diff-low.ok b/test/run-drun/ok/try-finally.diff-low.ok
new file mode 100644
index 00000000000..6d24ddb0412
--- /dev/null
+++ b/test/run-drun/ok/try-finally.diff-low.ok
@@ -0,0 +1,13 @@
+--- try-finally.run
++++ try-finally.run-low
+@@ -16,8 +16,10 @@
+ OUT2
+ IN2r
+ CAUGHT2r
++OUT2r
+ IN2b
+ CAUGHT2b
++OUT2b
+ AFTER2b
+ IN2i
+ CAUGHT2i
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index fa95cf6546b..0cc079b0061 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -6,9 +6,23 @@ debug.print: INl
 debug.print: OUTl
 debug.print: INe
 debug.print: OUTe
+debug.print: BEFORE1t
+debug.print: IN1t
+debug.print: IN1tInner
+debug.print: CAUGHT1tInner
+debug.print: CAUGHT1t
+debug.print: OUT1t
+debug.print: AFTER1t
 debug.print: IN2
 debug.print: CAUGHT2
 debug.print: OUT2
+debug.print: IN2r
+debug.print: CAUGHT2r
+debug.print: OUT2r
+debug.print: IN2b
+debug.print: CAUGHT2b
+debug.print: OUT2b
+debug.print: AFTER2b
 debug.print: IN2i
 debug.print: CAUGHT2i
 debug.print: OUT2i
@@ -76,7 +90,7 @@ debug.print: InnerLIVESTILL7
 debug.print: InnerOUT7
 debug.print: OUT7
 debug.print: It's over
-ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:200.17-200.29
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:236.17-236.29
 debug.print: go2
 debug.print: It's so over
-ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:284.13-284.25
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:323.13-323.25
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index f938970a513..5ab1c33d17e 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -1,19 +1,26 @@
 INt
-OUTt
 INl
 OUTl
 INe
 OUTe
+BEFORE1t
+IN1t
+IN1tInner
+CAUGHT1tInner
+CAUGHT1t
+AFTER1t
 IN2
 CAUGHT2
-OUT2
+IN2r
+CAUGHT2r
+IN2b
+CAUGHT2b
+AFTER2b
 IN2i
 CAUGHT2i
-OUT2i
 IN3
 OUT3
 IN4
-OUT4
 BEFORE5
 IN5
 OUT5
@@ -27,11 +34,8 @@ OUT6
 AFTER6
 IN8
 CAUGHT8
-OUT8
 IN8i
 CAUGHT8i
-OUT8i
 IN9
-OUT9
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index f938970a513..b43ba679b0f 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -4,9 +4,23 @@ INl
 OUTl
 INe
 OUTe
+BEFORE1t
+IN1t
+IN1tInner
+CAUGHT1tInner
+CAUGHT1t
+OUT1t
+AFTER1t
 IN2
 CAUGHT2
 OUT2
+IN2r
+CAUGHT2r
+OUT2r
+IN2b
+CAUGHT2b
+OUT2b
+AFTER2b
 IN2i
 CAUGHT2i
 OUT2i
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index f938970a513..4297073adf1 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -4,9 +4,21 @@ INl
 OUTl
 INe
 OUTe
+BEFORE1t
+IN1t
+IN1tInner
+CAUGHT1tInner
+CAUGHT1t
+OUT1t
+AFTER1t
 IN2
 CAUGHT2
 OUT2
+IN2r
+CAUGHT2r
+IN2b
+CAUGHT2b
+AFTER2b
 IN2i
 CAUGHT2i
 OUT2i
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
index a8b3cee6881..47a900bf832 100644
--- a/test/run-drun/ok/try-finally.tc.ok
+++ b/test/run-drun/ok/try-finally.tc.ok
@@ -22,59 +22,59 @@ try-finally.mo:37.9-38.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:84.9-89.38: warning [M0145], this try handler of type
+try-finally.mo:120.9-125.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:94.9-98.38: warning [M0145], this try handler of type
+try-finally.mo:130.9-134.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:104.19-110.38: warning [M0145], this try handler of type
+try-finally.mo:140.19-146.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:118.13-124.49: warning [M0145], this try handler of type
+try-finally.mo:154.13-160.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:116.19-127.38: warning [M0145], this try handler of type
+try-finally.mo:152.19-163.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:135.13-141.50: warning [M0145], this try handler of type
+try-finally.mo:171.13-177.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:133.19-144.39: warning [M0145], this try handler of type
+try-finally.mo:169.19-180.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:150.19-164.39: warning [M0145], this try handler of type
+try-finally.mo:186.19-200.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:172.13-181.50: warning [M0145], this try handler of type
+try-finally.mo:208.13-217.50: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:170.19-184.39: warning [M0145], this try handler of type
+try-finally.mo:206.19-220.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:193.13-202.49: warning [M0145], this try handler of type
+try-finally.mo:229.13-238.49: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:191.19-205.38: warning [M0145], this try handler of type
+try-finally.mo:227.19-241.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:235.9-239.39: warning [M0145], this try handler of type
+try-finally.mo:271.9-275.39: warning [M0145], this try handler of type
   Error
 does not cover value
   _
-try-finally.mo:243.9-247.38: warning [M0145], this try handler of type
+try-finally.mo:279.9-283.38: warning [M0145], this try handler of type
   Error
 does not cover value
   _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 90d7725b5f6..3b2a0b38649 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -51,6 +51,22 @@ actor A {
     };
 */
 
+    func t1t() : async () {
+        debugPrint "BEFORE1t";
+        try {
+            debugPrint "IN1t";
+            try {
+                debugPrint "IN1tInner";
+                throw error "IN1tInner";
+            }
+            catch e { debugPrint "CAUGHT1tInner"; throw e }
+            finally { debugPrint "OUT1tInner" };
+        }
+        catch _ { debugPrint "CAUGHT1t" }
+        finally { debugPrint "OUT1t" };
+        debugPrint "AFTER1t"
+    };
+
     func t2() : async () {
         try {
             debugPrint "IN2";
@@ -273,6 +289,7 @@ actor A {
         await t0l();
         await t0e();
         //await t1();
+        await t1t();
         await t2();
         await t2r();
         await t2b();

From c4bd5b1c12692c4cc27ddd293febc450df6c75ae Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 12:42:53 +0200
Subject: [PATCH 153/179] fix the re-`throw` to not ignore a `finally`

---
 src/ir_passes/await.ml                   |  4 ++--
 test/run-drun/ok/try-finally.diff-low.ok | 10 +++++++++-
 test/run-drun/ok/try-finally.drun-run.ok |  1 +
 test/run-drun/ok/try-finally.run-low.ok  |  1 +
 4 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index db19b3aaf4d..c906dce75ac 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -350,8 +350,8 @@ and c_exp' context exp k =
       | Cont k -> Cont (pre k)
       | Label -> assert false in
     (* All control-flow out must pass through the potential `finally` thunk *)
-    let context = LabelEnv.mapi (function | Return | Named _ | Cleanup -> pre'
-                                          | Throw -> fun c -> c) context in
+    let context = LabelEnv.mapi (function | Return | Named _ | Cleanup
+                                          | Throw -> pre') context in
     (* assert that a surrounding `AwaitPrim _` has set up a `Cleanup` cont *)
     if finally_opt <> None
     then ignore (LabelEnv.find Cleanup context);
diff --git a/test/run-drun/ok/try-finally.diff-low.ok b/test/run-drun/ok/try-finally.diff-low.ok
index 6d24ddb0412..b0216806109 100644
--- a/test/run-drun/ok/try-finally.diff-low.ok
+++ b/test/run-drun/ok/try-finally.diff-low.ok
@@ -1,6 +1,14 @@
 --- try-finally.run
 +++ try-finally.run-low
-@@ -16,8 +16,10 @@
+@@ -8,6 +8,7 @@
+ IN1t
+ IN1tInner
+ CAUGHT1tInner
++OUT1tInner
+ CAUGHT1t
+ OUT1t
+ AFTER1t
+@@ -16,8 +17,10 @@
  OUT2
  IN2r
  CAUGHT2r
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 0cc079b0061..8ca1ac135f1 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -10,6 +10,7 @@ debug.print: BEFORE1t
 debug.print: IN1t
 debug.print: IN1tInner
 debug.print: CAUGHT1tInner
+debug.print: OUT1tInner
 debug.print: CAUGHT1t
 debug.print: OUT1t
 debug.print: AFTER1t
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index b43ba679b0f..1dc75244df7 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -8,6 +8,7 @@ BEFORE1t
 IN1t
 IN1tInner
 CAUGHT1tInner
+OUT1tInner
 CAUGHT1t
 OUT1t
 AFTER1t

From 27bba803d4f6a6f9270e5211b268d2a388640bd8 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 12:46:35 +0200
Subject: [PATCH 154/179] simplify

---
 src/ir_passes/await.ml | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index c906dce75ac..9f4eb6b653d 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -350,8 +350,7 @@ and c_exp' context exp k =
       | Cont k -> Cont (pre k)
       | Label -> assert false in
     (* All control-flow out must pass through the potential `finally` thunk *)
-    let context = LabelEnv.mapi (function | Return | Named _ | Cleanup
-                                          | Throw -> pre') context in
+    let context = LabelEnv.mapi (fun _ -> pre') context in
     (* assert that a surrounding `AwaitPrim _` has set up a `Cleanup` cont *)
     if finally_opt <> None
     then ignore (LabelEnv.find Cleanup context);

From cdb70e3abf8497adf0de3fc14274e2de2c9df1e8 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 13:17:24 +0200
Subject: [PATCH 155/179] rearchitect the interpreter

---
 src/mo_interpreter/interpret.ml          | 16 +++++++---------
 test/run-drun/ok/try-finally.diff-ir.ok  |  8 +++++---
 test/run-drun/ok/try-finally.diff-low.ok | 11 -----------
 test/run-drun/ok/try-finally.run.ok      |  2 ++
 4 files changed, 14 insertions(+), 23 deletions(-)

diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index 9bbf34958ba..ba2225292d4 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -625,15 +625,13 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     let env' = { env with throws = Some k' } in
     interpret_exp env' exp1 k
   | TryE (exp1, cases, Some exp2) ->
-    let k' v1 =
-      let cleanup v2 = interpret_exp env exp2 (fun _ -> k v2) in
-      interpret_catches env cases exp.at v1 cleanup in
-    let out ret v = interpret_exp env exp2 (fun _ -> ret v) in
-    let k'' v2 = interpret_exp env exp2 (fun _ -> k v2) in
-    let env' = { env with throws = Some k'
-                        ; rets = Option.map out env.rets
-                        ; labs = V.Env.map out env.labs } in
-    interpret_exp env' exp1 k''
+    let pre k v = interpret_exp env exp2 (fun _ -> k v) in
+    let k = pre k in
+    let env = { env with rets = Option.map pre env.rets
+                       ; labs = V.Env.map pre env.labs } in
+    let k' v1 = interpret_catches env cases exp.at v1 k in
+    let env' = { env with throws = Some k' } in
+    interpret_exp env' exp1 k
   | WhileE (exp1, exp2) ->
     let k_continue = fun v -> V.as_unit v; interpret_exp env exp k in
     interpret_exp env exp1 (fun v1 ->
diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
index d3d3328867e..1a2fea2744b 100644
--- a/test/run-drun/ok/try-finally.diff-ir.ok
+++ b/test/run-drun/ok/try-finally.diff-ir.ok
@@ -6,7 +6,7 @@
  INl
  OUTl
  INe
-@@ -9,11 +8,9 @@
+@@ -9,25 +8,19 @@
  IN1tInner
  CAUGHT1tInner
  CAUGHT1t
@@ -17,8 +17,10 @@
 -OUT2
  IN2r
  CAUGHT2r
+-OUT2r
  IN2b
-@@ -21,11 +18,9 @@
+ CAUGHT2b
+-OUT2b
  AFTER2b
  IN2i
  CAUGHT2i
@@ -30,7 +32,7 @@
  BEFORE5
  IN5
  OUT5
-@@ -39,11 +34,8 @@
+@@ -41,11 +34,8 @@
  AFTER6
  IN8
  CAUGHT8
diff --git a/test/run-drun/ok/try-finally.diff-low.ok b/test/run-drun/ok/try-finally.diff-low.ok
index b0216806109..e180ba26d49 100644
--- a/test/run-drun/ok/try-finally.diff-low.ok
+++ b/test/run-drun/ok/try-finally.diff-low.ok
@@ -8,14 +8,3 @@
  CAUGHT1t
  OUT1t
  AFTER1t
-@@ -16,8 +17,10 @@
- OUT2
- IN2r
- CAUGHT2r
-+OUT2r
- IN2b
- CAUGHT2b
-+OUT2b
- AFTER2b
- IN2i
- CAUGHT2i
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index 4297073adf1..b43ba679b0f 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -16,8 +16,10 @@ CAUGHT2
 OUT2
 IN2r
 CAUGHT2r
+OUT2r
 IN2b
 CAUGHT2b
+OUT2b
 AFTER2b
 IN2i
 CAUGHT2i

From aa63c742dfc3f42c208faa28b90e5ed036e6e15b Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 13:29:21 +0200
Subject: [PATCH 156/179] correctly endow the inner environment with the
 precomposed `throws`

this fixes the discrepancy to the lowered interpretation
---
 src/mo_interpreter/interpret.ml          |  5 +++--
 test/run-drun/ok/try-finally.diff-ir.ok  |  6 ++++--
 test/run-drun/ok/try-finally.diff-low.ok | 10 ----------
 test/run-drun/ok/try-finally.run.ok      |  1 +
 4 files changed, 8 insertions(+), 14 deletions(-)
 delete mode 100644 test/run-drun/ok/try-finally.diff-low.ok

diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index ba2225292d4..f1993e13e83 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -621,14 +621,15 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
       interpret_cases env cases exp.at v1 k
       )
   | TryE (exp1, cases, None) ->
-    let k' = fun v1 -> interpret_catches env cases exp.at v1 k in
+    let k' v1 = interpret_catches env cases exp.at v1 k in
     let env' = { env with throws = Some k' } in
     interpret_exp env' exp1 k
   | TryE (exp1, cases, Some exp2) ->
     let pre k v = interpret_exp env exp2 (fun _ -> k v) in
     let k = pre k in
     let env = { env with rets = Option.map pre env.rets
-                       ; labs = V.Env.map pre env.labs } in
+                       ; labs = V.Env.map pre env.labs
+                       ; throws = Option.map pre env.throws } in
     let k' v1 = interpret_catches env cases exp.at v1 k in
     let env' = { env with throws = Some k' } in
     interpret_exp env' exp1 k
diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
index 1a2fea2744b..278a820b443 100644
--- a/test/run-drun/ok/try-finally.diff-ir.ok
+++ b/test/run-drun/ok/try-finally.diff-ir.ok
@@ -6,9 +6,11 @@
  INl
  OUTl
  INe
-@@ -9,25 +8,19 @@
+@@ -8,27 +7,20 @@
+ IN1t
  IN1tInner
  CAUGHT1tInner
+-OUT1tInner
  CAUGHT1t
 -OUT1t
  AFTER1t
@@ -32,7 +34,7 @@
  BEFORE5
  IN5
  OUT5
-@@ -41,11 +34,8 @@
+@@ -42,11 +34,8 @@
  AFTER6
  IN8
  CAUGHT8
diff --git a/test/run-drun/ok/try-finally.diff-low.ok b/test/run-drun/ok/try-finally.diff-low.ok
deleted file mode 100644
index e180ba26d49..00000000000
--- a/test/run-drun/ok/try-finally.diff-low.ok
+++ /dev/null
@@ -1,10 +0,0 @@
---- try-finally.run
-+++ try-finally.run-low
-@@ -8,6 +8,7 @@
- IN1t
- IN1tInner
- CAUGHT1tInner
-+OUT1tInner
- CAUGHT1t
- OUT1t
- AFTER1t
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index b43ba679b0f..1dc75244df7 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -8,6 +8,7 @@ BEFORE1t
 IN1t
 IN1tInner
 CAUGHT1tInner
+OUT1tInner
 CAUGHT1t
 OUT1t
 AFTER1t

From e9091eb863996237877394ed83ab28f3fff1f4c2 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 13:41:03 +0200
Subject: [PATCH 157/179] prepare for fusing

---
 src/mo_interpreter/interpret.ml | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index f1993e13e83..fb10f5162ab 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -622,17 +622,18 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
       )
   | TryE (exp1, cases, None) ->
     let k' v1 = interpret_catches env cases exp.at v1 k in
-    let env' = { env with throws = Some k' } in
-    interpret_exp env' exp1 k
-  | TryE (exp1, cases, Some exp2) ->
-    let pre k v = interpret_exp env exp2 (fun _ -> k v) in
-    let k = pre k in
-    let env = { env with rets = Option.map pre env.rets
-                       ; labs = V.Env.map pre env.labs
-                       ; throws = Option.map pre env.throws } in
+    interpret_exp { env with throws = Some k' } exp1 k
+  | TryE (exp1, cases, exp2_opt) ->
+     let k, env = match exp2_opt with
+       | None -> k, env
+       | Some exp2 ->
+          let pre k v = interpret_exp env exp2 (fun _ -> k v) in
+          pre k,
+          { env with rets = Option.map pre env.rets
+                   ; labs = V.Env.map pre env.labs
+                   ; throws = Option.map pre env.throws } in
     let k' v1 = interpret_catches env cases exp.at v1 k in
-    let env' = { env with throws = Some k' } in
-    interpret_exp env' exp1 k
+    interpret_exp { env with throws = Some k' } exp1 k
   | WhileE (exp1, exp2) ->
     let k_continue = fun v -> V.as_unit v; interpret_exp env exp k in
     interpret_exp env exp1 (fun v1 ->

From ecbd0d9f51f31fe2dc63ad71ce5c80d89de86588 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 13:42:54 +0200
Subject: [PATCH 158/179] deduplicate

---
 src/mo_interpreter/interpret.ml | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index fb10f5162ab..df58b7b8cff 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -620,9 +620,6 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     interpret_exp env exp1 (fun v1 ->
       interpret_cases env cases exp.at v1 k
       )
-  | TryE (exp1, cases, None) ->
-    let k' v1 = interpret_catches env cases exp.at v1 k in
-    interpret_exp { env with throws = Some k' } exp1 k
   | TryE (exp1, cases, exp2_opt) ->
      let k, env = match exp2_opt with
        | None -> k, env

From e65574b0cc8501ea13fc9580640ae1d572c30b7c Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 13:46:46 +0200
Subject: [PATCH 159/179] indent

---
 src/mo_interpreter/interpret.ml | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index df58b7b8cff..fb770ca0478 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -621,14 +621,14 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
       interpret_cases env cases exp.at v1 k
       )
   | TryE (exp1, cases, exp2_opt) ->
-     let k, env = match exp2_opt with
-       | None -> k, env
-       | Some exp2 ->
-          let pre k v = interpret_exp env exp2 (fun _ -> k v) in
-          pre k,
-          { env with rets = Option.map pre env.rets
-                   ; labs = V.Env.map pre env.labs
-                   ; throws = Option.map pre env.throws } in
+    let k, env = match exp2_opt with
+      | None -> k, env
+      | Some exp2 ->
+        let pre k v = interpret_exp env exp2 (fun _ -> k v) in
+        pre k,
+        { env with rets = Option.map pre env.rets
+                 ; labs = V.Env.map pre env.labs
+                 ; throws = Option.map pre env.throws } in
     let k' v1 = interpret_catches env cases exp.at v1 k in
     interpret_exp { env with throws = Some k' } exp1 k
   | WhileE (exp1, exp2) ->

From ff5227b0a0da93d09324e400a2fb436159acd95a Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 13:52:11 +0200
Subject: [PATCH 160/179] model the IR-interpreter after the AST one

---
 src/ir_interpreter/interpret_ir.ml      | 26 +++++++-------
 test/run-drun/ok/try-finally.diff-ir.ok | 48 -------------------------
 test/run-drun/ok/try-finally.run-ir.ok  | 11 ++++++
 3 files changed, 25 insertions(+), 60 deletions(-)
 delete mode 100644 test/run-drun/ok/try-finally.diff-ir.ok

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index fc062f2cc80..e651c7fbbe4 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -493,19 +493,21 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
       interpret_cases env cases exp.at v1 k
     )
   | TryE (exp1, cases, None) ->
-    let k' = fun v1 -> interpret_catches env cases exp.at v1 k in
-    let env' = { env with throws = Some k' } in
-    interpret_exp env' exp1 k
-  | TryE (exp1, cases, Some (id, ty)) ->
+    let k' v1 = interpret_catches env cases exp.at v1 k in
+    interpret_exp { env with throws = Some k' } exp1 k
+  | TryE (exp1, cases, finally_opt) ->
     assert env.flavor.has_await;
-    let exp2 = Construct.(varE (var id ty) -*- unitE ()) in
-    let k' v1 =
-      interpret_catches env cases exp.at v1 k in
-    let out ret v = interpret_exp env exp2 (fun u -> V.as_unit u; ret v) in
-    let env' = { env with throws = Some k'
-                        ; rets = Option.map out env.rets
-                        ; labs = V.Env.map out env.labs } in
-    interpret_exp env' exp1 k
+    let k, env = match finally_opt with
+      | None -> k, env
+      | Some (id, ty) ->
+        let exp2 = Construct.(varE (var id ty) -*- unitE ()) in
+        let pre k v = interpret_exp env exp2 (fun _ -> k v) in
+        pre k,
+        { env with rets = Option.map pre env.rets
+                 ; labs = V.Env.map pre env.labs
+                 ; throws = Option.map pre env.throws } in
+    let k' v1 = interpret_catches env cases exp.at v1 k in
+    interpret_exp { env with throws = Some k' } exp1 k
   | LoopE exp1 ->
     interpret_exp env exp1 (fun v -> V.as_unit v; interpret_exp env exp k)
   | LabelE (id, _typ, exp1) ->
diff --git a/test/run-drun/ok/try-finally.diff-ir.ok b/test/run-drun/ok/try-finally.diff-ir.ok
deleted file mode 100644
index 278a820b443..00000000000
--- a/test/run-drun/ok/try-finally.diff-ir.ok
+++ /dev/null
@@ -1,48 +0,0 @@
---- try-finally.run
-+++ try-finally.run-ir
-@@ -1,5 +1,4 @@
- INt
--OUTt
- INl
- OUTl
- INe
-@@ -8,27 +7,20 @@
- IN1t
- IN1tInner
- CAUGHT1tInner
--OUT1tInner
- CAUGHT1t
--OUT1t
- AFTER1t
- IN2
- CAUGHT2
--OUT2
- IN2r
- CAUGHT2r
--OUT2r
- IN2b
- CAUGHT2b
--OUT2b
- AFTER2b
- IN2i
- CAUGHT2i
--OUT2i
- IN3
- OUT3
- IN4
--OUT4
- BEFORE5
- IN5
- OUT5
-@@ -42,11 +34,8 @@
- AFTER6
- IN8
- CAUGHT8
--OUT8
- IN8i
- CAUGHT8i
--OUT8i
- IN9
--OUT9
- IN
- try-finally.mo:11.43-11.55: execution error, assertion failure
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index 5ab1c33d17e..1dc75244df7 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -1,4 +1,5 @@
 INt
+OUTt
 INl
 OUTl
 INe
@@ -7,20 +8,27 @@ BEFORE1t
 IN1t
 IN1tInner
 CAUGHT1tInner
+OUT1tInner
 CAUGHT1t
+OUT1t
 AFTER1t
 IN2
 CAUGHT2
+OUT2
 IN2r
 CAUGHT2r
+OUT2r
 IN2b
 CAUGHT2b
+OUT2b
 AFTER2b
 IN2i
 CAUGHT2i
+OUT2i
 IN3
 OUT3
 IN4
+OUT4
 BEFORE5
 IN5
 OUT5
@@ -34,8 +42,11 @@ OUT6
 AFTER6
 IN8
 CAUGHT8
+OUT8
 IN8i
 CAUGHT8i
+OUT8i
 IN9
+OUT9
 IN
 try-finally.mo:11.43-11.55: execution error, assertion failure

From 0f261acf3ee8ade406da455ee4aed0bf25df79b5 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 13:58:22 +0200
Subject: [PATCH 161/179] fuse the cases

---
 src/ir_interpreter/interpret_ir.ml | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index e651c7fbbe4..72128c3620b 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -492,9 +492,6 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     interpret_exp env exp1 (fun v1 ->
       interpret_cases env cases exp.at v1 k
     )
-  | TryE (exp1, cases, None) ->
-    let k' v1 = interpret_catches env cases exp.at v1 k in
-    interpret_exp { env with throws = Some k' } exp1 k
   | TryE (exp1, cases, finally_opt) ->
     assert env.flavor.has_await;
     let k, env = match finally_opt with

From f511bb0286f6d19e7caeddd015752f0e3204c61b Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 4 Jul 2024 14:35:32 +0200
Subject: [PATCH 162/179] simplify

---
 src/ir_passes/await.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 9f4eb6b653d..2074db13226 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -350,7 +350,7 @@ and c_exp' context exp k =
       | Cont k -> Cont (pre k)
       | Label -> assert false in
     (* All control-flow out must pass through the potential `finally` thunk *)
-    let context = LabelEnv.mapi (fun _ -> pre') context in
+    let context = LabelEnv.map pre' context in
     (* assert that a surrounding `AwaitPrim _` has set up a `Cleanup` cont *)
     if finally_opt <> None
     then ignore (LabelEnv.find Cleanup context);

From 84aa3e2ad2b413ca44446d5fc9299689f4ab8d17 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 9 Jul 2024 12:32:32 +0200
Subject: [PATCH 163/179] Allow `try` without `catch` (#4600)

* WIP: frontend

* accept

* activate the remaining testcase

* shortcut the construction of a dedicated `throw` context

when there is only a default (catch-all) that would rethrow
anyway

* Update lib.ml

* undo the `Option`-y thing

it is not helpful:
- longer
- we may have several `catch`-es in the future
- inconsistent with IR (which is still a `list`)
- no advantages
---
 src/ir_passes/await.ml                   |  2 +
 src/lib/lib.ml                           |  6 +-
 src/lib/lib.mli                          |  1 +
 src/mo_frontend/parser.mly               |  2 +-
 test/run-drun/ok/try-finally.drun-run.ok | 11 +++-
 test/run-drun/ok/try-finally.run-ir.ok   |  7 +++
 test/run-drun/ok/try-finally.run-low.ok  |  7 +++
 test/run-drun/ok/try-finally.run.ok      |  7 +++
 test/run-drun/ok/try-finally.tc.ok       | 80 ------------------------
 test/run-drun/try-finally.mo             | 16 ++---
 10 files changed, 48 insertions(+), 91 deletions(-)
 delete mode 100644 test/run-drun/ok/try-finally.tc.ok

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 2074db13226..26abe9d0c5c 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -361,6 +361,8 @@ and c_exp' context exp k =
     match eff exp1 with
     | T.Triv ->
       varE k -*- t_exp context exp1
+    | T.Await when cases = [] ->
+      c_exp context exp1 (ContVar k)
     | T.Await ->
       let error = fresh_var "v" T.catch in
       let cases' =
diff --git a/src/lib/lib.ml b/src/lib/lib.ml
index ee6c5b0c2f3..6b0cd938ad9 100644
--- a/src/lib/lib.ml
+++ b/src/lib/lib.ml
@@ -1,3 +1,5 @@
+module StdList = List
+
 module Format =
 struct
   let with_str_formatter f x =
@@ -504,7 +506,9 @@ module Option =
 struct
   let get o x = Option.value o ~default:x
 
-  let map2 (f : 'a -> 'b -> 'c) (a : 'a option) (b : 'b option) =
+  let exists f o = Option.to_list o |> StdList.exists f
+
+  let map2 f a b =
     match a, b with
     | Some a, Some b -> Some (f a b)
     | _ -> None
diff --git a/src/lib/lib.mli b/src/lib/lib.mli
index 778cf2acdab..795e35f1054 100644
--- a/src/lib/lib.mli
+++ b/src/lib/lib.mli
@@ -96,6 +96,7 @@ sig
     val (and+) : 'a option -> 'b option -> ('a * 'b) option
   end
   val get : 'a option -> 'a -> 'a
+  val exists : ('a -> bool) -> 'a option -> bool
   val map2 : ('a -> 'b -> 'c) -> 'a option -> 'b option -> 'c option
 end
 
diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly
index b68836d5660..ebb331fd0cb 100644
--- a/src/mo_frontend/parser.mly
+++ b/src/mo_frontend/parser.mly
@@ -711,7 +711,7 @@ exp_un(B) :
     { TryE(e1, [c], None) @? at $sloc }
   | TRY e1=exp_nest c=catch FINALLY e2=exp_nest
     { TryE(e1, [c], Some e2) @? at $sloc }
-  | TRY e1=exp_nest FINALLY e2=exp_nest (* FIXME: needs a different keyword (`DO`?), provisional *)
+  | TRY e1=exp_nest FINALLY e2=exp_nest
     { TryE(e1, [], Some e2) @? at $sloc }
 (* TODO: enable multi-branch TRY (already supported by compiler)
   | TRY e=exp_nest LCURLY cs=seplist(case, semicolon) RCURLY
diff --git a/test/run-drun/ok/try-finally.drun-run.ok b/test/run-drun/ok/try-finally.drun-run.ok
index 8ca1ac135f1..5f66f6a9ef0 100644
--- a/test/run-drun/ok/try-finally.drun-run.ok
+++ b/test/run-drun/ok/try-finally.drun-run.ok
@@ -6,6 +6,13 @@ debug.print: INl
 debug.print: OUTl
 debug.print: INe
 debug.print: OUTe
+debug.print: BEFORE1
+debug.print: IN1
+debug.print: IN1Inner
+debug.print: OUT1Inner
+debug.print: CAUGHT1
+debug.print: OUT1
+debug.print: AFTER1
 debug.print: BEFORE1t
 debug.print: IN1t
 debug.print: IN1tInner
@@ -91,7 +98,7 @@ debug.print: InnerLIVESTILL7
 debug.print: InnerOUT7
 debug.print: OUT7
 debug.print: It's over
-ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:236.17-236.29
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:238.17-238.29
 debug.print: go2
 debug.print: It's so over
-ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:323.13-323.25
+ingress Err: IC0503: Canister rwlgt-iiaaa-aaaaa-aaaaa-cai trapped explicitly: assertion failed at try-finally.mo:325.13-325.25
diff --git a/test/run-drun/ok/try-finally.run-ir.ok b/test/run-drun/ok/try-finally.run-ir.ok
index 1dc75244df7..6cc91503b35 100644
--- a/test/run-drun/ok/try-finally.run-ir.ok
+++ b/test/run-drun/ok/try-finally.run-ir.ok
@@ -4,6 +4,13 @@ INl
 OUTl
 INe
 OUTe
+BEFORE1
+IN1
+IN1Inner
+OUT1Inner
+CAUGHT1
+OUT1
+AFTER1
 BEFORE1t
 IN1t
 IN1tInner
diff --git a/test/run-drun/ok/try-finally.run-low.ok b/test/run-drun/ok/try-finally.run-low.ok
index 1dc75244df7..6cc91503b35 100644
--- a/test/run-drun/ok/try-finally.run-low.ok
+++ b/test/run-drun/ok/try-finally.run-low.ok
@@ -4,6 +4,13 @@ INl
 OUTl
 INe
 OUTe
+BEFORE1
+IN1
+IN1Inner
+OUT1Inner
+CAUGHT1
+OUT1
+AFTER1
 BEFORE1t
 IN1t
 IN1tInner
diff --git a/test/run-drun/ok/try-finally.run.ok b/test/run-drun/ok/try-finally.run.ok
index 1dc75244df7..6cc91503b35 100644
--- a/test/run-drun/ok/try-finally.run.ok
+++ b/test/run-drun/ok/try-finally.run.ok
@@ -4,6 +4,13 @@ INl
 OUTl
 INe
 OUTe
+BEFORE1
+IN1
+IN1Inner
+OUT1Inner
+CAUGHT1
+OUT1
+AFTER1
 BEFORE1t
 IN1t
 IN1tInner
diff --git a/test/run-drun/ok/try-finally.tc.ok b/test/run-drun/ok/try-finally.tc.ok
deleted file mode 100644
index 47a900bf832..00000000000
--- a/test/run-drun/ok/try-finally.tc.ok
+++ /dev/null
@@ -1,80 +0,0 @@
-try-finally.mo:11.9-12.37: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:16.9-17.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:21.19-22.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:26.19-27.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:32.9-33.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:37.9-38.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:120.9-125.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:130.9-134.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:140.19-146.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:154.13-160.49: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:152.19-163.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:171.13-177.50: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:169.19-180.39: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:186.19-200.39: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:208.13-217.50: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:206.19-220.39: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:229.13-238.49: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:227.19-241.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:271.9-275.39: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
-try-finally.mo:279.9-283.38: warning [M0145], this try handler of type
-  Error
-does not cover value
-  _
diff --git a/test/run-drun/try-finally.mo b/test/run-drun/try-finally.mo
index 3b2a0b38649..d8c5ea5d09a 100644
--- a/test/run-drun/try-finally.mo
+++ b/test/run-drun/try-finally.mo
@@ -38,18 +38,20 @@ actor A {
         finally { debugPrint "OUTd" };
     };
 
-/*  nested `try` won't work yet
     func t1() : async () {
+        debugPrint "BEFORE1";
         try {
-            do {
-                debugPrint "IN1";
-                throw error "IN1";
+            debugPrint "IN1";
+            try {
+                debugPrint "IN1Inner";
+                throw error "IN1Inner";
             }
-            finally { debugPrint "OUT1" };
+            finally { debugPrint "OUT1Inner" };
         }
         catch _ { debugPrint "CAUGHT1" }
+        finally { debugPrint "OUT1" };
+        debugPrint "AFTER1"
     };
-*/
 
     func t1t() : async () {
         debugPrint "BEFORE1t";
@@ -288,7 +290,7 @@ actor A {
         await t0t();
         await t0l();
         await t0e();
-        //await t1();
+        await t1();
         await t1t();
         await t2();
         await t2r();

From 59a14d9fea6287cba74a6dd489d0328aa822568b Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 9 Jul 2024 13:22:35 +0200
Subject: [PATCH 164/179] document `finally`

---
 doc/md/reference/language-manual.md | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/doc/md/reference/language-manual.md b/doc/md/reference/language-manual.md
index 02ad8d3f0d2..a67e773bc09 100644
--- a/doc/md/reference/language-manual.md
+++ b/doc/md/reference/language-manual.md
@@ -91,7 +91,7 @@ The following keywords are reserved and may not be used as identifiers:
 ``` bnf
 
 actor and assert async async* await await* break case catch class
-composite continue debug debug_show do else flexible false for
+composite continue debug debug_show do else false flexible finally for
 from_candid func if ignore import in module not null object or label
 let loop private public query return shared stable switch system throw
 to_candid true try type var while with
@@ -514,6 +514,9 @@ The syntax of an expression is as follows:
   await* <block-or-exp>                          Await a delayed computation (only in async)
   throw <exp>                                    Raise an error (only in async)
   try <block-or-exp> catch <pat> <block-or-exp>  Catch an error (only in async)
+  try <block-or-exp> finally <block-or-exp>      Guard with cleanup
+  try <block-or-exp> catch <pat> <block-or-exp> finally <block-or-exp>
+                                                 Catch an error (only in async) and cleanup
   assert <block-or-exp>                          Assertion
   <exp> : <typ>                                  Type annotation
   <dec>                                          Declaration
@@ -2547,6 +2550,10 @@ Because the [`Error`](../base/Error.md) type is opaque, the pattern match cannot
 
 :::
 
+The `try` expression can be endowed with a cleanup clause (and optionally omitting the `catch`) to facilitate structured rollback of temporary state changes (e.g. locks).
+
+This form is `try <block-or-exp1> (catch <pat> <block-or-exp2>)? finally <block-or-exp3>`, and evaluation proceeds as above with the crucial addition that every control-flow path leaving `<block-or-exp1>` or `<block-or-exp2>` will execute the unit-valued `<block-or-exp3>` before the entire `try` expression obtains its value. The cleanup expression will additionaly also be executed when the processing after an intervening `await` (directly, or indirectly as `await*`) traps.
+
 See [Error type](#error-type).
 
 ### Assert

From 0fabab40345390fdd0dfd06835a9da468eaeff6d Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 9 Jul 2024 13:30:45 +0200
Subject: [PATCH 165/179] fix: this was missed when merging #4600

---
 src/mo_frontend/typing.ml | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml
index 0061cb58d1c..4bcae87c26a 100644
--- a/src/mo_frontend/typing.ml
+++ b/src/mo_frontend/typing.ml
@@ -1538,7 +1538,7 @@ and infer_exp'' env exp : T.typ =
     if not env.pre then begin
       Option.iter (check_exp_strong { env with rets = None; labs = T.Env.empty } T.unit) exp2_opt;
       check_ErrorCap env "try" exp.at;
-      coverage_cases "try handler" env cases T.catch exp.at
+      if cases <> [] then coverage_cases "try handler" env cases T.catch exp.at
     end;
     T.lub t1 t2
   | WhileE (exp1, exp2) ->
@@ -1839,7 +1839,8 @@ and check_exp' env0 t exp : T.typ =
     check_ErrorCap env "try" exp.at;
     check_exp env t exp1;
     check_cases env T.catch t cases;
-    coverage_cases "try handler" env cases T.catch exp.at;
+    if cases <> []
+    then coverage_cases "try handler" env cases T.catch exp.at;
     if not env.pre then
       begin match exp2_opt with
       | None -> ()

From 2329069a15f80c61b3d38c1e58fd89341ab88e34 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 9 Jul 2024 13:54:13 +0200
Subject: [PATCH 166/179] optimisation: don't rethrow if there is an
 irrefutable `catch` pattern

---
 src/ir_passes/await.ml | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/ir_passes/await.ml b/src/ir_passes/await.ml
index 26abe9d0c5c..ba6e3d132a3 100644
--- a/src/ir_passes/await.ml
+++ b/src/ir_passes/await.ml
@@ -365,6 +365,11 @@ and c_exp' context exp k =
       c_exp context exp1 (ContVar k)
     | T.Await ->
       let error = fresh_var "v" T.catch in
+      let rethrow = { it = { pat = varP error; exp = varE f -*- varE error };
+                      at = no_region;
+                      note = ()
+                    } in
+      let omit_rethrow = List.exists (fun {it = {pat; exp}; _} -> Ir_utils.is_irrefutable pat) cases in
       let cases' =
         List.map
           (fun {it = { pat; exp }; at; note} ->
@@ -374,10 +379,7 @@ and c_exp' context exp k =
             in
             { it = { pat; exp = exp' }; at; note })
           cases
-        @ [{ it = { pat = varP error; exp = varE f -*- varE error };
-             at = no_region;
-             note = ()
-        }] in
+        @ if omit_rethrow then [] else [rethrow] in
       let throw = fresh_err_cont (answerT (typ_of_var k)) in
       let context' = LabelEnv.add Throw (Cont (ContVar throw)) context in
       blockE

From b0998cbd200c0692a8bd28cebd163dc5d88433d7 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 9 Jul 2024 15:32:51 +0200
Subject: [PATCH 167/179] undo

---
 src/ir_def/check_ir.ml | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 99ad6fc9f5a..13f649a8fdf 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -365,13 +365,13 @@ let rec check_exp env (exp:Ir.exp) : unit =
   (* helpers *)
   let check p = check env exp.at p in
   let (<:) t1 t2 =
-  try
+(*  try *)
       check_sub env exp.at t1 t2
-  with e ->
+(*  with e ->
      (Printf.eprintf "(in here):\n%s"
         (Wasm.Sexpr.to_string 80 (Arrange_ir.exp exp));
       raise e)
-
+*)
   in
   (* check for aliasing *)
   if exp.note.Note.check_run = env.check_run
@@ -409,7 +409,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
             check_concrete env exp.at t_ret;
           end;
           typ exp2 <: t_arg;
-          t_ret <: t;
+          t_ret <: t
         | T.Non -> () (* dead code, not much to check here *)
         | t1 -> error env exp1.at "expected function type, but expression produces type\n  %s"
              (T.string_of_typ_expand t1)

From 47bf1d1071ba3b7e7970b2cad0b2896153a9bab0 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 9 Jul 2024 15:36:19 +0200
Subject: [PATCH 168/179] tweak

---
 src/ir_def/check_ir.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 13f649a8fdf..11ecd5d4ad0 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -560,7 +560,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
            (match ts2 with
             | [] -> ()
             | _ -> error env exp.at "CPSAwait answer type error");
-           typ krc <: T.Tup T.[cont_typ; Construct.err_contT (Tup ts2); Construct.bail_contT];
+           typ krc <: T.(Tup Construct.[cont_typ; err_contT (Tup ts2); bail_contT]);
            t1 <: T.seq ts1;
            T.seq ts2 <: t;
          end;

From 51bb8a1933bbf2c509447032f1ba26b8f91fa4e0 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Tue, 9 Jul 2024 15:43:20 +0200
Subject: [PATCH 169/179] remove fuzz

---
 src/ir_passes/async.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
index 2fde258618c..7a4ebf3e82c 100644
--- a/src/ir_passes/async.ml
+++ b/src/ir_passes/async.ml
@@ -341,7 +341,7 @@ let transform prog =
          )
          (varE nary_async))
         .it
-    | PrimE (OtherPrim "call_raw", [exp1; exp2; exp3]) ->(* HERE *)
+    | PrimE (OtherPrim "call_raw", [exp1; exp2; exp3]) ->
       let exp1' = t_exp exp1 in
       let exp2' = t_exp exp2 in
       let exp3' = t_exp exp3 in

From 007fc756ce2ba1eb52127fe7070043a9477a8505 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 18 Jul 2024 13:23:35 +0200
Subject: [PATCH 170/179] Update src/ir_def/check_ir.ml

---
 src/ir_def/check_ir.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
index 11ecd5d4ad0..fce03d10903 100644
--- a/src/ir_def/check_ir.ml
+++ b/src/ir_def/check_ir.ml
@@ -560,7 +560,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
            (match ts2 with
             | [] -> ()
             | _ -> error env exp.at "CPSAwait answer type error");
-           typ krc <: T.(Tup Construct.[cont_typ; err_contT (Tup ts2); bail_contT]);
+           typ krc <: T.(Tup Construct.[cont_typ; err_contT (seq ts2); bail_contT]);
            t1 <: T.seq ts1;
            T.seq ts2 <: t;
          end;

From 70ba3c23b506768a46e2dd2a20799fc8d8b14d85 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 18 Jul 2024 14:21:00 +0200
Subject: [PATCH 171/179] post-merge fixup

---
 src/viper/traversals.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/viper/traversals.ml b/src/viper/traversals.ml
index a21c99178a1..c5cf7933ea4 100644
--- a/src/viper/traversals.ml
+++ b/src/viper/traversals.ml
@@ -51,7 +51,7 @@ let rec over_exp (v : visitor) (exp : exp) : exp =
   | ObjBlockE (x, t, dfs) -> { exp with it = ObjBlockE (x, Option.map (over_typ v) t, List.map (over_dec_field v) dfs) }
   | ObjE (bases, efs) -> { exp with it = ObjE (List.map (over_exp v) bases, List.map (over_exp_field v) efs) }
   | IfE (exp1, exp2, exp3) -> { exp with it = IfE(over_exp v exp1, over_exp v exp2, over_exp v exp3) }
-  | TryE (exp1, cases) -> { exp with it = TryE (over_exp v exp1, List.map (over_case v) cases) }
+  | TryE (exp1, cases, exp2) -> { exp with it = TryE (over_exp v exp1, List.map (over_case v) cases, Option.map (over_exp v) exp2) }
   | SwitchE (exp1, cases) -> { exp with it = SwitchE (over_exp v exp1, List.map (over_case v) cases) }
   | FuncE (name, sort_pat, typ_binds, pat, typ_opt, sugar, exp1) -> { exp with it = FuncE (name, sort_pat, typ_binds, over_pat v pat, Option.map (over_typ v) typ_opt, sugar, over_exp v exp1) }
   | IgnoreE exp1 -> { exp with it = IgnoreE (over_exp v exp1)})

From 5340312895e844a71a99a5c8ee3dbe45e51d6440 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 18 Jul 2024 14:25:33 +0200
Subject: [PATCH 172/179] Update src/mo_interpreter/interpret.ml

Co-authored-by: Claudio Russo <claudio@dfinity.org>
---
 src/mo_interpreter/interpret.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/mo_interpreter/interpret.ml b/src/mo_interpreter/interpret.ml
index fb770ca0478..cd02a23b882 100644
--- a/src/mo_interpreter/interpret.ml
+++ b/src/mo_interpreter/interpret.ml
@@ -624,7 +624,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     let k, env = match exp2_opt with
       | None -> k, env
       | Some exp2 ->
-        let pre k v = interpret_exp env exp2 (fun _ -> k v) in
+        let pre k v = interpret_exp env exp2 (fun v2 -> V.as_unit v2; k v) in
         pre k,
         { env with rets = Option.map pre env.rets
                  ; labs = V.Env.map pre env.labs

From 9c8bcb965dd30cbbde7f01c13e8a62a832b8a615 Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 18 Jul 2024 14:28:45 +0200
Subject: [PATCH 173/179] Update src/ir_interpreter/interpret_ir.ml

---
 src/ir_interpreter/interpret_ir.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/ir_interpreter/interpret_ir.ml b/src/ir_interpreter/interpret_ir.ml
index 0247d674635..eded76e3736 100644
--- a/src/ir_interpreter/interpret_ir.ml
+++ b/src/ir_interpreter/interpret_ir.ml
@@ -498,7 +498,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
       | None -> k, env
       | Some (id, ty) ->
         let exp2 = Construct.(varE (var id ty) -*- unitE ()) in
-        let pre k v = interpret_exp env exp2 (fun _ -> k v) in
+        let pre k v = interpret_exp env exp2 (fun v2 -> V.as_unit v2; k v) in
         pre k,
         { env with rets = Option.map pre env.rets
                  ; labs = V.Env.map pre env.labs

From d848aa6a73110fa00aa05a5ea6b83777364ce55e Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 18 Jul 2024 15:15:54 +0200
Subject: [PATCH 174/179] Update Changelog.md

Co-authored-by: Claudio Russo <claudio@dfinity.org>
---
 Changelog.md | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/Changelog.md b/Changelog.md
index 35687807806..5f19ac6ebfc 100644
--- a/Changelog.md
+++ b/Changelog.md
@@ -11,10 +11,10 @@
     presence of control-flow expressions (`return`, `break`, `continue`, `throw`).
 
     _Note_: `finally`-expressions that are in scope will be executed even if an execution
-    path _following_ an `await`-expression traps. This behaviour, not available before in Motoko,
-    allows programmers writing last-resort cleanups. For trapping execution paths _without_ an
-    intervening `await`, the replica-provided state rewinding mechanism stays in charge of
-    the cleanup.
+    path _following_ an `await`-expression traps. This feature, not available before in Motoko,
+    allows programmers to implement cleanups even in the presence of traps. For trapping 
+    execution paths prior to any `await`, the replica-provided state roll back mechanism must 
+    ensure no cleanup is required.
 
     The relevant security best practices are accessible at
     https://internetcomputer.org/docs/current/developer-docs/security/security-best-practices/inter-canister-calls#recommendation

From 580642cf9a395a2fe1c4ce6787f3c4394b98f4bd Mon Sep 17 00:00:00 2001
From: Gabor Greif <gabor@dfinity.org>
Date: Thu, 18 Jul 2024 15:16:55 +0200
Subject: [PATCH 175/179] Update doc/md/reference/language-manual.md

Co-authored-by: Claudio Russo <claudio@dfinity.org>
---
 doc/md/reference/language-manual.md | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/doc/md/reference/language-manual.md b/doc/md/reference/language-manual.md
index a67e773bc09..9c0e169edaf 100644
--- a/doc/md/reference/language-manual.md
+++ b/doc/md/reference/language-manual.md
@@ -2550,7 +2550,8 @@ Because the [`Error`](../base/Error.md) type is opaque, the pattern match cannot
 
 :::
 
-The `try` expression can be endowed with a cleanup clause (and optionally omitting the `catch`) to facilitate structured rollback of temporary state changes (e.g. locks).
+The `try` expression can be provided with a `finally` cleanup clause to facilitate structured rollback of temporary state changes (e.g. to release a lock). 
+The preceding `catch` clause may be omitted in the presence of a `finally` clause.
 
 This form is `try <block-or-exp1> (catch <pat> <block-or-exp2>)? finally <block-or-exp3>`, and evaluation proceeds as above with the crucial addition that every control-flow path leaving `<block-or-exp1>` or `<block-or-exp2>` will execute the unit-valued `<block-or-exp3>` before the entire `try` expression obtains its value. The cleanup expression will additionaly also be executed when the processing after an intervening `await` (directly, or indirectly as `await*`) traps.
 

From 156ee7f2615a6842d9cc8f9d89afc27bc18180fe Mon Sep 17 00:00:00 2001
From: Claudio Russo <claudio@dfinity.org>
Date: Thu, 18 Jul 2024 17:14:22 +0100
Subject: [PATCH 176/179] bug in checking of try catch finally that sends in
 finally

---
 test/run-drun/ok/try-finally-more.comp-ref.ok |  6 +++++
 .../ok/try-finally-more.comp-ref.ret.ok       |  1 +
 test/run-drun/ok/try-finally-more.comp.ok     |  6 +++++
 test/run-drun/ok/try-finally-more.comp.ret.ok |  1 +
 test/run-drun/ok/try-finally-more.diff-low.ok | 12 ++++++++++
 test/run-drun/ok/try-finally-more.run-ir.ok   |  3 +++
 test/run-drun/ok/try-finally-more.run-low.ok  |  6 +++++
 .../ok/try-finally-more.run-low.ret.ok        |  1 +
 test/run-drun/ok/try-finally-more.run.ok      |  3 +++
 test/run-drun/ok/try-finally-more.tc.ok       |  9 ++++++++
 test/run-drun/try-finally-bug.mo              | 22 +++++++++++++++++++
 11 files changed, 70 insertions(+)
 create mode 100644 test/run-drun/ok/try-finally-more.comp-ref.ok
 create mode 100644 test/run-drun/ok/try-finally-more.comp-ref.ret.ok
 create mode 100644 test/run-drun/ok/try-finally-more.comp.ok
 create mode 100644 test/run-drun/ok/try-finally-more.comp.ret.ok
 create mode 100644 test/run-drun/ok/try-finally-more.diff-low.ok
 create mode 100644 test/run-drun/ok/try-finally-more.run-ir.ok
 create mode 100644 test/run-drun/ok/try-finally-more.run-low.ok
 create mode 100644 test/run-drun/ok/try-finally-more.run-low.ret.ok
 create mode 100644 test/run-drun/ok/try-finally-more.run.ok
 create mode 100644 test/run-drun/ok/try-finally-more.tc.ok
 create mode 100644 test/run-drun/try-finally-bug.mo

diff --git a/test/run-drun/ok/try-finally-more.comp-ref.ok b/test/run-drun/ok/try-finally-more.comp-ref.ok
new file mode 100644
index 00000000000..5d81f42f598
--- /dev/null
+++ b/test/run-drun/ok/try-finally-more.comp-ref.ok
@@ -0,0 +1,6 @@
+OOPS! You've triggered a compiler bug.
+Please report this at https://github.com/dfinity/motoko/issues/new with the following details:
+
+Motoko (source 0.11.2-171-g51bb8a193)
+
+Fatal error: exception File "ir_passes/await.ml", line 99, characters 2-8: Assertion failed
diff --git a/test/run-drun/ok/try-finally-more.comp-ref.ret.ok b/test/run-drun/ok/try-finally-more.comp-ref.ret.ok
new file mode 100644
index 00000000000..63e15a4d3fa
--- /dev/null
+++ b/test/run-drun/ok/try-finally-more.comp-ref.ret.ok
@@ -0,0 +1 @@
+Return code 2
diff --git a/test/run-drun/ok/try-finally-more.comp.ok b/test/run-drun/ok/try-finally-more.comp.ok
new file mode 100644
index 00000000000..5d81f42f598
--- /dev/null
+++ b/test/run-drun/ok/try-finally-more.comp.ok
@@ -0,0 +1,6 @@
+OOPS! You've triggered a compiler bug.
+Please report this at https://github.com/dfinity/motoko/issues/new with the following details:
+
+Motoko (source 0.11.2-171-g51bb8a193)
+
+Fatal error: exception File "ir_passes/await.ml", line 99, characters 2-8: Assertion failed
diff --git a/test/run-drun/ok/try-finally-more.comp.ret.ok b/test/run-drun/ok/try-finally-more.comp.ret.ok
new file mode 100644
index 00000000000..63e15a4d3fa
--- /dev/null
+++ b/test/run-drun/ok/try-finally-more.comp.ret.ok
@@ -0,0 +1 @@
+Return code 2
diff --git a/test/run-drun/ok/try-finally-more.diff-low.ok b/test/run-drun/ok/try-finally-more.diff-low.ok
new file mode 100644
index 00000000000..5f1fdaf56c0
--- /dev/null
+++ b/test/run-drun/ok/try-finally-more.diff-low.ok
@@ -0,0 +1,12 @@
+--- try-finally-more.run
++++ try-finally-more.run-low
+@@ -1,3 +1,6 @@
+-try
+-catch
+-OUT
++OOPS! You've triggered a compiler bug.
++Please report this at https://github.com/dfinity/motoko/issues/new with the following details:
++
++Motoko (source 0.11.2-171-g51bb8a193)
++
++Fatal error: exception File "ir_passes/await.ml", line 99, characters 2-8: Assertion failed
diff --git a/test/run-drun/ok/try-finally-more.run-ir.ok b/test/run-drun/ok/try-finally-more.run-ir.ok
new file mode 100644
index 00000000000..e90ef7fd80c
--- /dev/null
+++ b/test/run-drun/ok/try-finally-more.run-ir.ok
@@ -0,0 +1,3 @@
+try
+catch
+OUT
diff --git a/test/run-drun/ok/try-finally-more.run-low.ok b/test/run-drun/ok/try-finally-more.run-low.ok
new file mode 100644
index 00000000000..5d81f42f598
--- /dev/null
+++ b/test/run-drun/ok/try-finally-more.run-low.ok
@@ -0,0 +1,6 @@
+OOPS! You've triggered a compiler bug.
+Please report this at https://github.com/dfinity/motoko/issues/new with the following details:
+
+Motoko (source 0.11.2-171-g51bb8a193)
+
+Fatal error: exception File "ir_passes/await.ml", line 99, characters 2-8: Assertion failed
diff --git a/test/run-drun/ok/try-finally-more.run-low.ret.ok b/test/run-drun/ok/try-finally-more.run-low.ret.ok
new file mode 100644
index 00000000000..63e15a4d3fa
--- /dev/null
+++ b/test/run-drun/ok/try-finally-more.run-low.ret.ok
@@ -0,0 +1 @@
+Return code 2
diff --git a/test/run-drun/ok/try-finally-more.run.ok b/test/run-drun/ok/try-finally-more.run.ok
new file mode 100644
index 00000000000..e90ef7fd80c
--- /dev/null
+++ b/test/run-drun/ok/try-finally-more.run.ok
@@ -0,0 +1,3 @@
+try
+catch
+OUT
diff --git a/test/run-drun/ok/try-finally-more.tc.ok b/test/run-drun/ok/try-finally-more.tc.ok
new file mode 100644
index 00000000000..a939fac2191
--- /dev/null
+++ b/test/run-drun/ok/try-finally-more.tc.ok
@@ -0,0 +1,9 @@
+try-finally-more.mo:7.21-7.28: warning [M0145], this pattern of type
+  (Nat, Nat, Nat)
+does not cover value
+  (1, 2, 0 or 1 or _) or
+  (1, 0 or 1 or _, _) or
+  (0 or 2 or _, _, _)
+try-finally-more.mo:1.29-1.37: warning [M0198], unused field call_raw in object pattern (delete or rewrite as `call_raw = _`)
+try-finally-more.mo:1.39-1.55: warning [M0198], unused field principalOfActor in object pattern (delete or rewrite as `principalOfActor = _`)
+try-finally-more.mo:12.17-12.18: warning [M0194], unused identifier e (delete or rename to wildcard `_` or `_e`)
diff --git a/test/run-drun/try-finally-bug.mo b/test/run-drun/try-finally-bug.mo
new file mode 100644
index 00000000000..ba130c1063d
--- /dev/null
+++ b/test/run-drun/try-finally-bug.mo
@@ -0,0 +1,22 @@
+import { debugPrint; error; call_raw; principalOfActor } =  "mo:⛔";
+
+actor A {
+
+    func t0() : async () {
+      try { }
+//        catch e {}
+        finally {
+         ignore async {};
+       } : ();
+    };
+
+    public func go() : async () {
+        await t0();
+    };
+
+};
+
+//SKIP ic-ref-run
+
+A.go(); //OR-CALL ingress go "DIDL\x00\x00"
+

From 796835648477c4982f5b9abc881fc1bad81d63e9 Mon Sep 17 00:00:00 2001
From: Claudio Russo <claudio@dfinity.org>
Date: Thu, 18 Jul 2024 17:29:27 +0100
Subject: [PATCH 177/179] bug

---
 test/run-drun/try-finally-bug.mo | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/test/run-drun/try-finally-bug.mo b/test/run-drun/try-finally-bug.mo
index ba130c1063d..ccdbbc508b4 100644
--- a/test/run-drun/try-finally-bug.mo
+++ b/test/run-drun/try-finally-bug.mo
@@ -3,11 +3,10 @@ import { debugPrint; error; call_raw; principalOfActor } =  "mo:⛔";
 actor A {
 
     func t0() : async () {
-      try { }
-//        catch e {}
+      let () = try { }
         finally {
-         ignore async {};
-       } : ();
+          ignore async {};
+       };
     };
 
     public func go() : async () {

From ed8aae3fcdb5fb01dda5e6677307b159a57ccc8e Mon Sep 17 00:00:00 2001
From: Claudio Russo <claudio@dfinity.org>
Date: Thu, 18 Jul 2024 17:49:43 +0100
Subject: [PATCH 178/179] fix bug using NullCap; update test output; remove
 error code

---
 src/lang_utils/error_codes.ml       |  1 -
 src/lang_utils/error_codes/M0200.md | 13 -------------
 src/mo_frontend/typing.ml           | 13 ++++---------
 test/fail/ok/try-finally.tc.ok      |  5 +++--
 4 files changed, 7 insertions(+), 25 deletions(-)
 delete mode 100644 src/lang_utils/error_codes/M0200.md

diff --git a/src/lang_utils/error_codes.ml b/src/lang_utils/error_codes.ml
index 01f4088801f..15158cb264a 100644
--- a/src/lang_utils/error_codes.ml
+++ b/src/lang_utils/error_codes.ml
@@ -203,5 +203,4 @@ let error_codes : (string * string option) list =
     "M0197", Some([%blob "lang_utils/error_codes/M0197.md"]); (* `system` capability required *)
     "M0198", Some([%blob "lang_utils/error_codes/M0198.md"]); (* Unused field pattern warning *)
     "M0199", Some([%blob "lang_utils/error_codes/M0199.md"]); (* Deprecate experimental stable memory *)
-    "M0200", Some([%blob "lang_utils/error_codes/M0200.md"]); (* Cleanup clause must have trivial effect *)
   ]
diff --git a/src/lang_utils/error_codes/M0200.md b/src/lang_utils/error_codes/M0200.md
deleted file mode 100644
index d3832e980db..00000000000
--- a/src/lang_utils/error_codes/M0200.md
+++ /dev/null
@@ -1,13 +0,0 @@
-# M0200
-
-If you get this error then you are trying to message from
-the `finally` clause of a `try` block.
-
-`finally` clauses are generally used to clean up local state
-in the event of messaging failures, and are especially invoked when
-the code doing the result processing traps. In this last-resort cleanup
-only local manipulations are allowed to (e.g.) release locks and thus
-prevent the canister from ending up in a stuck state.
-
-Should you encounter this error, so make sure that you move all messaging
-code out of the `finally` block.
diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml
index b6a26817cf2..fc6aafe25d2 100644
--- a/src/mo_frontend/typing.ml
+++ b/src/mo_frontend/typing.ml
@@ -1538,9 +1538,10 @@ and infer_exp'' env exp : T.typ =
     let t1 = infer_exp env exp1 in
     let t2 = infer_cases env T.catch T.Non cases in
     if not env.pre then begin
-      Option.iter (check_exp_strong { env with rets = None; labs = T.Env.empty } T.unit) exp2_opt;
       check_ErrorCap env "try" exp.at;
-      if cases <> [] then coverage_cases "try handler" env cases T.catch exp.at
+      if cases <> [] then
+        coverage_cases "try handler" env cases T.catch exp.at;
+      Option.iter (check_exp_strong { env with async = C.NullCap; rets = None; labs = T.Env.empty } T.unit) exp2_opt
     end;
     T.lub t1 t2
   | WhileE (exp1, exp2) ->
@@ -1844,13 +1845,7 @@ and check_exp' env0 t exp : T.typ =
     if cases <> []
     then coverage_cases "try handler" env cases T.catch exp.at;
     if not env.pre then
-      begin match exp2_opt with
-      | None -> ()
-      | Some exp2 ->
-        check_exp_strong { env with rets = None; labs = T.Env.empty } T.unit exp2;
-        if exp2.note.note_eff <> T.Triv then
-          local_error env exp2.at "M0200" "a cleanup clause must not send messages";
-      end;
+      Option.iter (check_exp_strong { env with async = C.NullCap; rets = None; labs = T.Env.empty; } T.unit) exp2_opt;
     t
   (* TODO: allow shared with one scope par *)
   | FuncE (_, shared_pat,  [], pat, typ_opt, _sugar, exp), T.Func (s, c, [], ts1, ts2) ->
diff --git a/test/fail/ok/try-finally.tc.ok b/test/fail/ok/try-finally.tc.ok
index 349766cb929..9615e26ab19 100644
--- a/test/fail/ok/try-finally.tc.ok
+++ b/test/fail/ok/try-finally.tc.ok
@@ -1,5 +1,6 @@
-try-finally.mo:10.17-10.31: type error [M0200], a cleanup clause must not send messages
-try-finally.mo:16.17-16.39: type error [M0200], a cleanup clause must not send messages
+try-finally.mo:10.26-10.29: type error [M0047], send capability required, but not available
+ (need an enclosing async expression or function body)
+try-finally.mo:16.19-16.37: type error [M0039], misplaced throw
 try-finally.mo:22.19-22.21: type error [M0050], literal of type
   Nat
 does not have expected type

From cddd55c495a1a49690e52422be20abdfd4033642 Mon Sep 17 00:00:00 2001
From: Claudio Russo <claudio@dfinity.org>
Date: Thu, 18 Jul 2024 17:54:39 +0100
Subject: [PATCH 179/179] clean up test files

---
 test/run-drun/ok/try-finally-bug.tc.ok            |  1 +
 test/run-drun/ok/try-finally-bug.tc.ret.ok        |  1 +
 test/run-drun/ok/try-finally-more.comp-ref.ok     |  6 ------
 test/run-drun/ok/try-finally-more.comp-ref.ret.ok |  1 -
 test/run-drun/ok/try-finally-more.comp.ok         |  6 ------
 test/run-drun/ok/try-finally-more.comp.ret.ok     |  1 -
 test/run-drun/ok/try-finally-more.diff-low.ok     | 12 ------------
 test/run-drun/ok/try-finally-more.run-ir.ok       |  3 ---
 test/run-drun/ok/try-finally-more.run-low.ok      |  6 ------
 test/run-drun/ok/try-finally-more.run-low.ret.ok  |  1 -
 test/run-drun/ok/try-finally-more.run.ok          |  3 ---
 test/run-drun/ok/try-finally-more.tc.ok           |  9 ---------
 12 files changed, 2 insertions(+), 48 deletions(-)
 create mode 100644 test/run-drun/ok/try-finally-bug.tc.ok
 create mode 100644 test/run-drun/ok/try-finally-bug.tc.ret.ok
 delete mode 100644 test/run-drun/ok/try-finally-more.comp-ref.ok
 delete mode 100644 test/run-drun/ok/try-finally-more.comp-ref.ret.ok
 delete mode 100644 test/run-drun/ok/try-finally-more.comp.ok
 delete mode 100644 test/run-drun/ok/try-finally-more.comp.ret.ok
 delete mode 100644 test/run-drun/ok/try-finally-more.diff-low.ok
 delete mode 100644 test/run-drun/ok/try-finally-more.run-ir.ok
 delete mode 100644 test/run-drun/ok/try-finally-more.run-low.ok
 delete mode 100644 test/run-drun/ok/try-finally-more.run-low.ret.ok
 delete mode 100644 test/run-drun/ok/try-finally-more.run.ok
 delete mode 100644 test/run-drun/ok/try-finally-more.tc.ok

diff --git a/test/run-drun/ok/try-finally-bug.tc.ok b/test/run-drun/ok/try-finally-bug.tc.ok
new file mode 100644
index 00000000000..7b395a1134e
--- /dev/null
+++ b/test/run-drun/ok/try-finally-bug.tc.ok
@@ -0,0 +1 @@
+try-finally-bug.mo:8.18-8.26: type error [M0037], misplaced async expression; try enclosing in an async function
diff --git a/test/run-drun/ok/try-finally-bug.tc.ret.ok b/test/run-drun/ok/try-finally-bug.tc.ret.ok
new file mode 100644
index 00000000000..69becfa16f9
--- /dev/null
+++ b/test/run-drun/ok/try-finally-bug.tc.ret.ok
@@ -0,0 +1 @@
+Return code 1
diff --git a/test/run-drun/ok/try-finally-more.comp-ref.ok b/test/run-drun/ok/try-finally-more.comp-ref.ok
deleted file mode 100644
index 5d81f42f598..00000000000
--- a/test/run-drun/ok/try-finally-more.comp-ref.ok
+++ /dev/null
@@ -1,6 +0,0 @@
-OOPS! You've triggered a compiler bug.
-Please report this at https://github.com/dfinity/motoko/issues/new with the following details:
-
-Motoko (source 0.11.2-171-g51bb8a193)
-
-Fatal error: exception File "ir_passes/await.ml", line 99, characters 2-8: Assertion failed
diff --git a/test/run-drun/ok/try-finally-more.comp-ref.ret.ok b/test/run-drun/ok/try-finally-more.comp-ref.ret.ok
deleted file mode 100644
index 63e15a4d3fa..00000000000
--- a/test/run-drun/ok/try-finally-more.comp-ref.ret.ok
+++ /dev/null
@@ -1 +0,0 @@
-Return code 2
diff --git a/test/run-drun/ok/try-finally-more.comp.ok b/test/run-drun/ok/try-finally-more.comp.ok
deleted file mode 100644
index 5d81f42f598..00000000000
--- a/test/run-drun/ok/try-finally-more.comp.ok
+++ /dev/null
@@ -1,6 +0,0 @@
-OOPS! You've triggered a compiler bug.
-Please report this at https://github.com/dfinity/motoko/issues/new with the following details:
-
-Motoko (source 0.11.2-171-g51bb8a193)
-
-Fatal error: exception File "ir_passes/await.ml", line 99, characters 2-8: Assertion failed
diff --git a/test/run-drun/ok/try-finally-more.comp.ret.ok b/test/run-drun/ok/try-finally-more.comp.ret.ok
deleted file mode 100644
index 63e15a4d3fa..00000000000
--- a/test/run-drun/ok/try-finally-more.comp.ret.ok
+++ /dev/null
@@ -1 +0,0 @@
-Return code 2
diff --git a/test/run-drun/ok/try-finally-more.diff-low.ok b/test/run-drun/ok/try-finally-more.diff-low.ok
deleted file mode 100644
index 5f1fdaf56c0..00000000000
--- a/test/run-drun/ok/try-finally-more.diff-low.ok
+++ /dev/null
@@ -1,12 +0,0 @@
---- try-finally-more.run
-+++ try-finally-more.run-low
-@@ -1,3 +1,6 @@
--try
--catch
--OUT
-+OOPS! You've triggered a compiler bug.
-+Please report this at https://github.com/dfinity/motoko/issues/new with the following details:
-+
-+Motoko (source 0.11.2-171-g51bb8a193)
-+
-+Fatal error: exception File "ir_passes/await.ml", line 99, characters 2-8: Assertion failed
diff --git a/test/run-drun/ok/try-finally-more.run-ir.ok b/test/run-drun/ok/try-finally-more.run-ir.ok
deleted file mode 100644
index e90ef7fd80c..00000000000
--- a/test/run-drun/ok/try-finally-more.run-ir.ok
+++ /dev/null
@@ -1,3 +0,0 @@
-try
-catch
-OUT
diff --git a/test/run-drun/ok/try-finally-more.run-low.ok b/test/run-drun/ok/try-finally-more.run-low.ok
deleted file mode 100644
index 5d81f42f598..00000000000
--- a/test/run-drun/ok/try-finally-more.run-low.ok
+++ /dev/null
@@ -1,6 +0,0 @@
-OOPS! You've triggered a compiler bug.
-Please report this at https://github.com/dfinity/motoko/issues/new with the following details:
-
-Motoko (source 0.11.2-171-g51bb8a193)
-
-Fatal error: exception File "ir_passes/await.ml", line 99, characters 2-8: Assertion failed
diff --git a/test/run-drun/ok/try-finally-more.run-low.ret.ok b/test/run-drun/ok/try-finally-more.run-low.ret.ok
deleted file mode 100644
index 63e15a4d3fa..00000000000
--- a/test/run-drun/ok/try-finally-more.run-low.ret.ok
+++ /dev/null
@@ -1 +0,0 @@
-Return code 2
diff --git a/test/run-drun/ok/try-finally-more.run.ok b/test/run-drun/ok/try-finally-more.run.ok
deleted file mode 100644
index e90ef7fd80c..00000000000
--- a/test/run-drun/ok/try-finally-more.run.ok
+++ /dev/null
@@ -1,3 +0,0 @@
-try
-catch
-OUT
diff --git a/test/run-drun/ok/try-finally-more.tc.ok b/test/run-drun/ok/try-finally-more.tc.ok
deleted file mode 100644
index a939fac2191..00000000000
--- a/test/run-drun/ok/try-finally-more.tc.ok
+++ /dev/null
@@ -1,9 +0,0 @@
-try-finally-more.mo:7.21-7.28: warning [M0145], this pattern of type
-  (Nat, Nat, Nat)
-does not cover value
-  (1, 2, 0 or 1 or _) or
-  (1, 0 or 1 or _, _) or
-  (0 or 2 or _, _, _)
-try-finally-more.mo:1.29-1.37: warning [M0198], unused field call_raw in object pattern (delete or rewrite as `call_raw = _`)
-try-finally-more.mo:1.39-1.55: warning [M0198], unused field principalOfActor in object pattern (delete or rewrite as `principalOfActor = _`)
-try-finally-more.mo:12.17-12.18: warning [M0194], unused identifier e (delete or rename to wildcard `_` or `_e`)