WIP: first stab at 2nd class modules with type components

samples/counter.txt

@@ -1,7 +1,7 @@
 -- Checking counter.as:
-type Counter <: actor {dec : shared () -> (); read : shared () -> async Int}
-let Counter : class Int -> Counter
-let c : Counter
+type Counter = actor {dec : shared () -> (); read : shared () -> async Int}
+let Counter : Int -> Counter
+let c : actor {dec : shared () -> (); read : shared () -> async Int}
 let show : (Text, Int) -> ()
 let showAsync : (Text, async Int) -> ()
 let testDec : () -> ()
@@ -287,8 +287,8 @@ testRead()
     <= ()
   <= ()
 -- Finished counter.as:
-let Counter : class Int -> Counter = func
-let c : Counter = {dec = func; read = func}
+let Counter : Int -> Counter = func
+let c : actor {dec : shared () -> (); read : shared () -> async Int} = {dec = func; read = func}
 let show : (Text, Int) -> () = func
 let showAsync : (Text, async Int) -> () = func
 let testDec : () -> () = func

samples/quicksort.txt

@@ -1,10 +1,10 @@
 -- Checking quicksort.as:
 type Array<T> = [var T]
-type QS<T> <: {quicksort : (Array<T>, Nat, Nat) -> ()}
-let QS : class <T>((T, T) -> Int) -> QS<T>
+type QS<T> = {quicksort : (Array<T>, Nat, Nat) -> ()}
+let QS : <T>((T, T) -> Int) -> QS<T>
 let a : [var Int]
 let cmpi : (Int, Int) -> Int
-let qs : QS<Int>
+let qs : {quicksort : (Array<Int>, Nat, Nat) -> ()}
 -- Interpreting quicksort.as:
 QS(func)
   <= {quicksort = func}
@@ -97,8 +97,8 @@ quicksort([8, 3, 9, 5, 2], 0, 4)
     <= ()
   <= ()
 -- Finished quicksort.as:
-let QS : class <T>((T, T) -> Int) -> QS<T> = func
+let QS : <T>((T, T) -> Int) -> QS<T> = func
 let a : [var Int] = [2, 3, 5, 8, 9]
 let cmpi : (Int, Int) -> Int = func
-let qs : QS<Int> = {quicksort = func}
+let qs : {quicksort : (Array<Int>, Nat, Nat) -> ()} = {quicksort = func}
 

src/arrange.ml

@@ -108,6 +108,7 @@ and control c = match c with
 and obj_sort' s = match s with
   | Type.Object sh -> Atom ("Object " ^ sharing sh)
   | Type.Actor -> Atom "Actor"
+  | Type.Module -> Atom "Module"
 
 and obj_sort s = obj_sort' s.it
 
@@ -130,6 +131,10 @@ and exp_field (ef : exp_field)
 
 and operator_type t = Atom (Type.string_of_typ t)
 
+and path p = match p.it with
+  | IdH i -> "IdH" $$ [id i]
+  | DotH (p,i) -> "DotH" $$ [path p; id i]
+
 and typ t = match t.it with
   | VarT (s, ts)        -> "VarT" $$ [id s] @ List.map typ ts
   | PrimT p             -> "PrimT" $$ [Atom p]
@@ -140,9 +145,11 @@ and typ t = match t.it with
   | 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]
+  | PathT (p, i, ts)         -> "PathT" $$ [path p; id i] @ List.map typ ts
+
 
 and id i = Atom i.it
-and con_id i = Atom i.it         
+and con_id i = Atom i.it
 
 and name n = Atom (string_of_name n.it)
 
@@ -164,5 +171,7 @@ and dec d = match d.it with
     "TypD" $$ [con_id i] @ List.map typ_bind tp @ [typ t]
   | ClassD (i, j, tp, s, p, i', efs) ->
     "ClassD" $$ id i :: con_id j :: List.map typ_bind tp @ [obj_sort s; pat p; id i'] @ List.map exp_field efs
+  | ModuleD (i,ds) ->
+    "ModuleD" $$  [id i] @ List.map dec ds
 
 and prog prog = "BlockE"  $$ List.map dec prog.it

src/arrange_type.ml

@@ -17,6 +17,7 @@ let control c = match c with
 let obj_sort s = match s with
   | Type.Object sh -> Atom ("Object " ^ sharing sh)
   | Type.Actor -> Atom "Actor"
+  | Type.Module -> Atom "Module"
 
 let prim p = match p with
   | Null -> Atom "Null"
@@ -48,6 +49,7 @@ let rec typ (t:Type.typ) = match t with
   | Any                   -> Atom "Any"
   | Non                   -> Atom "Non"
   | Pre                   -> Atom "Pre"
+  | Kind (c,k)            -> Atom "Kind ..." (* TBC *)
 
 and typ_bind (tb : Type.bind) =
   tb.var $$ [typ tb.bound]

src/async.ml

@@ -162,6 +162,7 @@ let rec t_typ (t:T.typ) =
   | Any -> Any
   | Non -> Non
   | Pre -> Pre
+  | Kind (c,k) -> Kind (c, t_kind k)
 
 and t_bind {var; bound} =
   {var; bound = t_typ bound}

src/check_ir.ml

@@ -191,6 +191,19 @@ let rec check_typ env typ : unit =
     check env no_region (sorted fields) "object type's fields are not sorted"
   | T.Mut typ ->
     check_typ env typ
+  | T.Kind (c,k) ->
+    check_kind env k
+
+and check_kind env k =
+    let (binds,typ) =
+      match k with
+      | T.Abs(binds,typ)
+      | T.Def(binds,typ) -> (binds,typ)
+    in
+    let cs,ce = check_typ_binds env binds in
+    let ts = List.map (fun c -> T.Con(c,[])) cs in
+    let env' = adjoin_typs env ce in
+    check_typ env' (T.open_ ts  typ);
 
 and check_typ_field env s typ_field : unit =
   let {T.name; T.typ} = typ_field in

src/definedness.ml

@@ -94,6 +94,7 @@ let rec exp msgs e : f = match e.it with
     begin match s.it with
     | Type.Actor -> eagerify f
     | Type.Object _ -> f
+    | Type.Module -> assert false (* TBR *)
     end
   | DotE (e, _t, i)     -> exp msgs e
   | AssignE (e1, e2)    -> exps msgs [e1; e2]
@@ -153,6 +154,8 @@ and dec msgs d = match d.it with
   | TypD (i, tp, t) -> (M.empty, S.empty)
   | ClassD (i, l, tp, s, p, i', efs) ->
     (M.empty, S.singleton i.it) +++ delayify (close (exp_fields msgs efs) /// pat msgs p // i'.it)
+  | ModuleD (i, ds) ->
+    (M.empty, S.singleton i.it) +++ decs msgs ds    (* TBR *)
 
 and decs msgs decs : f =
   (* Annotate the declarations with the analysis results *)

src/desugar.ml

@@ -104,7 +104,7 @@ and field_to_obj_entry (f : S.exp_field) =
 
 and obj at s class_id self_id es obj_typ =
   match s.it with
-  | Type.Object _ -> build_obj at None s self_id es obj_typ
+  | Type.Object _ | Type.Module -> build_obj at None s self_id es obj_typ (* TBR *)
   | Type.Actor -> I.ActorE (self_id, exp_fields es, obj_typ)
 
 and build_obj at class_id s self_id es obj_typ =
@@ -182,6 +182,8 @@ and dec' at n d = match d with
              { it = obj at s (Some fun_id) self_id es obj_typ;
                at = at;
                note = { S.note_typ = obj_typ; S.note_eff = T.Triv } })
+  | S.ModuleD(id, ds) ->
+    failwith "NYI"
 
 and cases cs = List.map case cs
 

src/effect.ml

@@ -105,6 +105,10 @@ and infer_effect_dec dec =
     T.Triv
   | ClassD (v, l, tps, s, p, v', efs) ->
     T.Triv
+  | ModuleD (_,decs) ->
+    let es = List.map effect_dec decs in
+    List.fold_left max_eff Type.Triv es
+
 
 (* effect inference on Ir *)
 

src/interpret.ml

@@ -575,8 +575,10 @@ and declare_dec dec : val_env =
   | LetD (pat, _) -> declare_pat pat
   | VarD (id, _)
   | FuncD (_, id, _, _, _, _)
+  | ModuleD (id, _)
   | ClassD (id, _, _, _, _, _, _) -> declare_id id
 
+
 and declare_decs decs ve : val_env =
   match decs with
   | [] -> ve
@@ -619,6 +621,12 @@ and interpret_dec env dec (k : V.value V.cont) =
     let v = V.Func (V.call_conv_of_typ dec.note.note_typ, f) in
     define_id env id v;
     k v
+  | ModuleD (id, decs) ->
+    let ve = ref V.Env.empty in
+    interpret_block env decs (Some ve) (fun v ->
+        let v = V.Obj (V.Env.map Lib.Promise.value (!ve)) in
+        define_id env id v;
+        k v)
 
 and interpret_decs env decs (k : V.value V.cont) =
   match decs with

src/lexer.mll

@@ -190,6 +190,7 @@ rule token mode = parse
   | "func" { FUNC }
   | "if" { IF }
   | "in" { IN }
+  | "module" { MODULE }
   | "new" { NEW }
   | "not" { NOT }
   | "null" { NULL }

src/parser.mly

@@ -106,6 +106,7 @@ let share_expfield (ef : exp_field) =
 %token EQ LT GT
 %token PLUSASSIGN MINUSASSIGN MULASSIGN DIVASSIGN MODASSIGN POWASSIGN CATASSIGN
 %token ANDASSIGN ORASSIGN XORASSIGN SHLASSIGN SHRASSIGN ROTLASSIGN ROTRASSIGN
+%token MODULE
 %token NULL
 %token<string> NAT
 %token<string> FLOAT
@@ -190,6 +191,13 @@ seplist1(X, SEP) :
   | (* empty *) { Type.Local @@ no_region }
   | SHARED { Type.Sharable @@ at $sloc }
 
+(* paths *)
+
+path :
+  | x=id
+    { IdH x @! at $sloc }
+  | p=path DOT x=id
+    { DotH (p, x) @! at $sloc }
 
 (* Types *)
 
@@ -204,6 +212,8 @@ typ_nullary :
     { TupT(ts) @! at $sloc }
   | x=id tso=typ_args?
     { VarT(x, Lib.Option.get tso []) @! at $sloc }
+  | p=path DOT x=id tso=typ_args?
+    { PathT(p, x, Lib.Option.get tso []) @! at $sloc }
   | LBRACKET m=var_opt t=typ RBRACKET
     { ArrayT(m, t) @! at $sloc }
   | tfs=typ_obj
@@ -545,6 +555,10 @@ dec_nonvar :
       let id = xf "class" $sloc in
       let con_id = id.it @= at $sloc in
       ClassD(id, con_id, tps, s, p, x, efs') @? at $sloc }
+  | MODULE xf=id_opt id_opt=id? EQ? LCURLY ds=seplist(dec, semicolon) RCURLY
+    { let id = xf "module" $sloc in
+      ModuleD(id, ds) @? at $sloc }
+
 
 dec :
   | d=dec_var

src/syntax.ml

@@ -23,6 +23,12 @@ type obj_sort = Type.obj_sort Source.phrase
 type mut = mut' Source.phrase
 and mut' = Const | Var
 
+and path = (path', Type.typ) Source.annotated_phrase
+
+and path' =
+  | IdH  of id
+  | DotH of path * id
+
 type typ = (typ',Type.typ) Source.annotated_phrase
 and typ' =
   | PrimT of string                                (* primitive *)
@@ -34,6 +40,7 @@ and typ' =
   | FuncT of sharing * typ_bind list * typ * typ   (* function *)
   | AsyncT of typ                                  (* future *)
   | ParT of typ                                    (* parentheses, used to control function arity only *)
+  | PathT of path * id * typ list                  (* type projection *)
 (*
   | UnionT of type * typ                           (* union *)
   | AtomT of string                                (* atom *)
@@ -184,7 +191,7 @@ and dec' =
   | TypD of con_id * typ_bind list * typ       (* type *)
   | ClassD of                                  (* class *)
       id * con_id * typ_bind list * obj_sort * pat * id * exp_field list
-
+  | ModuleD of id * dec list
 
 (* Program *)