improve n-ary continuation coercion

src/codegen/compile.ml

@@ -10590,8 +10590,7 @@ and compile_prim_invocation (env : E.t) ae p es at =
     let call_as_prim = match fun_sr, sort with
       | SR.Const (_, Const.Fun (mk_fi, Const.PrimWrapper prim)), _ ->
          begin match n_args, e2.it with
-         | 0, _ -> true
-         | 1, _ -> true
+         | (0 | 1), _ -> true
          | n, PrimE (TupPrim, es) when List.length es = n -> true
          | _, _ -> false
          end

src/ir_passes/async.ml

@@ -71,6 +71,23 @@ let new_async t =
   let fail = fresh_var "fail" (typ (projE call_new_async 2)) in
   (async, fulfill, fail), call_new_async
 
+let coerce_and_cont0T =
+  T.Func (
+    T.Local,
+    T.Returns,
+    [],
+    [t_async_fut unary T.unit],
+    [t_async_fut nary T.unit])
+
+let coerce_and_cont2T =
+  let t = T.(Tup [Var ("T", 0); Var ("U", 1)]) in
+  T.Func (
+    T.Local,
+    T.Returns,
+    [ { var = "T"; sort = T.Type; bound = T.Any }; { var = "U"; sort = T.Type; bound = T.Any } ],
+    [t_async_fut unary t],
+    [t_async_fut nary t])
+
 let new_nary_async_reply ts =
   (* The async implementation isn't n-ary *)
   let t = T.seq ts in
@@ -91,16 +108,22 @@ let new_nary_async_reply ts =
     in
     match ts with
     | [t1] ->
-      begin
-      match T.normalize t1 with
-      | T.Tup _ ->
-        (* TODO(#3740): find a better fix than PR #3741 *)
-        (* HACK *)
-        coerce t1
+      begin match T.normalize t1 with
+      | T.Tup [] ->
+        varE (var "@coerce_and_cont00" coerce_and_cont0T) -*- varE unary_async
+      | T.Tup ([_; _] as tu) ->
+        callE (varE (var "@coerce_and_cont2" coerce_and_cont2T)) tu (varE unary_async)
+      (* TODO(#3740): find a better fix than PR #3741 *)
+      (* HACK *)
+      | T.Tup _ -> coerce t1
       | _ ->
         varE unary_async
       end
-    | ts1 ->
+    | [] ->
+      varE (var "@coerce_and_cont0" coerce_and_cont0T) -*- varE unary_async
+    | [_; _] ->
+      callE (varE (var "@coerce_and_cont2" coerce_and_cont2T)) ts (varE unary_async)
+    | _ ->
       coerce t
   in
   (* construct the n-ary reply callback that take a *sequence* of values to fulfill the async *)

src/ir_passes/await.ml

@@ -594,7 +594,7 @@ and t_comp_unit context = function
         let e = fresh_var "e" T.catch in
         ProgU [
           funcD throw e (assertE (falseE ()));
-          expD (c_block context' ds (tupE []) (meta (T.unit) (fun v1 -> tupE [])))
+          expD (c_block context' ds (tupE []) (meta T.unit (fun v1 -> tupE [])))
         ]
     end
   | ActorU (as_opt, ds, ids, { meta = m; preupgrade; postupgrade; heartbeat; timer; inspect}, t) ->
@@ -619,7 +619,7 @@ and t_ignore_throw context exp =
      { (blockE [
           funcD throw e (tupE[]);
         ]
-        (c_exp context' exp (meta (T.unit) (fun v1 -> tupE []))))
+        (c_exp context' exp (meta T.unit (fun v1 -> tupE []))))
        (* timer logic requires us to preserve any source location,
           or timer won't be initialized in compile.ml *)
        with at = exp.at

src/prelude/internals.mo

@@ -307,6 +307,18 @@ func @getSystemRefund() : @Refund {
   return (prim "cyclesRefunded" : () -> Nat) ();
 };
 
+func @coerce_and_cont2<T <: Any, U <: Any>(a : @Async<(T, U)>) :
+  (k : (T, U) -> (), r : @Cont<Error>) -> {
+    #suspend;
+    #schedule : () -> ()
+  } = func(k, r) = a(func tup = k tup, r);
+
+func @coerce_and_cont0(a : @Async<()>) :
+  (k : () -> (), r : @Cont<Error>) -> {
+    #suspend;
+    #schedule : () -> ()
+  } = func(k, r) = a(func() = k(), r);
+
 func @new_async<T <: Any>() : (@Async<T>, @Cont<T>, @Cont<Error>) {
   let w_null = func(r : @Refund, t : T) { };
   let r_null = func(_ : Error) {};

test/fail/ok/cyclic-bound5.tc.ok

@@ -1 +1 @@
-cyclic-bound5.mo:7.8-7.17: type error [M0043], type parameter U__1 has cyclic bounds U__1 <: U__1
+cyclic-bound5.mo:7.8-7.17: type error [M0043], type parameter U__2 has cyclic bounds U__2 <: U__2

test/fail/ok/inference.tc.ok

@@ -25,7 +25,7 @@ to argument of type
 to produce result of type
   Any
 because type parameter T has an open bound
-  U__12
+  U__13
 mentioning another type parameter, so that explicit type instantiation is required due to limitation of inference
 inference.mo:95.8-95.26: type error [M0098], cannot implicitly instantiate function of type
   <T <: U, U>(T, T) -> (U, U)
@@ -34,7 +34,7 @@ to argument of type
 to produce result of type
   Any
 because type parameter T has an open bound
-  U__13
+  U__14
 mentioning another type parameter, so that explicit type instantiation is required due to limitation of inference
 inference.mo:96.8-96.23: type error [M0098], cannot implicitly instantiate function of type
   <T <: U, U>(T, T) -> (U, U)
@@ -43,7 +43,7 @@ to argument of type
 to produce result of type
   Any
 because type parameter T has an open bound
-  U__14
+  U__15
 mentioning another type parameter, so that explicit type instantiation is required due to limitation of inference
 inference.mo:111.8-111.17: type error [M0098], cannot implicitly instantiate function of type
   <T <: Int>T -> T
@@ -73,34 +73,34 @@ to argument of type
   <V>V -> V
 to produce result of type
   ()
-because no instantiation of T__102 makes
-  <V>V -> V  <:  <U>T__102 -> U
+because no instantiation of T__103 makes
+  <V>V -> V  <:  <U>T__103 -> U
 inference.mo:118.1-118.31: type error [M0098], cannot implicitly instantiate function of type
   <T>(<U>U -> T) -> ()
 to argument of type
   <V>V -> V
 to produce result of type
   ()
-because no instantiation of T__103 makes
-  <V>V -> V  <:  <U>U -> T__103
+because no instantiation of T__104 makes
+  <V>V -> V  <:  <U>U -> T__104
 inference.mo:127.8-127.20: type error [M0098], cannot implicitly instantiate function of type
   <T>[T] -> T
 to argument of type
   [var Nat]
 to produce result of type
   Any
-because no instantiation of T__106 makes
-  [var Nat]  <:  [T__106]
+because no instantiation of T__107 makes
+  [var Nat]  <:  [T__107]
 inference.mo:130.1-130.13: type error [M0098], cannot implicitly instantiate function of type
   <T>[var T] -> T
 to argument of type
   [Nat]
 to produce result of type
   ()
-because no instantiation of T__107 makes
-  [Nat]  <:  [var T__107]
+because no instantiation of T__108 makes
+  [Nat]  <:  [var T__108]
 and
-  T__107  <:  ()
+  T__108  <:  ()
 inference.mo:132.1-132.17: type error [M0098], cannot implicitly instantiate function of type
   <T>[var T] -> T
 to argument of type
@@ -115,24 +115,24 @@ so that no valid instantiation exists
 inference.mo:137.4-137.8: type error [M0098], cannot implicitly instantiate function of type
   <U <: {}>U -> ()
 to argument of type
-  T__39
+  T__40
 to produce result of type
   ()
 because implicit instantiation of type parameter U is over-constrained with
-  T__39  <:  U  <:  {}
+  T__40  <:  U  <:  {}
 where
-  T__39  </:  {}
+  T__40  </:  {}
 so that no valid instantiation exists
 inference.mo:152.11-152.15: type error [M0098], cannot implicitly instantiate function of type
-  <U <: T__42>U -> U
+  <U <: T__43>U -> U
 to argument of type
-  T__42
+  T__43
 to produce result of type
   None
 because implicit instantiation of type parameter U is over-constrained with
-  T__42  <:  U  <:  None
+  T__43  <:  U  <:  None
 where
-  T__42  </:  None
+  T__43  </:  None
 so that no valid instantiation exists
 inference.mo:172.8-172.54: type error [M0098], cannot implicitly instantiate function of type
   <T>(Bool, [var T], [var T]) -> [var T]
@@ -151,7 +151,7 @@ to argument of type
   {type x = Nat}
 to produce result of type
   Any
-because no instantiation of T__117 makes
-  {type x = Nat}  <:  {x : T__117}
+because no instantiation of T__118 makes
+  {type x = Nat}  <:  {x : T__118}
 inference.mo:183.8-183.21: type error [M0045], wrong number of type arguments: expected 2 but got 0
 inference.mo:186.8-186.15: type error [M0045], wrong number of type arguments: expected 1 but got 0

test/fail/ok/issue-2391.tc.ok

@@ -1,3 +1,3 @@
-issue-2391.mo:3.3-3.35: type error [M0137], type C = {y : T__16} references type parameter T__16 from an outer scope
-issue-2391.mo:10.3-10.47: type error [M0137], type C<U> = {y : T__17} references type parameter T__17 from an outer scope
+issue-2391.mo:3.3-3.35: type error [M0137], type C = {y : T__17} references type parameter T__17 from an outer scope
+issue-2391.mo:10.3-10.47: type error [M0137], type C<U> = {y : T__18} references type parameter T__18 from an outer scope
 issue-2391.mo:16.3-16.64: type error [M0137], type C<U> = {y : (T1, T2)} references type parameters T2, T1 from an outer scope

test/fail/ok/modexp2.tc.ok

@@ -1,2 +1,2 @@
 modexp2.mo:11.16-11.17: type error [M0030], type field U does not exist in type
-  module {type T = U; f : ???}
+  module {type T = U__1; f : ???}

test/fail/ok/modexp5.tc.ok

@@ -1 +1 @@
-modexp5.mo:6.20-6.30: type error [M0137], type U = T__18 references type parameter T__18 from an outer scope
+modexp5.mo:6.20-6.30: type error [M0137], type U = T__19 references type parameter T__19 from an outer scope

test/fail/ok/pretty-inference.tc.ok

@@ -170,8 +170,8 @@ to argument of type
   (Nat, Nat)
 to produce result of type
   ()
-because no instantiation of T__42, U__12 makes
-  (Nat, Nat)  <:  (T__42, U__12)
+because no instantiation of T__43, U__13 makes
+  (Nat, Nat)  <:  (T__43, U__13)
 and
   Nat  <:  ()
 pretty-inference.mo:44.1-44.9: type error [M0098], cannot implicitly instantiate function of type
@@ -180,8 +180,8 @@ to argument of type
   ((Nat, Bool), (Nat, Bool))
 to produce result of type
   ()
-because no instantiation of T__43, U__13 makes
-  ((Nat, Bool), (Nat, Bool))  <:  (T__43, U__13)
+because no instantiation of T__44, U__14 makes
+  ((Nat, Bool), (Nat, Bool))  <:  (T__44, U__14)
 and
   Nat  <:  ()
 pretty-inference.mo:46.1-46.9: type error [M0098], cannot implicitly instantiate function of type
@@ -190,9 +190,9 @@ to argument of type
   (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool)))
 to produce result of type
   ()
-because no instantiation of T__44, U__14 makes
+because no instantiation of T__45, U__15 makes
   (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool)))  <: 
-    (T__44, U__14)
+    (T__45, U__15)
 and
   Nat  <:  ()
 pretty-inference.mo:48.1-48.9: type error [M0098], cannot implicitly instantiate function of type
@@ -202,10 +202,10 @@ to argument of type
    (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool))))
 to produce result of type
   ()
-because no instantiation of T__45, U__15 makes
+because no instantiation of T__46, U__16 makes
   ((((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool))),
    (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool))))  <: 
-    (T__45, U__15)
+    (T__46, U__16)
 and
   Nat  <:  ()
 pretty-inference.mo:50.1-50.9: type error [M0098], cannot implicitly instantiate function of type
@@ -217,12 +217,12 @@ to argument of type
     (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool)))))
 to produce result of type
   ()
-because no instantiation of T__46, U__16 makes
+because no instantiation of T__47, U__17 makes
   (((((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool))),
     (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool)))),
    ((((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool))),
     (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool)))))  <: 
-    (T__46, U__16)
+    (T__47, U__17)
 and
   Nat  <:  ()
 pretty-inference.mo:52.1-52.9: type error [M0098], cannot implicitly instantiate function of type
@@ -238,7 +238,7 @@ to argument of type
      (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool))))))
 to produce result of type
   ()
-because no instantiation of T__47, U__17 makes
+because no instantiation of T__48, U__18 makes
   ((((((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool))),
      (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool)))),
     ((((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool))),
@@ -247,6 +247,6 @@ because no instantiation of T__47, U__17 makes
      (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool)))),
     ((((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool))),
      (((Nat, Bool), (Nat, Bool)), ((Nat, Bool), (Nat, Bool))))))  <: 
-    (T__47, U__17)
+    (T__48, U__18)
 and
   Nat  <:  ()

test/run-drun/await.mo

@@ -66,6 +66,9 @@ actor a {
        Prim.debugPrint a;
        Prim.debugPrint b;
     };
+    Prim.debugPrint (debug_show (await p()));
+    Prim.debugPrint (debug_show (await async (1, "two", '3')));
+    await async ();
 
     ignore(await a);
     ignore(await b);

test/run-drun/ok/await.drun-run.ok

@@ -18,10 +18,12 @@ debug.print: cnt: 2 i: 2
 debug.print: cnt: 3 i: 4
 debug.print: cnt: 4 i: 5
 debug.print: cnt: 5 i: 10
+debug.print: ("fst", "snd")
 debug.print: .
 debug.print: cnt: 6 i: 3
 debug.print: cnt: 7 i: 6
 debug.print: cnt: 8 i: 11
+debug.print: (1, "two", '3')
 debug.print: .
 debug.print: cnt: 9 i: 7
 debug.print: cnt: 10 i: 12

test/run-drun/ok/await.run-ir.ok

@@ -16,10 +16,12 @@ cnt: 2 i: 2
 cnt: 3 i: 4
 cnt: 4 i: 5
 cnt: 5 i: 10
+("fst", "snd")
 .
 cnt: 6 i: 3
 cnt: 7 i: 6
 cnt: 8 i: 11
+(1, "two", '3')
 .
 cnt: 9 i: 7
 cnt: 10 i: 12

test/run-drun/ok/await.run-low.ok

@@ -16,10 +16,12 @@ cnt: 2 i: 2
 cnt: 3 i: 4
 cnt: 4 i: 5
 cnt: 5 i: 10
+("fst", "snd")
 .
 cnt: 6 i: 3
 cnt: 7 i: 6
 cnt: 8 i: 11
+(1, "two", '3')
 .
 cnt: 9 i: 7
 cnt: 10 i: 12

test/run-drun/ok/await.run.ok

@@ -16,10 +16,12 @@ cnt: 2 i: 2
 cnt: 3 i: 4
 cnt: 4 i: 5
 cnt: 5 i: 10
+("fst", "snd")
 .
 cnt: 6 i: 3
 cnt: 7 i: 6
 cnt: 8 i: 11
+(1, "two", '3')
 .
 cnt: 9 i: 7
 cnt: 10 i: 12

test/run-drun/ok/await.tc.ok

@@ -1,3 +1,2 @@
 await.mo:45.9-45.10: warning [M0194], unused identifier g (delete or rename to wildcard `_` or `_g`)
-await.mo:63.10-63.11: warning [M0194], unused identifier p (delete or rename to wildcard `_` or `_p`)
 await.mo:64.9-64.10: warning [M0194], unused identifier h (delete or rename to wildcard `_` or `_h`)

test/run-drun/ok/do-async-poly.tc.ok

@@ -1,10 +1,10 @@
 do-async-poly.mo:8.42-8.43: type error [M0033], async has non-shared content type
-  T__20
-do-async-poly.mo:13.42-13.43: type error [M0033], async has non-shared content type
   T__21
-do-async-poly.mo:18.44-18.45: type error [M0033], async has non-shared content type
+do-async-poly.mo:13.42-13.43: type error [M0033], async has non-shared content type
   T__22
-do-async-poly.mo:22.42-22.43: type error [M0033], async has non-shared content type
+do-async-poly.mo:18.44-18.45: type error [M0033], async has non-shared content type
   T__23
-do-async-poly.mo:26.43-26.44: type error [M0033], async has non-shared content type
+do-async-poly.mo:22.42-22.43: type error [M0033], async has non-shared content type
   T__24
+do-async-poly.mo:26.43-26.44: type error [M0033], async has non-shared content type
+  T__25