loose ends

src/mo_def/arrange.ml

@@ -69,8 +69,8 @@ module Make (Cfg : Config) = struct
     | FromCandidE e       -> "FromCandidE" $$ [exp e]
     | TupE es             -> "TupE"      $$ exps es
     | ProjE (e, i)        -> "ProjE"     $$ [exp e; Atom (string_of_int i)]
-    | ObjBlockE (s, po, nt, dfs) -> "ObjBlockE" $$ [obj_sort s;
-                                                (match po with
+    | ObjBlockE (s, eo, nt, dfs) -> "ObjBlockE" $$ [obj_sort s;
+                                                (match eo with
                                                 |  None -> Atom "_"
                                                 |  Some e -> exp e);
                                                 match nt with
@@ -270,9 +270,11 @@ module Make (Cfg : Config) = struct
     | VarD (x, e) -> "VarD" $$ [id x; exp e]
     | TypD (x, tp, t) ->
       "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t]
-    | ClassD (sp, po, x, tp, p, rt, s, i', dfs) ->
-       "ClassD" $$ shared_pat sp :: id x :: List.map typ_bind tp @ [
-        (match po with None -> Atom "_" | Some e -> exp e);
+    | ClassD (sp, eo, x, tp, p, rt, s, i', dfs) ->
+       "ClassD" $$
+        shared_pat sp ::
+        (match eo with None -> Atom "_" | Some e -> exp e) ::
+        id x :: List.map typ_bind tp @ [
         pat p;
         (match rt with None -> Atom "_" | Some t -> typ t);
         obj_sort s; id i'

src/mo_def/compUnit.ml

@@ -9,14 +9,14 @@ let (@~) it at = Source.annotate Const it at
 let is_actor_def e =
   let open Source in
   match e.it with
-  | AwaitE (Type.Fut, { it = AsyncE (Type.Fut, _, {it = ObjBlockE ({ it = Type.Actor; _}, _po, _t, _fields); _ }) ; _  }) -> true
+  | AwaitE (Type.Fut, { it = AsyncE (Type.Fut, _, {it = ObjBlockE ({ it = Type.Actor; _}, _eo, _t, _fields); _ }) ; _  }) -> true
   | _ -> false
 
 let as_actor_def e =
   let open Source in
   match e.it with
-  | AwaitE (Type.Fut, { it = AsyncE (Type.Fut, _, {it = ObjBlockE ({ it = Type.Actor;_}, po,  _t, fields); note; at }) ; _  }) ->
-    po, fields, note, at
+  | AwaitE (Type.Fut, { it = AsyncE (Type.Fut, _, {it = ObjBlockE ({ it = Type.Actor;_}, eo,  _t, fields); note; at }) ; _  }) ->
+    eo, fields, note, at
   | _ -> assert false
 
 let is_module_def e =
@@ -47,15 +47,15 @@ let comp_unit_of_prog as_lib (prog : prog) : comp_unit =
     | [{it = ExpD e; _} ] when is_actor_def e ->
       let po, fields, note, at = as_actor_def e in
       finish imports { it = ActorU (po, None, fields); note; at }
-    | [{it = ClassD (sp, po, tid, tbs, p, typ_ann, {it = Type.Actor;_}, self_id, fields); _} as d] ->
-      assert (List.length tbs > 0); (* TODO: record _po *)
-      finish imports { it = ActorClassU (sp, po, tid, tbs, p, typ_ann, self_id, fields); note = d.note; at = d.at }
+    | [{it = ClassD (sp, eo, tid, tbs, p, typ_ann, {it = Type.Actor;_}, self_id, fields); _} as d] ->
+      assert (List.length tbs > 0);
+      finish imports { it = ActorClassU (sp, eo, tid, tbs, p, typ_ann, self_id, fields); note = d.note; at = d.at }
     (* let-bound terminal expressions *)
     | [{it = LetD ({it = VarP i1; _}, ({it = ObjBlockE ({it = Type.Module; _}, _po, _t, fields); _} as e), _); _}] when as_lib ->
       finish imports { it = ModuleU (Some i1, fields); note = e.note; at = e.at }
     | [{it = LetD ({it = VarP i1; _}, e, _); _}] when is_actor_def e ->
-      let po, fields, note, at = as_actor_def e in (* TODO: record _po *)
-      finish imports { it = ActorU (po, Some i1, fields); note; at }
+      let eo, fields, note, at = as_actor_def e in
+      finish imports { it = ActorU (eo, Some i1, fields); note; at }
 
     (* Everything else is a program *)
     | ds' ->
@@ -116,8 +116,8 @@ let decs_of_lib (cu : comp_unit) =
   match cub.it with
   | ModuleU (id_opt, fields) ->
     obj_decs Type.Module cub.at cub.note id_opt fields
-  | ActorClassU (csp, po, i, tbs, p, t, i', efs) -> (* TODO : restor po *)
-    [{ it = ClassD (csp, po, i, tbs, p, t,{ it = Type.Actor; at = no_region; note = ()}, i', efs);
+  | ActorClassU (csp, eo, i, tbs, p, t, i', efs) ->
+    [{ it = ClassD (csp, eo, i, tbs, p, t,{ it = Type.Actor; at = no_region; note = ()}, i', efs);
        at = cub.at;
        note = cub.note;}];
   | ProgU _

src/mo_frontend/effect.ml

@@ -99,9 +99,9 @@ let rec infer_effect_exp (exp:Syntax.exp) : T.eff =
     map_max_effs effect_exp exps
   | BlockE decs ->
     map_max_effs effect_dec decs
-  | ObjBlockE (sort, _, _, dfs) ->
-    (* TODO *)
-    infer_effect_dec_fields dfs
+  | ObjBlockE (sort, eo, _, dfs) ->
+    let e = match eo with None -> T.Triv | Some exp -> effect_exp exp in
+    max_eff e (infer_effect_dec_fields dfs)
   | ObjE (bases, efs) ->
     let bases = map_max_effs effect_exp bases in
     let fields = infer_effect_exp_fields efs in

src/mo_frontend/parser.mly

@@ -108,7 +108,7 @@ let is_sugared_func_or_module dec = match dec.it with
   | LetD({it = VarP _; _} as pat, exp, None) ->
     dec.at = pat.at && pat.at = exp.at &&
     (match exp.it with
-     | ObjBlockE (sort, _, _, _) ->
+    | ObjBlockE (sort, _, _, _) ->
       sort.it = Type.Module
     | FuncE _ ->
       true
@@ -207,13 +207,13 @@ let share_dec_field default_stab (df : dec_field) =
     }
 
 
-and objblock s po id ty dec_fields =
+and objblock s eo id ty dec_fields =
   List.iter (fun df ->
     match df.it.vis.it, df.it.dec.it with
     | Public _, ClassD (_, _, id, _, _, _, _, _, _) when is_anon_id id ->
       syntax_error df.it.dec.at "M0158" "a public class cannot be anonymous, please provide a name"
     | _ -> ()) dec_fields;
-  ObjBlockE(s, po, (id, ty), dec_fields)
+  ObjBlockE(s, eo, (id, ty), dec_fields)
 
 %}
 
@@ -377,7 +377,7 @@ seplist1(X, SEP) :
 
 %inline obj_sort :
   | OBJECT { (false, Type.Object @@ at $sloc, None) }
-  | po=persistent ACTOR m=migration { (po, Type.Actor @@ at $sloc, m) }
+  | po=persistent ACTOR eo=migration { (po, Type.Actor @@ at $sloc, eo) }
   | MODULE { (false, Type.Module @@ at $sloc, None) }
 
 %inline obj_sort_opt :
@@ -891,7 +891,7 @@ dec_nonvar :
   | TYPE x=typ_id tps=type_typ_params_opt EQ t=typ
     { TypD(x, tps, t) @? at $sloc }
   | ds=obj_sort xf=id_opt t=annot_opt EQ? efs=obj_body
-    { let (persistent, s, po) = ds in
+    { let (persistent, s, eo) = ds in
       let sort = Type.(match s.it with
                        | Actor -> "actor" | Module -> "module" | Object -> "object"
                        | _ -> assert false) in
@@ -903,9 +903,9 @@ dec_nonvar :
           AwaitE
             (Type.Fut,
              AsyncE(Type.Fut, scope_bind (anon_id "async" (at $sloc)) (at $sloc),
-                    objblock s po id t (List.map (share_dec_field default_stab) efs) @? at $sloc)
+                    objblock s eo id t (List.map (share_dec_field default_stab) efs) @? at $sloc)
              @? at $sloc) @? at $sloc
-        else objblock s po None t efs @? at $sloc
+        else objblock s eo None t efs @? at $sloc
       in
       let_or_exp named x e.it e.at }
   | sp=shared_pat_opt FUNC xf=id_opt
@@ -999,7 +999,7 @@ parse_stab_sig :
     { let trivia = !triv_table in
       let sigs = Single sfs in
       fun filename -> {
-          it = (ds, {it=sigs; at = at $sloc; note = ()});
+          it = (ds, {it = sigs; at = at $sloc; note = ()});
           at = at $sloc;
           note =
           { filename; trivia }}
@@ -1009,10 +1009,10 @@ parse_stab_sig :
              LCURLY sfs_post=seplist(stab_field, semicolon) RCURLY  RPAR
     { let trivia = !triv_table in
       let sigs = PrePost(sfs_pre, sfs_post) in
-      fun filename -> {
-          it = (ds, {it=sigs; at = at $sloc; note = ()});
+      fun filename ->
+        { it = (ds, {it = sigs; at = at $sloc; note = ()});
           at = at $sloc;
-          note = { filename; trivia }}
+          note = { filename; trivia } }
     }
 
 %%

src/mo_frontend/static.ml

@@ -44,8 +44,10 @@ let rec exp m e = match e.it with
       | Const ->  List.iter (exp m) es
       | Var -> err m e.at
     end
-  | ObjBlockE (_, _eo, _, dfs) -> dec_fields m dfs (* TODO eo *)
-  | ObjE (bases, efs) -> List.iter (exp m) bases; exp_fields m efs
+  | ObjBlockE (_, eo, _, dfs) ->
+    Option.iter (exp m) eo; dec_fields m dfs
+  | ObjE (bases, efs) ->
+    List.iter (exp m) bases; exp_fields m efs
 
   (* Variable access. Dangerous, due to loops. *)
   | (VarE _ | ImportE _) -> ()

src/mo_interpreter/interpret.ml

@@ -491,8 +491,8 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
       | _ -> assert false)
   | ProjE (exp1, n) ->
     interpret_exp env exp1 (fun v1 -> k (List.nth (V.as_tup v1) n))
-  | ObjBlockE (obj_sort, exp_opt, (self_id_opt, _), dec_fields) ->
-     (*TODO*)
+  | ObjBlockE (obj_sort, _exp_opt, (self_id_opt, _), dec_fields) ->
+    (* NB: we ignore the migration expression _exp_opt *)
     interpret_obj env obj_sort.it self_id_opt dec_fields k
   | ObjE (exp_bases, exp_fields) ->
     let fields fld_env = interpret_exp_fields env exp_fields fld_env (fun env -> k (V.Obj env)) in
@@ -978,7 +978,7 @@ and interpret_dec env dec (k : V.value V.cont) =
   | TypD _ ->
     k V.unit
   | ClassD (shared_pat, _eo, id, _typbinds, pat, _typ_opt, obj_sort, id', dec_fields) ->
-    (* TODO _eo *)
+    (* NB: we ignore the migration expression _eo *)
     let f = interpret_func env id.it shared_pat pat (fun env' k' ->
       if obj_sort.it <> T.Actor then
         let env'' = adjoin_vals env' (declare_id id') in
@@ -1091,7 +1091,7 @@ let import_lib env lib =
   | Syntax.ModuleU _ ->
     Fun.id
   | Syntax.ActorClassU (_sp, _eo, id, _tbs, _p, _typ, _self_id, _dec_fields) ->
-    (* TODO eo *)
+    (* NB: we ignore the migration expression _eo *)
     fun v -> V.Obj (V.Env.from_list
       [ (id.it, v);
         ("system",