Kill Shared type

samples/app/server.as

@@ -29,7 +29,7 @@ actor class Server() = {
     nextId += 1;
     let cs = new {head = c; var tail = clients};
     clients := ?cs;
-    return (shared {
+    return (new {
       post = shared func(message : Text) {
         if (not c.revoked) broadcast(c.id, message);
       };

samples/app/types.as

@@ -1,6 +1,4 @@
-type Subscription = shared {
+type Subscription = {
   post : shared Text -> ();  // revokable by Server
   cancel : shared () -> ();
 };
-
-

src/as_def/arrange.ml

@@ -27,7 +27,7 @@ let rec exp e = match e.it with
   | FuncE (x, s, tp, p, t, e') ->
     "FuncE" $$ [
       Atom (Type.string_of_typ e.note.note_typ);
-      Atom (Arrange_type.sharing s.it);
+      func_sort s;
       Atom x] @
       List.map typ_bind tp @ [
       pat p;
@@ -97,7 +97,14 @@ and case c = "case" $$ [pat c.it.pat; exp c.it.exp]
 
 and pat_field pf = pf.it.id.it $$ [pat pf.it.pat]
 
-and obj_sort s = Arrange_type.obj_sort s.it
+and obj_sort s = match s.it with
+  | Type.Object -> Atom "Object"
+  | Type.Actor -> Atom "Actor"
+  | Type.Module -> Atom "Module"
+
+and func_sort s = match s.it with
+  | Type.Local -> Atom "Local"
+  | Type.Shared -> Atom "Shared"
 
 and mut m = match m.it with
   | Const -> Atom "Const"
@@ -133,7 +140,7 @@ and typ t = match t.it with
   | OptT t              -> "OptT" $$ [typ t]
   | VariantT cts        -> "VariantT" $$ List.map typ_tag cts
   | TupT ts             -> "TupT" $$ List.map typ ts
-  | FuncT (s, tbs, at, rt) -> "FuncT" $$ [Atom (Arrange_type.sharing s.it)] @ List.map typ_bind tbs @ [ typ at; typ rt]
+  | FuncT (s, tbs, at, rt) -> "FuncT" $$ [func_sort s] @ List.map typ_bind tbs @ [ typ at; typ rt]
   | AsyncT t            -> "AsyncT" $$ [typ t]
   | ParT t              -> "ParT" $$ [typ t]
 

src/as_def/syntax.ml

@@ -19,8 +19,8 @@ type typ_id = (string, Type.con option) Source.annotated_phrase
 
 (* Types *)
 
-type sharing = Type.sharing Source.phrase
 type obj_sort = Type.obj_sort Source.phrase
+type func_sort = Type.func_sort Source.phrase
 
 type mut = mut' Source.phrase
 and mut' = Const | Var
@@ -39,7 +39,7 @@ and typ' =
   | OptT of typ                                    (* option *)
   | VariantT of typ_tag list                       (* variant *)
   | TupT of typ list                               (* tuple *)
-  | FuncT of sharing * typ_bind list * typ * typ   (* function *)
+  | FuncT of func_sort * typ_bind list * typ * typ (* function *)
   | AsyncT of typ                                  (* future *)
   | ParT of typ                                    (* parentheses, used to control function arity only *)
 
@@ -126,7 +126,7 @@ and exp' =
   | AssignE of exp * exp                       (* assignment *)
   | ArrayE of mut * exp list                   (* array *)
   | IdxE of exp * exp                          (* array indexing *)
-  | FuncE of string * sharing * typ_bind list * pat * typ option * exp  (* function *)
+  | FuncE of string * func_sort * typ_bind list * pat * typ option * exp  (* function *)
   | CallE of exp * typ list * exp              (* function call *)
   | BlockE of dec list                         (* block (with type after avoidance)*)
   | NotE of exp                                (* negation *)

src/as_frontend/parser.mly

@@ -66,10 +66,8 @@ let let_or_exp named x e' at =
 
 let share_typ t =
   match t.it with
-  | ObjT ({it = Type.Object Type.Local; _} as s, tfs) ->
-    { t with it = ObjT ({s with it = Type.Object Type.Sharable}, tfs)}
   | FuncT ({it = Type.Local; _} as s, tbs, t1, t2) ->
-    { t with it = FuncT ({s with it = Type.Sharable}, tbs, t1, t2)}
+    { t with it = FuncT ({s with it = Type.Shared}, tbs, t1, t2)}
   | _ -> t
 
 let share_typfield (tf : typ_field) =
@@ -78,7 +76,7 @@ let share_typfield (tf : typ_field) =
 let share_exp e =
   match e.it with
   | FuncE (x, ({it = Type.Local; _} as s), tbs, p, t, e) ->
-    FuncE (x, {s with it = Type.Sharable}, tbs, p, t, e) @? e.at
+    FuncE (x, {s with it = Type.Shared}, tbs, p, t, e) @? e.at
   | _ -> e
 
 let share_dec d =
@@ -182,23 +180,18 @@ seplist(X, SEP) :
   | VAR { Var @@ at $sloc }
 
 %inline obj_sort :
-  | NEW { Type.Object Type.Local @@ at $sloc }
-  | OBJECT { Type.Object Type.Local @@ at $sloc }
-  | SHARED { Type.Object Type.Sharable @@ at $sloc }
+  | NEW { Type.Object @@ at $sloc }
+  | OBJECT { Type.Object @@ at $sloc }
   | ACTOR { Type.Actor @@ at $sloc }
   | MODULE { Type.Module @@ at $sloc }
 
 %inline obj_sort_opt :
-  | (* empty *) { Type.Object Type.Local @@ no_region }
+  | (* empty *) { Type.Object @@ no_region }
   | s=obj_sort { s }
 
-%inline shared_opt :
-  | (* empty *) { Type.Local @@ no_region }
-  | SHARED { Type.Sharable @@ at $sloc }
-
 %inline func_sort_opt :
   | (* empty *) { Type.Local @@ no_region }
-  | SHARED { Type.Sharable @@ at $sloc }
+  | SHARED { Type.Shared @@ at $sloc }
 
 (* paths *)
 
@@ -230,7 +223,7 @@ typ_nullary :
   | LBRACKET m=var_opt t=typ RBRACKET
     { ArrayT(m, t) @! at $sloc }
   | tfs=typ_obj
-    { ObjT(Type.Object Type.Local @@ at $sloc, tfs) @! at $sloc }
+    { ObjT(Type.Object @@ at $sloc, tfs) @! at $sloc }
   | tfs=typ_variant
     { VariantT tfs @! at $sloc }
 
@@ -249,9 +242,7 @@ typ_pre :
     { AsyncT(t) @! at $sloc }
   | s=obj_sort tfs=typ_obj
     { let tfs' =
-        if s.it = Type.Object Type.Local || s.it = Type.Module
-        then tfs
-        else List.map share_typfield tfs
+        if s.it = Type.Actor then List.map share_typfield tfs else tfs
       in ObjT(s, tfs') @! at $sloc }
 
 typ :
@@ -495,7 +486,7 @@ exp_field :
   | v=private_opt x=id EQ e=exp
     { let d = LetD(VarP(x) @! x.at, e) @? at $sloc in
       {dec = d; vis = v} @@ at $sloc }
-  | v=private_opt s=shared_opt x=id fe=func_exp
+  | v=private_opt s=func_sort_opt x=id fe=func_exp
     { let d = LetD(VarP(x) @! x.at, fe s x.it) @? at $sloc in
       {dec = d; vis = v} @@ at $sloc }
   (* TODO(andreas): allow any dec *)
@@ -582,19 +573,15 @@ dec_nonvar :
   | s=obj_sort xf=id_opt EQ? efs=obj_body
     { let named, x = xf "object" $sloc in
       let efs' =
-        if s.it = Type.Object Type.Local || s.it = Type.Module
-        then efs
-        else List.map share_expfield efs
+        if s.it = Type.Actor then List.map share_expfield efs else efs
       in let_or_exp named x (ObjE(s, efs')) (at $sloc) }
-  | s=shared_opt FUNC xf=id_opt fe=func_exp
+  | s=func_sort_opt FUNC xf=id_opt fe=func_exp
     { let named, x = xf "func" $sloc in
       let_or_exp named x (fe s x.it).it (at $sloc) }
   | s=obj_sort_opt CLASS xf=typ_id_opt tps=typ_params_opt p=pat_argument xefs=class_body
     { let x, efs = xefs in
       let efs' =
-        if s.it = Type.Object Type.Local || s.it = Type.Module
-        then efs
-        else List.map share_expfield efs
+        if s.it = Type.Actor then List.map share_expfield efs else efs
       in ClassD(xf "class" $sloc, tps, s, p, x, efs') @? at $sloc }
   | IMPORT xf=id_opt EQ? f=TEXT
     { let named, x = xf "import" $sloc in

src/as_frontend/typing.ml

@@ -126,7 +126,7 @@ let rec check_obj_path env path : T.obj_sort * (T.field list) =
     (s, fs)
   | t ->
     error env path.at
-      "expected actor, object or module type, but path expression produces type\n  %s"
+      "expected module, object, or actor type, but path expression produces type\n  %s"
       (T.string_of_typ_expand t)
 
 and check_obj_path' env path : T.typ =
@@ -180,7 +180,6 @@ and check_typ' env typ : T.typ =
     T.Con (c, ts)
   | PrimT "Any" -> T.Any
   | PrimT "None" -> T.Non
-  | PrimT "Shared" -> T.Shared
   | PrimT s ->
     (try T.Prim (T.prim s) with Invalid_argument _ ->
       error env typ.at "unknown primitive type"
@@ -198,20 +197,15 @@ and check_typ' env typ : T.typ =
     let ts1 = List.map (check_typ env') typs1 in
     let ts2 = List.map (check_typ env') typs2 in
     let c = match typs2 with [{it = AsyncT _; _}] -> T.Promises | _ -> T.Returns in
-    if sort.it = T.Sharable then
+    if sort.it = T.Shared then
     if not env.pre then begin
       let t1 = T.seq ts1 in
-      if not (T.sub t1 T.Shared) then
+      if not (T.shared t1) then
         error env typ1.at
           "shared function has non-shared parameter type\n  %s"
           (T.string_of_typ_expand t1);
       match ts2 with
-      | [] -> ()
-      | [T.Async t2] ->
-        if not (T.sub t2 T.Shared) then
-          error env typ2.at
-            "shared function has non-shared result type\n  %s"
-            (T.string_of_typ_expand t2);
+      | [] | [T.Async _] -> ()
       | _ ->
         error env typ2.at
           "shared function has non-async result type\n  %s"
@@ -228,8 +222,8 @@ and check_typ' env typ : T.typ =
     T.Variant (List.sort T.compare_field fs)
   | AsyncT typ ->
     let t = check_typ env typ in
-    if not env.pre && not (T.sub t T.Shared) then
-      error env typ.at "async type has non-shared parameter type\n  %s"
+    if not env.pre && not (T.shared t) then
+      error env typ.at "async has non-shared content type\n  %s"
         (T.string_of_typ_expand t);
     T.Async t
   | ObjT (sort, fields) ->
@@ -243,13 +237,12 @@ and check_typ' env typ : T.typ =
 and check_typ_field env s typ_field : T.field =
   let {id; mut; typ} = typ_field.it in
   let t = infer_mut mut (check_typ env typ) in
-  if not env.pre then begin
-    if s = T.Actor && not (T.is_func (T.promote t)) then
+  if not env.pre && s = T.Actor then begin
+    if not (T.is_func (T.promote t)) then
       error env typ.at "actor field %s has non-function type\n  %s"
         id.it (T.string_of_typ_expand t);
-    if s <> T.Object T.Local && not (T.sub t T.Shared) then
-      error env typ.at
-        "shared object or actor field %s has non-shared type\n  %s"
+    if not (T.shared t) then
+      error env typ.at "actor field %s has non-shared type\n  %s"
         id.it (T.string_of_typ_expand t)
   end;
   T.{lab = id.it; typ = t}
@@ -406,12 +399,12 @@ let array_obj t =
     ] in
   let mut t = immut t @
     [ {lab = "set"; typ = Func (Local, Returns, [], [Prim Nat; t], [])} ] in
-  Object Local,
+  Object,
   List.sort compare_field (match t with Mut t' -> mut t' | t -> immut t)
 
 let text_obj () =
   let open T in
-  Object Local,
+  Object,
   [ {lab = "chars"; typ = Func (Local, Returns, [], [], [iter_obj (Prim Char)])};
     {lab = "len";  typ = Func (Local, Returns, [], [], [Prim Nat])};
   ]
@@ -600,29 +593,17 @@ and infer_exp'' env exp : T.typ =
       let env'' =
         {env' with labs = T.Env.empty; rets = Some t2; async = false} in
       check_exp (adjoin_vals env'' ve) t2 exp;
-      if sort.it = T.Sharable then begin
-        if not (T.sub t1 T.Shared) then
+      if sort.it = T.Shared then begin
+        if not (T.shared t1) then
           error env pat.at
             "shared function has non-shared parameter type\n  %s"
             (T.string_of_typ_expand t1);
-        if not (T.concrete t1) then
-          error env pat.at
-            "shared function parameter contains abstract type\n  %s"
-            (T.string_of_typ_expand t1);
         match t2 with
         | T.Tup [] -> ()
-        | T.Async t2 ->
-          if not (T.sub t2 T.Shared) then
-            error env typ.at
-              "shared function has non-shared result type\n  %s"
-              (T.string_of_typ_expand t2);
-          if not (T.concrete t2) then
-            error env typ.at
-              "shared function result contains abstract type\n  %s"
-              (T.string_of_typ_expand t2);
+        | T.Async _ ->
           if not (isAsyncE exp) then
             error env exp.at
-              "shared function with async type has non-async body"
+              "shared function with async result type has non-async body"
         | _ ->
           error env typ.at "shared function has non-async result type\n  %s"
             (T.string_of_typ_expand t2)
@@ -632,7 +613,7 @@ and infer_exp'' env exp : T.typ =
     let ts2 = match typ.it with TupT _ -> T.as_seq t2 | _ -> [t2] in
     let c =
       match sort.it, typ.it with
-      | T.Sharable, (AsyncT _) -> T.Promises  (* TBR: do we want this for T.Local too? *)
+      | T.Shared, (AsyncT _) -> T.Promises  (* TBR: do we want this for T.Local too? *)
       | _ -> T.Returns
     in
     let tbs = List.map2 (fun c t -> {T.var = Con.name c; bound = T.close cs t}) cs ts in
@@ -651,7 +632,7 @@ and infer_exp'' env exp : T.typ =
     let t_ret = T.open_ ts t_ret in
     if not env.pre then begin
       check_exp env t_arg exp2;
-      if sort = T.Sharable then begin
+      if sort = T.Shared then begin
         if not (T.concrete t_arg) then
           error env exp1.at
             "shared function argument contains abstract type\n  %s"
@@ -777,8 +758,8 @@ and infer_exp'' env exp : T.typ =
     let env' =
       {env with labs = T.Env.empty; rets = Some T.Pre; async = true} in
     let t = infer_exp env' exp1 in
-    if not (T.sub t T.Shared) then
-      error env exp1.at "async type has non-shared parameter type\n  %s"
+    if not (T.shared t) then
+      error env exp1.at "async type has non-shared content type\n  %s"
         (T.string_of_typ_expand t);
     T.Async t
   | AwaitE exp1 ->
@@ -1004,7 +985,7 @@ and infer_pats at env pats ts ve : T.typ list * Scope.val_env =
 
 and infer_pat_fields at env pfs ts ve : (T.obj_sort * T.field list) * Scope.val_env =
   match pfs with
-  | [] -> (T.(Object Local), List.rev ts), ve
+  | [] -> (T.Object, List.rev ts), ve
   | pf::pfs' ->
     let typ, ve1 = infer_pat env pf.it.pat in
     let ve' = disjoint_union env at "duplicate binding for %s in pattern" ve ve1 in
@@ -1275,19 +1256,20 @@ and infer_obj env s fields at : T.typ =
   let t = object_of_scope env s fields scope at in
   let (_, tfs) = T.as_obj t in
   if not env.pre then begin
-    if s = T.Object T.Sharable || s = T.Actor then
+    if s = T.Actor then
       List.iter (fun T.{lab; typ} ->
-          if  (not (T.is_typ typ)) && not (T.sub typ T.Shared) then
-            let _, pub_val = pub_fields fields in
-            error env (T.Env.find lab pub_val)
-              "public shared object or actor field %s has non-shared type\n  %s"
-              lab (T.string_of_typ_expand typ)
-        ) tfs;
+        if not (T.is_typ typ) && not (T.shared typ) then
+          let _, pub_val = pub_fields fields in
+          error env (T.Env.find lab pub_val)
+            "public actor field %s has non-shared type\n  %s"
+            lab (T.string_of_typ_expand typ)
+      ) tfs;
     if s = T.Actor then
       List.iter (fun ef ->
-          if ef.it.vis.it = Syntax.Public && not (is_actor_method ef.it.dec) && not (is_typ_dec ef.it.dec) then
-            local_error env ef.it.dec.at "public actor field needs to be a manifest function"
-        ) fields;
+        if ef.it.vis.it = Syntax.Public && not (is_actor_method ef.it.dec) && not (is_typ_dec ef.it.dec) then
+          local_error env ef.it.dec.at
+            "public actor field needs to be a manifest function"
+      ) fields;
     if s = T.Module then Static.fields env.msgs fields
   end;
   t

src/as_interpreter/interpret.ml

@@ -175,7 +175,7 @@ let make_unit_message env id v =
   let open CC in
   let call_conv, f = V.as_func v in
   match call_conv with
-  | {sort = T.Sharable; n_res = 0; _} ->
+  | {sort = T.Shared; n_res = 0; _} ->
     Value.message_func call_conv.n_args (fun v k ->
       actor_msg env id f v (fun _ -> ());
       k V.unit
@@ -187,7 +187,7 @@ let make_async_message env id v =
   let open CC in
   let call_conv, f = V.as_func v in
   match call_conv with
-  | {sort = T.Sharable; control = T.Promises; n_res = 1; _} ->
+  | {sort = T.Shared; control = T.Promises; n_res = 1; _} ->
     Value.async_func call_conv.n_args (fun v k ->
       let async = make_async () in
       actor_msg env id f v (fun v_async ->
@@ -438,7 +438,7 @@ and interpret_exp_mut env exp (k : V.value V.cont) =
     let v = V.Func (CC.call_conv_of_typ exp.note.note_typ, f) in
     let v' =
       match _sort.it with
-      | T.Sharable -> make_message env name exp.note.note_typ v
+      | T.Shared -> make_message env name exp.note.note_typ v
       | T.Local -> v
     in k v'
   | CallE (exp1, typs, exp2) ->