bugfix: check that timer servicing worked

src/ir_def/construct.ml

@@ -112,6 +112,7 @@ let primE prim es =
     | DeserializePrim ts -> T.seq ts
     | DeserializeOptPrim ts -> T.Opt (T.seq ts)
     | OtherPrim "trap" -> T.Non
+    | OtherPrim "global_timer_set" -> T.nat64
     | OtherPrim "call_perform_status" -> T.(Prim Nat32)
     | OtherPrim "call_perform_message" -> T.text
     | OtherPrim "array_len"
@@ -269,6 +270,12 @@ let nat32E n =
     note = Note.{ def with typ = T.(Prim Nat32) }
   }
 
+let nat64E n =
+  { it = LitE (Nat64Lit n);
+    at = no_region;
+    note = Note.{ def with typ = T.nat64 }
+  }
+
 let natE n =
   { it = LitE (NatLit n);
     at = no_region;

src/ir_def/construct.mli

@@ -66,6 +66,7 @@ val let_else_switch : pat -> exp -> exp -> exp
 val natE : Mo_values.Numerics.Nat.t -> exp
 val intE : Mo_values.Numerics.Int.t -> exp
 val nat32E : Mo_values.Numerics.Nat32.t -> exp
+val nat64E : Mo_values.Numerics.Nat64.t -> exp
 val textE : string -> exp
 val blobE : string -> exp
 val letE : var -> exp -> exp -> exp

src/ir_passes/await.ml

@@ -653,14 +653,14 @@ and t_comp_unit context = function
         preupgrade = t_exp LabelEnv.empty preupgrade;
         postupgrade = t_exp LabelEnv.empty postupgrade;
         heartbeat = t_ignore_throw LabelEnv.empty heartbeat;
-        timer = t_ignore_throw LabelEnv.empty timer;
+        timer = t_timer_throw LabelEnv.empty timer;
         inspect = t_exp LabelEnv.empty inspect;
         stable_record = t_exp LabelEnv.empty stable_record;
         stable_type;
       },
       t)
 
-and t_ignore_throw context exp =
+and t_on_throw context exp t_exp =
   match exp.it with
   | Ir.PrimE (Ir.TupPrim, []) ->
      exp
@@ -671,14 +671,23 @@ and t_ignore_throw context exp =
          (LabelEnv.add Throw (Cont throw) context) in
      let e = fresh_var "e" T.catch in
      { (blockE [
-          funcD throw e (tupE[]);
+          funcD throw e t_exp;
         ]
         (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
      }
 
+and t_ignore_throw context exp = t_on_throw context exp (tupE[])
+
+(* if self-call queue full: expire global timer soon and retry *)
+and t_timer_throw context exp =
+  t_on_throw context exp
+    (blockE [expD (primE
+                (OtherPrim "global_timer_set")
+                [Mo_values.Numerics.Nat64.of_int 1 |> nat64E])]
+       (tupE[]))
 
 and t_prog (prog, flavor) =
   (t_comp_unit LabelEnv.empty prog, { flavor with has_await = false })

src/lowering/desugar.ml

@@ -367,8 +367,8 @@ and call_system_func_opt name es obj_typ =
            let timer =
              blockE
                [ expD T.(callE (varE (var id.it note)) [Any]
-                   (varE (var "@set_global_timer" (Func (Local, Returns, [], [Prim Nat64], []))))) ]
-               (unitE ()) in
+                   (varE (var "@set_global_timer" Mo_frontend.Typing.global_timer_set_type))) ]
+               (unitE()) in
            { timer with at }
         | "heartbeat" ->
           blockE
@@ -606,7 +606,7 @@ and build_actor at ts self_id es obj_typ =
           | None when !Mo_config.Flags.global_timer ->
             blockE
               [ expD T.(callE (varE (var "@timer_helper" Mo_frontend.Typing.heartbeat_type)) [unit] (unitE())) ]
-              (unitE ())
+              (unitE())
           | None -> tupE []);
        inspect =
          (match call_system_func_opt "inspect" es obj_typ with

src/mo_frontend/typing.ml

@@ -389,9 +389,11 @@ let infer_mut mut : T.typ -> T.typ =
 let heartbeat_type =
   T.(Func (Local, Returns, [scope_bind], [], [Async (Fut, Var (default_scope_var, 0), unit)]))
 
+let global_timer_set_type = T.(Func (Local, Returns, [], [Prim Nat64], []))
+
 let timer_type =
   T.(Func (Local, Returns, [scope_bind],
-    [Func (Local, Returns, [], [Prim Nat64], [])],
+    [global_timer_set_type],
     [Async (Fut, Var (default_scope_var, 0), unit)]))
 
 let system_funcs tfs =

src/mo_frontend/typing.mli

@@ -13,3 +13,4 @@ val check_actors : ?viper_mode:bool -> ?check_actors:bool -> scope -> Syntax.pro
 val check_stab_sig : scope -> Syntax.stab_sig -> (field list) Diag.result
 
 val heartbeat_type : typ
+val global_timer_set_type : typ

src/prelude/internals.mo

@@ -675,5 +675,4 @@ func @cancelTimer(id : Nat) {
   }
 };
 
-
 func @set_global_timer(time : Nat64) = ignore (prim "global_timer_set" : Nat64 -> Nat64) time;