Remove the Class type

README.md

@@ -187,9 +187,6 @@ and open the path printed on the last line of that command.
 * Async types: like futures/promises
   - `async T`
 
-* Class types: the identity of a class (essentially, a modref)
-  - `class`
-
 * Like types: structural expansions of nominal types
   - `like T`
 

design/Syntax.md

@@ -10,7 +10,7 @@ Productions marked * probably deferred to later versions.
   (shared|actor)? { <typ-field>;* }             object
   [ var? <typ> ]                                array
   ? <typ>                                       option
-  (shared|class)? <typ-params>? <typ> -> <typ>  function
+  shared <typ-params>? <typ> -> <typ>  function
   async <typ>                                   future
   ( ((<id> :)? <typ>),* )                       tuple
   Any                                           top

src/arrange.ml

@@ -111,10 +111,6 @@ and obj_sort' s = match s with
 
 and obj_sort s = obj_sort' s.it
 
-and func_sort s = match s.it with
-  | Type.Call sh -> Atom ("Call " ^ sharing sh)
-  | Type.Construct -> Atom "Construct"
-
 and mut m = match m.it with
   | Const -> Atom "Const"
   | Var   -> Atom "Var"
@@ -141,7 +137,7 @@ and typ t = match t.it with
   | ArrayT (m, t)       -> "ArrayT" $$ [mut m; typ t]
   | OptT t              -> "OptT" $$ [typ t]
   | TupT ts             -> "TupT" $$ List.map typ ts
-  | FuncT (s, tbs, at, rt) -> "FuncT" $$ [func_sort s] @ List.map typ_bind tbs @ [ typ at; typ rt]
+  | FuncT (s, tbs, at, rt) -> "FuncT" $$ [Atom (sharing s.it)] @ List.map typ_bind tbs @ [ typ at; typ rt]
   | AsyncT t            -> "AsyncT" $$ [typ t]
   | ParT t              -> "ParT" $$ [typ t]
 

src/arrange_type.ml

@@ -6,23 +6,19 @@ let ($$) head inner = Node (head, inner)
 
 let id i = Atom i.it
 
-let rec sharing sh = match sh with
+let sharing sh = match sh with
   | Type.Local -> "Local"
   | Type.Sharable -> "Sharable"
 
-and control c = match c with
+let control c = match c with
   | Type.Returns -> "Returns"
   | Type.Promises -> "Promises"
 
-and obj_sort s = match s with
+let obj_sort s = match s with
   | Type.Object sh -> Atom ("Object " ^ sharing sh)
   | Type.Actor -> Atom "Actor"
 
-and func_sort s = match s with
-  | Type.Call sh -> Atom ("Call " ^ sharing sh)
-  | Type.Construct -> Atom "Construct"
-
-and prim p = match p with
+let prim p = match p with
   | Null -> Atom "Null"
   | Bool -> Atom "Bool"
   | Nat -> Atom "Nat"
@@ -35,7 +31,7 @@ and prim p = match p with
   | Char -> Atom "Char"
   | Text -> Atom "Text"
 
-and con c = Atom (Con.to_string c)
+let con c = Atom (Con.to_string c)
 
 let rec typ (t:Type.typ) = match t with
   | Var (s, i)             -> "Var" $$ [Atom s; Atom (string_of_int i)]
@@ -45,10 +41,9 @@ let rec typ (t:Type.typ) = match t with
   | Array t                -> "Array" $$ [typ t]
   | Opt t                  -> "Opt" $$ [typ t]
   | Tup ts                 -> "Tup" $$ List.map typ ts
-  | Func (s, c, tbs, at, rt) -> "Func" $$ [func_sort s; Atom (control c)] @ List.map typ_bind tbs @ [ "" $$ (List.map typ at); "" $$ (List.map typ rt)]
+  | Func (s, c, tbs, at, rt) -> "Func" $$ [Atom (sharing s); Atom (control c)] @ List.map typ_bind tbs @ [ "" $$ (List.map typ at); "" $$ (List.map typ rt)]
   | Async t               -> "Async" $$ [typ t]
   | Mut t                 -> "Mut" $$ [typ t]
-  | Class                 -> Atom "Class"
   | Shared                -> Atom "Shared"
   | Any                   -> Atom "Any"
   | Non                   -> Atom "Non"

src/async.ml

@@ -19,21 +19,23 @@ let unary typ = [typ]
 
 let nary typ = T.as_seq typ
 
-let replyT as_seq typ = T.Func(T.Call T.Sharable, T.Returns, [], as_seq typ, [])
+let replyT as_seq typ = T.Func(T.Sharable, T.Returns, [], as_seq typ, [])
 
-let fullfillT as_seq typ = T.Func(T.Call T.Local, T.Returns, [], as_seq typ, [])
+let fullfillT as_seq typ = T.Func(T.Local, T.Returns, [], as_seq typ, [])
 
 let t_async as_seq t =
-  T.Func (T.Call T.Local, T.Returns, [], [T.Func(T.Call T.Local, T.Returns, [],as_seq t,[])], [])
+  T.Func (T.Local, T.Returns, [], [T.Func(T.Local, T.Returns, [],as_seq t,[])], [])
 
 let new_async_ret as_seq t = [t_async as_seq t;fullfillT as_seq t]
 
 let new_asyncT =
-   T.Func(T.Call T.Local,T.Returns,
-                          [ { var = "T";
-                              bound = T.Shared } ],
-                          [],
-                          new_async_ret unary (T.Var ("T", 0)))
+  T.Func (
+    T.Local,
+    T.Returns,
+    [ { var = "T"; bound = T.Shared } ],
+    [],
+    new_async_ret unary (T.Var ("T", 0))
+  )
 
 let new_asyncE =
   idE ("@new_async"@@no_region) new_asyncT
@@ -92,7 +94,7 @@ let letEta e scope =
 
 let isAwaitableFunc exp =
   match typ exp with
-  | T.Func (T.Call T.Sharable,T.Promises,_,_,[T.Async _]) -> true
+  | T.Func (T.Sharable,T.Promises,_,_,[T.Async _]) -> true
   | _ -> false
 
 let extendTup ts t2 = ts @ [t2]
@@ -137,7 +139,7 @@ let rec t_typ (t:T.typ) =
   | Func (s, c, tbs, t1, t2) ->
      begin
        match s with
-       |  T.Call T.Sharable ->
+       |  T.Sharable ->
          begin
            match t2 with
            | [] ->
@@ -156,7 +158,6 @@ let rec t_typ (t:T.typ) =
   | Async t -> t_async nary (t_typ t)
   | Obj (s, fs) -> Obj (s, List.map t_field  fs)
   | Mut t -> Mut (t_typ t)
-  | Class -> Class
   | Shared -> Shared
   | Any -> Any
   | Non -> Non
@@ -235,7 +236,7 @@ and t_exp' (exp:exp) =
       | t -> assert false in
     let k = fresh_id contT in
     let v1 = fresh_id t1 in
-    let post = fresh_id (T.Func(T.Call T.Sharable,T.Returns,[],[],[])) in
+    let post = fresh_id (T.Func(T.Sharable,T.Returns,[],[],[])) in
     let u = fresh_id T.unit in
     let ((nary_async,nary_reply),def) = new_nary_async_reply t1 in
     (blockE [letP (tupP [varP nary_async; varP nary_reply]) def;
@@ -247,7 +248,7 @@ and t_exp' (exp:exp) =
   | CallE (cc,exp1, typs, exp2) when isAwaitableFunc exp1 ->
     let ts1,t2 =
       match typ exp1 with
-      | T.Func (T.Call T.Sharable,T.Promises,tbs,ts1,[T.Async t2]) ->
+      | T.Func (T.Sharable,T.Promises,tbs,ts1,[T.Async t2]) ->
            List.map t_typ ts1, t_typ t2
       | _ -> assert(false)
     in
@@ -315,10 +316,9 @@ and t_dec' dec' =
     let s = cc.Value.sort in
     begin
       match s with
-      | T.Construct
-      | T.Call T.Local  ->
+      | T.Local  ->
          FuncD (cc, id, t_typ_binds typbinds, t_pat pat, t_typ typT, t_exp exp)
-      | T.Call T.Sharable ->
+      | T.Sharable ->
          begin
            match typ exp with
            | T.Tup [] ->

src/awaitopt.ml

@@ -284,7 +284,7 @@ and c_loop_some context k e1 e2 =
 
 and c_for context k pat e1 e2 =
   let v1 = fresh_id (typ e1) in
-  let next_typ = (T.Func(T.Call T.Local, T.Returns, [], [], [T.Opt pat.note])) in
+  let next_typ = (T.Func(T.Local, T.Returns, [], [], [T.Opt pat.note])) in
   let dotnext v = dotE v nextN next_typ -*- unitE in
   let loop = fresh_id (contT T.unit) in
   let v2 = fresh_id T.unit in

src/check_ir.ml

@@ -142,7 +142,6 @@ let rec check_typ env typ : unit =
   | T.Any -> ()
   | T.Non -> ()
   | T.Shared -> ()
-  | T.Class -> ()
   | T.Prim _ -> ()
   | T.Array typ ->
     check_typ env typ
@@ -164,7 +163,7 @@ let rec check_typ env typ : unit =
         error env no_region "promising function with non-async result type \n  %s"
           (T.string_of_typ_expand env'.cons t2)
     end;
-    if sort = T.Call T.Sharable then begin
+    if sort = T.Sharable then begin
       let t1 = T.seq ts1 in
       check_sub env' no_region t1 T.Shared;
       match ts2 with
@@ -723,7 +722,7 @@ and check_dec env dec  =
     let env' = adjoin_typs env ce in
     let ve = check_pat_exhaustive env' pat in
     check_typ env' t2;
-    check ((cc.Value.sort = T.Call T.Sharable && Type.is_async t2)
+    check ((cc.Value.sort = T.Sharable && Type.is_async t2)
            ==> isAsyncE exp)
       "shared function with async type has non-async body";
     let env'' =
@@ -790,7 +789,7 @@ and gather_dec env scope dec : scope =
       | _ -> T.as_seq t2
     in
     let c = match func_sort, t2 with
-      | T.Call T.Sharable, (T.Async _) -> T.Promises  (* TBR: do we want this for T.Local too? *)
+      | T.Sharable, (T.Async _) -> T.Promises  (* TBR: do we want this for T.Local too? *)
       | _ -> T.Returns
     in
     let ts = List.map (fun typbind -> typbind.it.T.bound) typ_binds in

src/compile.ml

@@ -941,7 +941,7 @@ module AllocHow = struct
       | VarD _ ->
       map_of_set LocalMut d
       (* Messages cannot be static *)
-      | FuncD (cc, _, _, _, _, _) when cc.Value.sort = Type.Call Type.Sharable ->
+      | FuncD (cc, _, _, _, _, _) when cc.Value.sort = Type.Sharable ->
       map_of_set LocalImmut d
       (* Static functions *)
       | FuncD _ when is_static env how0 f ->
@@ -1128,7 +1128,6 @@ module Object = struct
     in the await-translation of objects, and get rid of this indirection.
   *)
 
-  (* First word: Class pointer (0x1, an invalid pointer, when none) *)
   let header_size = Int32.add Tagged.header_size 1l
 
   (* Number of object fields *)
@@ -2803,7 +2802,7 @@ module FuncDec = struct
 
   (* Compile a closure declaration (has free variables) *)
   let dec_closure pre_env cc h name captured mk_pat mk_body at =
-      let is_local = cc.Value.sort <> Type.Call Type.Sharable in
+      let is_local = cc.Value.sort <> Type.Sharable in
 
       let (set_li, get_li) = new_local pre_env (name.it ^ "_clos") in
       let (pre_env1, alloc_code0) = AllocHow.add_how pre_env name.it h in
@@ -2893,7 +2892,7 @@ module FuncDec = struct
         Var.set_val env name.it)
 
   let dec pre_env how name cc captured mk_pat mk_body at =
-    let is_local = cc.Value.sort <> Type.Call Type.Sharable in
+    let is_local = cc.Value.sort <> Type.Sharable in
 
     if not is_local && E.mode pre_env <> DfinityMode
     then
@@ -3351,15 +3350,15 @@ and compile_exp (env : E.t) exp =
         compile_unboxed_zero ^^ (* A dummy closure *)
         compile_exp_as env (StackRep.of_arity cc.Value.n_args) e2 ^^ (* the args *)
         G.i (Call (nr fi))
-     | None, (Type.Call Type.Local | Type.Construct) ->
+     | None, Type.Local ->
         let (set_clos, get_clos) = new_local env "clos" in
         compile_exp_vanilla env e1 ^^
         set_clos ^^
         get_clos ^^
         compile_exp_as env (StackRep.of_arity cc.Value.n_args) e2 ^^
         get_clos ^^
         Closure.call_closure env cc
-     | None, Type.Call Type.Sharable ->
+     | None, Type.Sharable ->
         let (set_funcref, get_funcref) = new_local env "funcref" in
         compile_exp_as env StackRep.UnboxedReference e1 ^^
         set_funcref ^^

src/construct.ml

@@ -279,7 +279,7 @@ let funcD f x exp =
   match f.it, x.it with
   | VarE _, VarE _ ->
     let sharing, t1, t2 = match typ f with
-      | T.Func(T.Call sharing, _, _, ts1, ts2) -> sharing, T.seq ts1, T.seq ts2
+      | T.Func(sharing, _, _, ts1, ts2) -> sharing, T.seq ts1, T.seq ts2
       | _ -> assert false in
     let cc = Value.call_conv_of_typ (typ f) in
     { it = FuncD (cc,
@@ -298,7 +298,7 @@ let funcD f x exp =
 let nary_funcD f xs exp =
   match f.it, typ f with
   | VarE _,
-    T.Func(T.Call sharing,_,_,_,ts2) ->
+    T.Func(sharing,_,_,_,ts2) ->
     let cc = Value.call_conv_of_typ (typ f) in
     let t2 = T.seq ts2 in
     { it = FuncD (cc,
@@ -317,8 +317,8 @@ let nary_funcD f xs exp =
 
 let answerT = T.unit
 
-let contT typ = T.Func (T.Call T.Local, T.Returns, [], T.as_seq typ, [])
-let cpsT typ = T.Func (T.Call T.Local, T.Returns, [], [contT typ], [])
+let contT typ = T.Func (T.Local, T.Returns, [], T.as_seq typ, [])
+let cpsT typ = T.Func (T.Local, T.Returns, [], [contT typ], [])
 
 let fresh_cont typ = fresh_id (contT typ)
 
@@ -343,23 +343,23 @@ let  (-->) x exp =
   match x.it with
   | VarE _ ->
     let f = idE ("$lambda" @@ no_region)
-              (T.Func (T.Call T.Local, T.Returns, [], T.as_seq (typ x), T.as_seq (typ exp)))
+              (T.Func (T.Local, T.Returns, [], T.as_seq (typ x), T.as_seq (typ exp)))
     in
     decE  (funcD f x exp)
   | _ -> failwith "Impossible: -->"
 
 (* n-ary local lambda *)
 let (-->*) xs exp =
   let f = idE ("$lambda" @@ no_region)
-            (T.Func (T.Call T.Local, T.Returns, [],
+            (T.Func (T.Local, T.Returns, [],
                      List.map typ xs, T.as_seq (typ exp))) in
   decE (nary_funcD f xs exp)
 
 
 (* n-ary shared lambda *)
 let (-@>*) xs exp  =
   let f = idE ("$lambda" @@ no_region)
-            (T.Func (T.Call T.Sharable, T.Returns, [],
+            (T.Func (T.Sharable, T.Returns, [],
                      List.map typ xs, T.as_seq (typ exp))) in
   decE (nary_funcD f xs exp)
 
@@ -387,8 +387,8 @@ let ( -*- ) exp1 exp2 =
 *)
 
 let prim_async typ =
-  primE "@async" (T.Func (T.Call T.Local, T.Returns, [], [cpsT typ], [T.Async typ]))
+  primE "@async" (T.Func (T.Local, T.Returns, [], [cpsT typ], [T.Async typ]))
 
 let prim_await typ =
-  primE "@await" (T.Func (T.Call T.Local, T.Returns, [], [T.Async typ; contT typ], []))
+  primE "@await" (T.Func (T.Local, T.Returns, [], [T.Async typ; contT typ], []))
 

src/interpret.ml

@@ -149,7 +149,7 @@ let actor_msg id f v (k : V.value V.cont) =
 let make_unit_message id v =
   let call_conv, f = V.as_func v in
   match call_conv with
-  | {V.sort = T.Call T.Sharable; V.n_res = 0; _} ->
+  | {V.sort = T.Sharable; V.n_res = 0; _} ->
     Value.message_func call_conv.V.n_args (fun v k ->
       actor_msg id f v (fun _ -> ());
       k V.unit
@@ -161,7 +161,7 @@ let make_unit_message id v =
 let make_async_message id v =
   let call_conv, f = V.as_func v in
   match call_conv with
-  | {V.sort = T.Call T.Sharable; V.control = T.Promises; V.n_res = 1; _} ->
+  | {V.sort = T.Sharable; V.control = T.Promises; V.n_res = 1; _} ->
     Value.async_func call_conv.V.n_args (fun v k ->
       let async = make_async () in
       actor_msg id f v (fun v_async ->

src/interpret_ir.ml

@@ -149,7 +149,7 @@ let actor_msg id f v (k : V.value V.cont) =
 let make_unit_message id v =
   let call_conv, f = V.as_func v in
   match call_conv with
-  | {V.sort = T.Call T.Sharable; V.n_res = 0; _} ->
+  | {V.sort = T.Sharable; V.n_res = 0; _} ->
     Value.message_func call_conv.V.n_args (fun v k ->
       actor_msg id f v (fun _ -> ());
       k V.unit
@@ -162,7 +162,7 @@ let make_async_message id v =
   assert (not !Flags.async_lowering);
   let call_conv, f = V.as_func v in
   match call_conv with
-  | {V.sort = T.Call T.Sharable; V.control = T.Promises; V.n_res = 1; _} ->
+  | {V.sort = T.Sharable; V.control = T.Promises; V.n_res = 1; _} ->
     Value.async_func call_conv.V.n_args (fun v k ->
       let async = make_async () in
       actor_msg id f v (fun v_async ->
@@ -640,8 +640,7 @@ and interpret_dec env dec (k : V.value V.cont) =
     let v = V.Func (V.call_conv_of_typ dec.note.Syntax.note_typ, f) in
     let v =
       match cc.Value.sort with
-      | T.Call T.Sharable ->
-        make_message id dec.note.Syntax.note_typ v
+      | T.Sharable -> make_message id dec.note.Syntax.note_typ v
       | _-> v
     in
     define_id env id v;