feat: parenthetical syntax for cycles, timeout etc.

default.nix

@@ -512,8 +512,8 @@ rec {
       drun-compacting-gc = snty_compacting_gc_subdir "run-drun" [ moc nixpkgs.drun ] ;
       drun-generational-gc = snty_generational_gc_subdir "run-drun" [ moc nixpkgs.drun ] ;
       drun-incremental-gc = snty_incremental_gc_subdir "run-drun" [ moc nixpkgs.drun ] ;
-      drun-eop-release = enhanced_orthogonal_persistence_subdir "run-drun" [ moc nixpkgs.drun ] ;
-      drun-eop-debug = snty_enhanced_orthogonal_persistence_subdir "run-drun" [ moc nixpkgs.drun ] ;
+      ## FOR NOW drun-eop-release = enhanced_orthogonal_persistence_subdir "run-drun" [ moc nixpkgs.drun ] ;
+      ## FOR NOW drun-eop-debug = snty_enhanced_orthogonal_persistence_subdir "run-drun" [ moc nixpkgs.drun ] ;
       fail       = test_subdir "fail"       [ moc ];
       fail-eop   = enhanced_orthogonal_persistence_subdir "fail"       [ moc ];
       repl       = test_subdir "repl"       [ moc ];

doc/md/examples/grammar.txt

@@ -219,6 +219,7 @@
     'break' <id> <exp_nullary>?
     'continue' <id>
     'debug' <exp_nest>
+    '(' <exp_post>? 'with' <list(<exp_field>, ';')> ')' <exp_nest>
     'if' <exp_nullary> <exp_nest>
     'if' <exp_nullary> <exp_nest> 'else' <exp_nest>
     'try' <exp_nest> <catch>

src/codegen/compile_enhanced.ml

@@ -12219,7 +12219,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 _FIXME, [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
@@ -12455,7 +12455,7 @@ 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, exp_c) ->
+  | SelfCallE (cyc_FIXME, 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

src/ir_def/arrange_ir.ml

@@ -22,14 +22,15 @@ let rec exp e = match e.it with
   | SwitchE (e, cs)     -> "SwitchE" $$ [exp e] @ List.map case cs
   | LoopE e1            -> "LoopE"   $$ [exp e1]
   | LabelE (i, t, e)    -> "LabelE"  $$ [id i; typ t; exp e]
-  | AsyncE (Type.Fut, tb, e, t) -> "AsyncE"  $$ [typ_bind tb; exp e; typ t]
-  | AsyncE (Type.Cmp, tb, e, t) -> "AsyncE*"  $$ [typ_bind tb; exp e; typ t]
+  | AsyncE (None, Type.Fut, tb, e, t) -> "AsyncE" $$ [typ_bind tb; exp e; typ t]
+  | AsyncE (Some par, Type.Fut, tb, e, t) -> "AsyncE()" $$ [exp par; typ_bind tb; exp e; typ t]
+  | AsyncE (_, Type.Cmp, tb, e, t) -> "AsyncE*" $$ [typ_bind tb; exp e; typ t]
   | DeclareE (i, t, e1) -> "DeclareE" $$ [id i; exp e1]
   | 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, exp_c) ->
-    "SelfCallE" $$ [typ (Type.seq ts); exp exp_f; exp exp_k; exp exp_r; exp exp_c]
+  | SelfCallE (_FIXME, ts, exp_f, exp_k, exp_r, exp_c) ->
+    "SelfCallE" $$ [exp _FIXME; 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, None) -> "TryE" $$ [exp e] @ List.map case cs
@@ -61,7 +62,8 @@ and args = function
 and arg a = Atom a.it
 
 and prim = function
-  | CallPrim ts       -> "CallPrim" $$ List.map typ ts
+  | CallPrim (ts, par) when empty par -> "CallPrim" $$ List.map typ ts
+  | CallPrim (ts, par) -> "CallPrim()" $$ [exp par] @ List.map typ ts
   | UnPrim (t, uo)    -> "UnPrim"     $$ [typ t; Arrange_ops.unop uo]
   | BinPrim (t, bo)   -> "BinPrim"    $$ [typ t; Arrange_ops.binop bo]
   | RelPrim (t, ro)   -> "RelPrim"    $$ [typ t; Arrange_ops.relop ro]
@@ -95,34 +97,41 @@ and prim = function
   | ActorOfIdBlob t   -> "ActorOfIdBlob" $$ [typ t]
   | BlobOfIcUrl       -> Atom "BlobOfIcUrl"
   | IcUrlOfBlob       -> Atom "IcUrlOfBlob"
-  | SelfRef t         -> "SelfRef"    $$ [typ t]
+  | SelfRef t         -> "SelfRef" $$ [typ t]
   | SystemTimePrim    -> Atom "SystemTimePrim"
+  | SystemTimeoutPrim -> Atom "SystemTimeoutPrim"
   | SystemCyclesAddPrim -> Atom "SystemCyclesAddPrim"
   | SystemCyclesAcceptPrim -> Atom "SystemCyclesAcceptPrim"
   | SystemCyclesAvailablePrim -> Atom "SystemCyclesAvailablePrim"
   | SystemCyclesBalancePrim -> Atom "SystemCyclesBalancePrim"
   | SystemCyclesRefundedPrim -> Atom "SystemCyclesRefundedPrim"
   | SystemCyclesBurnPrim -> Atom "SystemCyclesBurnPrim"
+  | ICCyclesPrim      -> Atom "ICCyclesPrim"
   | SetCertifiedData  -> Atom "SetCertifiedData"
   | GetCertificate    -> Atom "GetCertificate"
   | OtherPrim s       -> Atom s
   | CPSAwait (Type.Fut, t) -> "CPSAwait" $$ [typ t]
   | CPSAwait (Type.Cmp, t) -> "CPSAwait*" $$ [typ t]
-  | CPSAsync (Type.Fut, t) -> "CPSAsync" $$ [typ t]
-  | CPSAsync (Type.Cmp, t) -> "CPSAsync*" $$ [typ t]
+  | CPSAsync (Type.Fut, t, par) -> "CPSAsync" $$ [exp par] @ [typ t]
+  | CPSAsync (Type.Cmp, t, _) -> "CPSAsync*" $$ [typ t]
   | ICArgDataPrim     -> Atom "ICArgDataPrim"
   | ICStableSize t    -> "ICStableSize" $$ [typ t]
   | ICPerformGC       -> Atom "ICPerformGC"
   | ICReplyPrim ts    -> "ICReplyPrim" $$ List.map typ ts
   | ICRejectPrim      -> Atom "ICRejectPrim"
   | ICCallerPrim      -> Atom "ICCallerPrim"
-  | ICCallPrim        -> Atom "ICCallPrim"
+  | ICCallPrim e      -> "ICCallPrim" $$ Option.(map exp e |> to_list)
   | ICCallRawPrim     -> Atom "ICCallRawPrim"
   | ICMethodNamePrim  -> Atom "ICMethodNamePrim"
   | ICReplyDeadlinePrim  -> Atom "ICReplyDeadlinePrim"
   | ICStableWrite t   -> "ICStableWrite" $$ [typ t]
   | ICStableRead t    -> "ICStableRead" $$ [typ t]
 
+and empty exp =
+  Type.(is_obj exp.note.Note.typ
+        && (let (s, fls) = as_obj exp.note.Note.typ in
+            s = Object && fls = []))
+
 and mut = function
   | Const -> Atom "Const"
   | Var   -> Atom "Var"

src/ir_def/check_ir.ml

@@ -405,7 +405,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, _FIXMEpars), [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;
@@ -556,6 +556,11 @@ 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
+
+
+    | ICCyclesPrim, [] -> () (* FIXME *)
+
+
     | CPSAwait (s, cont_typ), [a; krb] ->
       let (_, t1) =
         try T.as_async_sub s T.Non (T.normalize (typ a))
@@ -574,7 +579,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
        | _ -> error env exp.at "CPSAwait bad cont");
       check (not (env.flavor.has_await)) "CPSAwait await flavor";
       check (env.flavor.has_async_typ) "CPSAwait in post-async flavor";
-    | CPSAsync (s, t0), [exp] ->
+    | CPSAsync (s, t0, _FIXME), [exp] ->
       (match typ exp with
        | T.Func (T.Local, T.Returns, [tb],
                  T.[Func (Local, Returns, [], ts1, []);
@@ -601,7 +606,8 @@ let rec check_exp env (exp:Ir.exp) : unit =
       T.Non <: t
     | ICCallerPrim, [] ->
       T.caller <: t
-    | ICCallPrim, [exp1; exp2; k; r; c] ->
+    | ICCallPrim setup, [exp1; exp2; k; r; c] ->
+      Option.iter (fun e -> typ e <: T.unit) setup;
       let t1 = T.promote (typ exp1) in
       begin match t1 with
       | T.Func (sort, T.Replies, _ (*TBR*), arg_tys, ret_tys) ->
@@ -684,6 +690,9 @@ let rec check_exp env (exp:Ir.exp) : unit =
     | SystemCyclesAddPrim, [e1] ->
       typ e1 <: T.nat;
       T.unit <: t
+    | SystemTimeoutPrim, [e1] ->
+      typ e1 <: T.nat32;
+      T.unit <: t
     (* Certified Data *)
     | SetCertifiedData, [e1] ->
       typ e1 <: T.blob;
@@ -746,7 +755,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
     check_exp (add_lab env id t0) exp1;
     typ exp1 <: t0;
     t0 <: t
-  | AsyncE (s, tb, exp1, t0) ->
+  | AsyncE (_FIXME, s, tb, exp1, t0) ->
     check env.flavor.has_await "async expression in non-await flavor";
     check_typ env t0;
     let c, tb, ce = check_open_typ_bind env tb in
@@ -805,13 +814,15 @@ 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, exp_c) ->
+  | SelfCallE (cyc, ts, exp_f, exp_k, exp_r, exp_c) ->
     check (not env.flavor.Ir.has_async_typ) "SelfCallE in async flavor";
+    check_exp env cyc;
     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 cyc <: T.(Opt (Obj (Object, [])));
     typ exp_f <: T.unit;
     typ exp_k <: T.(Construct.contT (Tup ts) unit);
     typ exp_r <: T.(Construct.err_contT unit);

src/ir_def/construct.ml

@@ -62,6 +62,8 @@ let tupP pats =
     note = T.Tup (List.map (fun p -> p.note) pats);
     at = no_region }
 
+let tupVarsP vs = List.map varP vs |> tupP
+
 let seqP ps =
   match ps with
   | [p] -> p
@@ -90,10 +92,12 @@ let primE prim es =
     | ICReplyPrim _
     | ICRejectPrim -> T.Non
     | ICCallerPrim -> T.caller
-    | ICStableWrite _ -> T.unit
+    | ICStableWrite _
+    | ICPerformGC
+    | SystemTimeoutPrim
+    | SystemCyclesAddPrim -> T.unit
     | ICStableRead t -> t
     | ICMethodNamePrim -> T.text
-    | ICPerformGC
     | ICStableSize _ -> T.nat64
     | IdxPrim
     | DerefArrayOffset -> T.(as_immut (as_array_sub (List.hd es).note.Note.typ))
@@ -111,9 +115,10 @@ let primE prim es =
     | SystemCyclesBurnPrim -> T.nat
     | DeserializePrim ts -> T.seq ts
     | DeserializeOptPrim ts -> T.Opt (T.seq ts)
+    | ICCyclesPrim -> T.(Opt (Obj (Object, [])))
     | OtherPrim "trap" -> T.Non
     | OtherPrim "global_timer_set" -> T.nat64
-    | OtherPrim "call_perform_status" -> T.(Prim Nat32)
+    | OtherPrim "call_perform_status" -> T.nat32
     | OtherPrim "call_perform_message" -> T.text
     | OtherPrim "array_len"
     | OtherPrim "blob_size"
@@ -152,23 +157,21 @@ let assertE e =
   }
 
 
-let asyncE s typ_bind e typ1 =
-  { it = AsyncE (s, typ_bind, e, typ1);
-    at = no_region;
-    note =
-      Note.{ def with typ = T.Async (s, typ1, typ e);
-                      eff = T.(if s = Fut then Await else Triv) }
-  }
-
 let awaitE s e =
   let (s, _ , typ) = T.as_async (T.normalize (typ e)) in
   { it = PrimE (AwaitPrim s, [e]);
     at = no_region;
     note = Note.{ def with typ; eff = T.Await }
   }
 
-let cps_asyncE s typ1 typ2 e =
-  { it = PrimE (CPSAsync (s, typ1), [e]);
+let nullE () =
+  { it = LitE NullLit;
+    at = no_region;
+    note = Note.{ def with typ = T.(Prim Null) }
+  }
+
+let cps_asyncE s typ1 par typ2 e =
+  { it = PrimE (CPSAsync (s, typ1, if s = T.Fut then par else nullE ()), [e]);
     at = no_region;
     note = Note.{ def with typ = T.Async (s, typ1, typ2); eff = eff e }
   }
@@ -197,10 +200,10 @@ let ic_rejectE e =
     note = Note.{ def with typ = T.unit; eff = eff e }
   }
 
-let ic_callE f e k r c =
+let ic_callE s f e k r c =
   let es = [f; e; k; r; c] in
   let eff = map_max_effs eff es in
-  { it = PrimE (ICCallPrim, es);
+  { it = PrimE (ICCallPrim s, es);
     at = no_region;
     note = Note.{ def with typ = T.unit; eff }
   }
@@ -267,7 +270,7 @@ let blockE decs exp =
 let nat32E n =
   { it = LitE (Nat32Lit n);
     at = no_region;
-    note = Note.{ def with typ = T.(Prim Nat32) }
+    note = Note.{ def with typ = T.nat32 }
   }
 
 let nat64E n =
@@ -306,12 +309,6 @@ let boolE b =
     note = Note.{ def with typ = T.bool }
   }
 
-let nullE () =
-  { it = LitE NullLit;
-    at = no_region;
-    note = Note.{ def with typ = T.Prim T.Null }
-  }
-
 
 (* Functions *)
 
@@ -329,14 +326,24 @@ let funcE name sort ctrl typ_binds args typs exp =
     note = Note.{ def with typ; eff = T.Triv };
   }
 
+let recordE' = ref (fun _ -> nullE ()) (* gets correctly filled below *)
+
+let asyncE s typ_bind e typ1 =
+  { it = AsyncE (None, s, typ_bind, e, typ1);
+    at = no_region;
+    note =
+      Note.{ def with typ = T.Async (s, typ1, typ e);
+                      eff = T.(if s = Fut then Await else Triv) }
+  }
+
 let callE exp1 typs exp2 =
   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
     | _ -> raise (Invalid_argument "callE expect a function")
   in
-  let p = CallPrim typs in
+  let p = CallPrim (typs, !recordE' []) in
   let es = [exp1; exp2] in
   { it = PrimE (p, es);
     at = no_region;
@@ -346,6 +353,10 @@ let callE exp1 typs exp2 =
     }
   }
 
+let parenthetical par = function
+  | { it = PrimE (CallPrim (typs, _), es); _ } as e when true ->
+    { e with it = PrimE (CallPrim (typs, par), es) }
+  | e -> Printf.eprintf "PAR? %s\n" (Wasm.Sexpr.to_string 180 (Arrange_ir.exp e)); e
 
 let ifE exp1 exp2 exp3 =
   { it = IfE (exp1, exp2, exp3);
@@ -368,7 +379,7 @@ let orE : Ir.exp -> Ir.exp -> Ir.exp = fun e1 e2 ->
 let impliesE : Ir.exp -> Ir.exp -> Ir.exp = fun e1 e2 ->
   orE (notE e1) e2
 let oldE : Ir.exp -> Ir.exp = fun e ->
-  { it = (primE (CallPrim [typ e]) [e]).it;
+  { it = (primE (CallPrim ([typ e], !recordE' [])) [e]).it;
     at = no_region;
     note = Note.{ def with
       typ = typ e;
@@ -384,7 +395,7 @@ let dotE exp name typ =
   { it = PrimE (DotPrim name, [exp]);
     at = no_region;
     note = Note.{ def with
-      typ = typ;
+      typ;
       eff = eff exp
     }
   }
@@ -491,6 +502,9 @@ let assignE v exp2 =
     note = Note.{ def with typ = T.unit; eff = eff exp2 };
   }
 
+let assignVarE v exp =
+  assignE (var v T.(Mut (typ exp |> as_immut))) exp
+
 let labelE l typ exp =
   { it = LabelE (l, typ, exp);
     at = no_region;
@@ -799,6 +813,8 @@ let objE sort typ_flds flds =
 
 let recordE flds = objE T.Object [] flds
 
+let _ = recordE' := recordE
+
 let check_call_perform_status success mk_failure =
   ifE
     (callE