Generalise objects

README.md

@@ -27,6 +27,7 @@ git -C nix/dev submodule update --init --recursive
 
 To update, just run the last two commands again.
 
+
 ## Development using Nix
 
 This is the command that should always pass on master is the following, which builds everything:
@@ -52,6 +53,7 @@ nix-build -A js
 By default, `dvm` is built using the V8 engine. To build with the Haskell
 engine, pass `--arg v8 false` to any of the above `nix-*` commands.
 
+
 ## Development without Nix
 
 You can get a development environment that is independent of nix (although
@@ -68,7 +70,7 @@ installing all required tools without nix is out of scope).
    the precise repository and version. You can use `nix` to fetch the correct
    source for you, and run the manual installation inside:
    ```
-   cd $(nix-build -Q -A wasm.src)
+   cd $(nix-build -Q -A wasm.src)/interpreter
    make install
    ```
  * Install the `wasm` tool, using
@@ -85,6 +87,7 @@ installing all required tools without nix is out of scope).
    ```
    which also updates the `dev` checkout.
 
+
 ## Create a coverage report
 
 Run

design/Syntax.md

@@ -80,9 +80,8 @@ Productions marked * probably deferred to later versions.
 * # <id>                                             atom
 
 <exp-field> ::=                                object expression fields
-  private? <id> (: <typ>)? = <exp>                        immutable
-  private? var <id> (: <typ>)? = <exp>                    mutable
-  private? <id> <typ-params>? <pat> (: <typ>)? = <exp>    function (short-hand)
+  private? dec                                   field
+  private? <id> = <exp>                          short-hand
 ```
 
 ## Patterns

src/arrange.ml

@@ -4,21 +4,23 @@ open Wasm.Sexpr
 
 let ($$) head inner = Node (head, inner)
 
+and id i = Atom i.it
+
 let rec exp e = match e.it with
-  | VarE i              -> "VarE"    $$ [id i]
+  | VarE x              -> "VarE"    $$ [id x]
   | LitE l              -> "LitE"    $$ [lit !l]
   | UnE (ot, uo, e)     -> "UnE"     $$ [operator_type !ot; unop uo; exp e]
   | BinE (ot, e1, bo, e2) -> "BinE"    $$ [operator_type !ot; exp e1; binop bo; exp e2]
   | RelE (ot, e1, ro, e2) -> "RelE"    $$ [operator_type !ot; exp e1; relop ro; exp e2]
   | TupE es             -> "TupE"    $$ List.map exp es
   | ProjE (e, i)        -> "ProjE"   $$ [exp e; Atom (string_of_int i)]
   | ObjE (s, i, efs)    -> "ObjE"    $$ [obj_sort s; id i] @ List.map exp_field efs
-  | DotE (e, sr, n)         -> "DotE"    $$ [exp e; obj_sort' !sr; name n]
+  | DotE (e, x)         -> "DotE"    $$ [exp e; id x]
   | AssignE (e1, e2)    -> "AssignE" $$ [exp e1; exp e2]
   | ArrayE (m, es)      -> "ArrayE"  $$ [mut m] @ List.map exp es
   | IdxE (e1, e2)       -> "IdxE"    $$ [exp e1; exp e2]
   | CallE (e1, ts, e2)  -> "CallE"   $$ [exp e1] @ List.map typ ts @ [exp e2]
-  | BlockE (ds, ot)      -> "BlockE"  $$ List.map dec ds @ [operator_type (!ot)]
+  | BlockE (ds)         -> "BlockE"  $$ List.map dec ds
   | NotE e              -> "NotE"    $$ [exp e]
   | AndE (e1, e2)       -> "AndE"    $$ [exp e1; exp e2]
   | OrE (e1, e2)        -> "OrE"     $$ [exp e1; exp e2]
@@ -35,19 +37,18 @@ let rec exp e = match e.it with
   | AwaitE e            -> "AwaitE"  $$ [exp e]
   | AssertE e           -> "AssertE" $$ [exp e]
   | AnnotE (e, t)       -> "AnnotE"  $$ [exp e; typ t]
-  | DecE (d, ot)        -> "DecE"    $$ [dec d ; operator_type !ot]
   | OptE e              -> "OptE"    $$ [exp e]
   | PrimE p             -> "PrimE"   $$ [Atom p]
 
 and pat p = match p.it with
   | WildP         -> Atom "WildP"
-  | VarP i        -> "VarP"       $$ [ id i]
+  | VarP x        -> "VarP"       $$ [id x]
   | TupP ps       -> "TupP"       $$ List.map pat ps
-  | AnnotP (p, t) -> "AnnotP"     $$ [ pat p; typ t]
-  | LitP l        -> "LitP"       $$ [ lit !l ]
-  | SignP (uo, l) -> "SignP"      $$ [ unop uo ; lit !l ]
-  | OptP p        -> "OptP"       $$ [ pat p ]
-  | AltP (p1,p2)  -> "AltP"       $$ [ pat p1; pat p2 ]
+  | AnnotP (p, t) -> "AnnotP"     $$ [pat p; typ t]
+  | LitP l        -> "LitP"       $$ [lit !l]
+  | SignP (uo, l) -> "SignP"      $$ [unop uo ; lit !l]
+  | OptP p        -> "OptP"       $$ [pat p]
+  | AltP (p1,p2)  -> "AltP"       $$ [pat p1; pat p2]
 
 and lit (l:lit) = match l with
   | NullLit       -> Atom "NullLit"
@@ -62,7 +63,7 @@ and lit (l:lit) = match l with
   | FloatLit f    -> "FloatLit"  $$ [ Atom (Value.Float.to_string f) ]
   | CharLit c     -> "CharLit"   $$ [ Atom (string_of_int c) ]
   | TextLit t     -> "TextLit"   $$ [ Atom t ]
-  | PreLit (s,p)  -> "PreLit"    $$ [ Atom s; prim p]
+  | PreLit (s,p)  -> "PreLit"    $$ [ Atom s; prim p ]
 
 and unop uo = match uo with
   | PosOp -> Atom "PosOp"
@@ -115,7 +116,7 @@ and mut m = match m.it with
   | Const -> Atom "Const"
   | Var   -> Atom "Var"
 
-and priv p = match p.it with
+and vis v = match v.it with
   | Public  -> Atom "Public"
   | Private -> Atom "Private"
 
@@ -126,7 +127,7 @@ and typ_bind (tb : typ_bind)
   = tb.it.var.it $$ [typ tb.it.bound]
 
 and exp_field (ef : exp_field)
-  = (string_of_name ef.it.name.it) $$ [id ef.it.id; exp ef.it.exp; mut ef.it.mut; priv ef.it.priv]
+  = "Field" $$ [dec ef.it.dec; vis ef.it.vis]
 
 and operator_type t = Atom (Type.string_of_typ t)
 
@@ -141,28 +142,23 @@ and typ t = match t.it with
   | AsyncT t            -> "AsyncT" $$ [typ t]
   | ParT t              -> "ParT" $$ [typ t]
 
-and id i = Atom i.it
-and con_id i = Atom i.it         
-
-and name n = Atom (string_of_name n.it)
-
 and dec d = match d.it with
-  | ExpD e ->      "ExpD" $$ [exp e ]
+  | ExpD e -> "ExpD" $$ [exp e ]
   | LetD (p, e) -> "LetD" $$ [pat p; exp e]
-  | VarD (i, e) -> "VarD" $$ [id i; exp e]
-  | FuncD (s, i, tp, p, t, e) ->
+  | VarD (x, e) -> "VarD" $$ [id x; exp e]
+  | FuncD (s, x, tp, p, t, e) ->
     "FuncD" $$ [
       Atom (Type.string_of_typ d.note.note_typ);
       Atom (sharing s.it);
-      id i] @
+      id x] @
       List.map typ_bind tp @ [
       pat p;
       typ t;
       exp e
     ]
-  | TypD (i, tp, t) ->
-    "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
+  | TypD (x, tp, t) ->
+    "TypD" $$ [id x] @ List.map typ_bind tp @ [typ t]
+  | ClassD (x, tp, s, p, i', efs) ->
+    "ClassD" $$ id x :: List.map typ_bind tp @ [obj_sort s; pat p; id i'] @ List.map exp_field efs
 
 and prog prog = "BlockE"  $$ List.map dec prog.it

src/arrange_ir.ml

@@ -17,13 +17,13 @@ let rec exp e = match e.it with
   | TupE es             -> "TupE"    $$ List.map exp es
   | ProjE (e, i)        -> "ProjE"   $$ [exp e; Atom (string_of_int i)]
   | ActorE (i, efs, t)  -> "ActorE"  $$ [id i] @ List.map exp_field efs @ [typ t]
-  | DotE (e, n)         -> "DotE"    $$ [exp e; name n]
-  | ActorDotE (e, n)    -> "ActorDotE" $$ [exp e; name n]
+  | DotE (e, n)         -> "DotE"    $$ [exp e; Atom (name n)]
+  | ActorDotE (e, n)    -> "ActorDotE" $$ [exp e; Atom (name n)]
   | AssignE (e1, e2)    -> "AssignE" $$ [exp e1; exp e2]
-  | ArrayE (m, t, es)      -> "ArrayE"  $$ [Arrange.mut m; typ t] @ List.map exp es
+  | ArrayE (m, t, es)   -> "ArrayE"  $$ [Arrange.mut m; typ t] @ List.map exp es
   | IdxE (e1, e2)       -> "IdxE"    $$ [exp e1; exp e2]
   | CallE (cc, e1, ts, e2) -> "CallE" $$ [call_conv cc; exp e1] @ List.map typ ts @ [exp e2]
-  | BlockE (ds, t)      -> "BlockE"  $$ List.map dec ds @ [typ t]
+  | BlockE ds           -> "BlockE"  $$ List.map dec ds
   | IfE (e1, e2, e3)    -> "IfE"     $$ [exp e1; exp e2; exp e3]
   | SwitchE (e, cs)     -> "SwitchE" $$ [exp e] @ List.map case cs
   | WhileE (e1, e2)     -> "WhileE"  $$ [exp e1; exp e2]
@@ -40,9 +40,9 @@ let rec exp e = match e.it with
   | PrimE p             -> "PrimE"   $$ [Atom p]
   | DeclareE (i, t, e1) -> "DeclareE" $$ [id i; exp e1]
   | DefineE (i, m, e1)  -> "DefineE" $$ [id i; Arrange.mut m; exp e1]
-  | NewObjE (s, nameids, t)-> "NewObjE" $$ (Arrange.obj_sort s ::
+  | NewObjE (s, nameids, t)-> "NewObjE" $$ (Arrange.obj_sort' s ::
                                               List.fold_left (fun flds (n,i) ->
-                                                  (name n)::(id i):: flds) [typ t] nameids)
+                                                  Atom (name n)::(id i):: flds) [typ t] nameids)
 
 and pat p = match p.it with
   | WildP         -> Atom "WildP"
@@ -55,9 +55,10 @@ and pat p = match p.it with
 and case c = "case" $$ [pat c.it.pat; exp c.it.exp]
 
 and exp_field (ef : exp_field)
-  = (Syntax.string_of_name ef.it.name.it) $$ [id ef.it.id; exp ef.it.exp; Arrange.mut ef.it.mut; Arrange.priv ef.it.priv]
+  = name ef.it.name $$ [id ef.it.id; exp ef.it.exp; Arrange.mut ef.it.mut; Arrange.vis ef.it.vis]
 
-and name n = Atom (Syntax.string_of_name n.it)
+and name n = match n.it with
+  | Name l -> l
 
 and call_conv cc = Atom (Value.string_of_call_conv cc)
 

src/arrange_type.ml

@@ -53,5 +53,5 @@ and typ_bind (tb : Type.bind) =
   tb.var $$ [typ tb.bound]
 
 and typ_field (tf : Type.field) =
-  tf.name $$ [typ tf.typ]
+  tf.lab $$ [typ tf.typ]
 

src/async.ml

@@ -201,7 +201,7 @@ module Transform() = struct
     match  ConRenaming.find_opt c (!con_renaming) with
     | Some c' -> c'
     | None ->
-      let clone = Con.clone c (Abs ([],Pre)) in
+      let clone = Con.clone c (Abs ([], Pre)) in
       con_renaming := ConRenaming.add c clone (!con_renaming);
       (* Need to extend con_renaming before traversing the kind *)
       Type.set_kind clone (t_kind (Con.kind c));
@@ -213,8 +213,8 @@ module Transform() = struct
      it will be a pure value anyways. *)
     t_typ ot
 
-  and t_field {name; typ} =
-    { name; typ = t_typ typ }
+  and t_field {lab; typ} =
+    { lab; typ = t_typ typ }
   let rec t_exp (exp: exp) =
     { it = t_exp' exp;
       note = { note_typ = t_typ exp.note.note_typ;
@@ -297,8 +297,8 @@ module Transform() = struct
         .it
     | CallE (cc, exp1, typs, exp2)  ->
       CallE(cc, t_exp exp1, List.map t_typ typs, t_exp exp2)
-    | BlockE (decs, ot) ->
-      BlockE (t_decs decs, t_typ ot)
+    | BlockE decs ->
+      BlockE (t_decs decs)
     | IfE (exp1, exp2, exp3) ->
       IfE (t_exp exp1, t_exp exp2, t_exp exp3)
     | SwitchE (exp1, cases) ->

src/awaitopt.ml → src/await.ml

@@ -89,8 +89,8 @@ and t_exp' context exp' =
     IdxE (t_exp context exp1, t_exp context exp2)
   | CallE (cc, exp1, typs, exp2) ->
     CallE (cc, t_exp context exp1, typs, t_exp context exp2)
-  | BlockE (decs, typ) ->
-    BlockE (t_decs context decs, typ)
+  | BlockE decs ->
+    BlockE (t_decs context decs)
   | IfE (exp1, exp2, exp3) ->
     IfE (t_exp context exp1, t_exp context exp2, t_exp context exp3)
   | SwitchE (exp1, cases) ->
@@ -345,7 +345,7 @@ and c_exp' context exp k =
     binary context k (fun v1 v2 -> e (IdxE (v1, v2))) exp1 exp2
   | CallE (cc, exp1, typs, exp2) ->
     binary context k (fun v1 v2 -> e (CallE (cc, v1, typs, v2))) exp1 exp2
-  | BlockE (decs,t) ->
+  | BlockE decs ->
     c_block context decs k
   | IfE (exp1, exp2, exp3) ->
     c_if context k exp1 exp2 exp3