Fix/issue129

src/desugar.ml

@@ -4,7 +4,7 @@ module I = Ir
 module T = Type
 
 (* TODO: clean me up when IrOps available, especially build_obj *)
-         
+
 (* Combinators used in the desguaring *)
 
 let bool_lit b : Ir.exp =
@@ -162,8 +162,8 @@ let
       | d::ds ->
         match d.it with
         | S.ClassD(_,con_id,_,_,_,_,_) ->
-          let (c,k) = match con_id.note with Some p -> p | _ -> assert false in
-          let typD = {it = I.TypD (c,k);
+          let (c, k) = match con_id.note with Some p -> p | _ -> assert false in
+          let typD = {it = I.TypD (c, k);
                       at = d.at;
                       note = {S.note_typ = T.unit; S.note_eff = T.Triv}}
           in
@@ -177,8 +177,8 @@ let
       let cc = Value.call_conv_of_typ n.S.note_typ in
       I.FuncD (cc, i, typ_binds tbs, pat p, ty.note, exp e)
     | S.TypD (con_id, typ_bind, t) ->
-      let (c,k) = Lib.Option.value con_id.note in
-      I.TypD (c,k)
+      let (c, k) = Lib.Option.value con_id.note in
+      I.TypD (c, k)
     | S.ClassD (fun_id, typ_id, tbs, s, p, self_id, es) ->
       let cc = Value.call_conv_of_typ n.S.note_typ in
       let inst = List.map
@@ -191,7 +191,7 @@ let
         match n.S.note_typ with
         | T.Func(s,c,bds,dom,[rng]) ->
           assert(List.length inst = List.length bds);
-          T.open_ inst rng 
+          T.open_ inst rng
         | _ -> assert false
       in
       I.FuncD (cc, fun_id, typ_binds tbs, pat p, obj_typ, (* TBR *)

src/parser.mly

@@ -27,11 +27,14 @@ let (@=) it at = {it; at; note = None}
 let dummy_obj_sort() = ref (Type.Object Type.Local)
 
 let dup_var x = VarE (x.it @@ x.at) @? x.at
+
+let anon sort at = "anon-" ^ sort ^ "-" ^ string_of_pos at.left
+
 let name_exp e =
   match e.it with
   | VarE x -> [], e, dup_var x
   | _ ->
-    let x = ("anon-val-" ^ string_of_pos (e.at.left)) @@ e.at in
+    let x = anon "val" e.at @@ e.at in
     [LetD (VarP x @! x.at, e) @? e.at], dup_var x, dup_var x
 
 let assign_op lhs rhs_f at =
@@ -164,8 +167,7 @@ seplist1(X, SEP) :
   | id=ID
     { fun _ _ -> id @@ at $sloc }
   | (* empty *)
-    { fun sort sloc ->
-      ("anon-" ^ sort ^ "-" ^ string_of_pos (at sloc).left) @@ at sloc }
+    { fun sort sloc -> anon sort (at sloc) @@ at sloc }
 
 %inline var_opt :
   | (* empty *) { Const @@ no_region }
@@ -456,9 +458,9 @@ exp :
     { e }
   | d=dec_var
     { DecE(d, ref Type.Pre) @? at $sloc }
-      
-    
-case : 
+
+
+case :
   | CASE p=pat_nullary e=exp
     { {pat = p; exp = e} @@ at $sloc }
 
@@ -558,15 +560,22 @@ dec :
   | e=exp_nondec
     { ExpD e @? at $sloc }
   (* TODO(andreas): move to dec_nonvar once other production is gone *)
-  | s=obj_sort xf=id_opt EQ? efs=obj_body
-    { let anon = if s.it = Type.Actor then "actor" else "object" in
-      let efs' =
+  | s=obj_sort id_opt=id? EQ? efs=obj_body
+    { let efs' =
         if s.it = Type.Object Type.Local
         then efs
         else List.map share_expfield efs
       in
-      let p = VarP(xf anon $sloc) @! at $sloc in
-      LetD(p, ObjE(s, xf anon $sloc, efs') @? at $sloc) @? at $sloc }
+      let r = at $sloc in
+      (* desugar anonymous objects to ExpD, named ones to LetD. *)
+      match id_opt with
+      | None ->
+        let sort = if s.it = Type.Actor then "actor" else "object" in
+        let x = anon sort r @@ r  in
+        ExpD(ObjE(s, x, efs') @? r) @? r
+      | Some x ->
+        let p = VarP x @! r in
+        LetD(p, ObjE(s, x, efs') @? r) @? r }
 
 func_dec :
   | tps=typ_params_opt p=pat_nullary rt=return_typ? fb=func_body
@@ -592,7 +601,7 @@ obj_body :
 
 class_body :
   | EQ xf=id_opt efs=obj_body { xf "object" $sloc, efs }
-  | efs=obj_body { ("anon-object-" ^ string_of_pos (at $sloc).left) @@ at $sloc, efs }
+  | efs=obj_body { anon "object" (at $sloc) @@ at $sloc, efs }
 
 
 (* Programs *)

src/typing.ml

@@ -1082,9 +1082,8 @@ and check_dec env t dec =
     (* TBR: special-case unit? *)
     if not (T.eq env.cons t T.unit || T.sub env.cons t' t) then
       local_error env dec.at "expression of type\n  %s\ncannot produce expected type\n  %s"
-        (T.string_of_typ_expand env.cons t)
         (T.string_of_typ_expand env.cons t')
-
+        (T.string_of_typ_expand env.cons t)
 (*
 and print_ce =
   Con.Env.iter (fun c k ->
@@ -1167,8 +1166,7 @@ and infer_dec_typdecs env dec : con_env =
     let tbs = List.map2 (fun c t -> {T.var = Con.name c; bound = T.close cs t}) cs ts in
     let k = T.Abs (tbs, T.close cs t) in
     id.note <- Some (c, k);
-    Con.Env.singleton c (T.Abs (tbs, T.close cs t))
-
+    Con.Env.singleton c k
 
 (* Pass 4: collect value identifiers *)
 and gather_block_valdecs env decs : val_env =
@@ -1185,7 +1183,6 @@ and gather_dec_valdecs env ve dec : val_env =
       error env dec.at "duplicate definition for %s in block" id.it;
     T.Env.add id.it T.Pre ve
 
-
 (* Pass 5: infer value types *)
 and infer_block_valdecs env decs : val_env =
   let _, ve =

test/run/issue129.as

@@ -0,0 +1,14 @@
+// status.as
+type Status = {
+  failed_ : Nat;
+  passed_ : Nat;
+  pending_ : Nat;
+};
+
+let appendStatus = func (x : Status, y : Status) : Status {
+  new {
+    failed_ = x.failed_ + y.failed_;
+    passed_ = x.passed_ + y.passed_;
+    pending_ = x.pending_ + y.pending_;
+  };
+};