feat: finally to also clean up after trapping continuations

src/lowering/desugar.ml

@@ -216,7 +216,8 @@ 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.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

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

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 *)

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]

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 }

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) ->

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, _ (*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) ->
+  | 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), _ ->
+  | 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) ->

src/mo_interpreter/interpret.ml

@@ -620,10 +620,17 @@ 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
+  | 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 env' = { env with throws = Some k' } 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
     interpret_exp env exp1 (fun v1 ->

test/run/ok/try-finally.comp.ok

@@ -0,0 +1 @@
+try-finally.mo:3.1-4.26: type error [M0039], misplaced try

test/run/ok/try-finally.comp.ret.ok

@@ -0,0 +1 @@
+Return code 1

test/run/ok/try-finally.diff-ir.ok

@@ -0,0 +1,5 @@
+--- try-finally.run
++++ try-finally.run-ir
+@@ -1,2 +1 @@
+ IN
+-OUT

test/run/ok/try-finally.diff-low.ok

@@ -0,0 +1,5 @@
+--- try-finally.run
++++ try-finally.run-low
+@@ -1,2 +1 @@
+ IN
+-OUT

test/run/ok/try-finally.run-ir.ok

@@ -0,0 +1 @@
+IN

test/run/ok/try-finally.run-low.ok

@@ -0,0 +1 @@
+IN

test/run/ok/try-finally.run.ok

@@ -0,0 +1,2 @@
+IN
+OUT

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
+  _

test/run/try-finally.mo

@@ -0,0 +1,4 @@
+import { debugPrint } =  "mo:prim";
+
+try { debugPrint "IN" }
+case { debugPrint "OUT" };