Index: typing/typecore.ml
===================================================================
--- typing/typecore.ml	(revision 15965)
+++ typing/typecore.ml	(working copy)
@@ -291,6 +291,10 @@
     (p0, p, {type_kind=Type_record (fields, _)}) -> (p0, p, fields)
   | _ -> raise Not_found

+type label_access =
+  | Record_access of Typedtree.expression * Types.label_description * bool
+  | Method of Longident.t * string
+
 let extract_concrete_variant env ty =
   match extract_concrete_typedecl env ty with
     (p0, p, {type_kind=Type_variant cstrs}) -> (p0, p, cstrs)
@@ -2148,30 +2152,46 @@
         exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_field(srecord, lid) ->
-      let (record, label, _) = type_label_access env loc srecord lid in
-      let (_, ty_arg, ty_res) = instance_label false label in
-      unify_exp env record ty_res;
-      rue {
-        exp_desc = Texp_field(record, lid, label);
-        exp_loc = loc; exp_extra = [];
-        exp_type = ty_arg;
-        exp_attributes = sexp.pexp_attributes;
-        exp_env = env }
+      begin match type_label_access env loc srecord lid with
+      | Record_access (record, label, _) ->
+          let (_, ty_arg, ty_res) = instance_label false label in
+          unify_exp env record ty_res;
+          rue {
+            exp_desc = Texp_field(record, lid, label);
+            exp_loc = loc; exp_extra = [];
+            exp_type = ty_arg;
+            exp_attributes = sexp.pexp_attributes;
+            exp_env = env }
+      | Method (mlid, s) ->
+          let fun_lid = Longident.Ldot (mlid, s) in
+          type_expect ?in_function env
+            Ast_helper.(Exp.apply (Exp.ident (mknoloc fun_lid))
+                          [Nolabel, srecord])
+            ty_expected
+      end
   | Pexp_setfield(srecord, lid, snewval) ->
-      let (record, label, opath) = type_label_access env loc srecord lid in
-      let ty_record = if opath = None then newvar () else record.exp_type in
-      let (label_loc, label, newval) =
-        type_label_exp false env loc ty_record (lid, label, snewval) in
-      unify_exp env record ty_record;
-      if label.lbl_mut = Immutable then
-        raise(Error(loc, env, Label_not_mutable lid.txt));
-      rue {
-        exp_desc = Texp_setfield(record, label_loc, label, newval);
-        exp_loc = loc; exp_extra = [];
-        exp_type = instance_def Predef.type_unit;
-        exp_attributes = sexp.pexp_attributes;
-        exp_env = env }
-  | Pexp_array(sargl) ->
+      begin match type_label_access env loc srecord lid with
+      | Record_access (record, label, has_opath) ->
+          let ty_record = if has_opath then record.exp_type else newvar () in
+          let (label_loc, label, newval) =
+            type_label_exp false env loc ty_record (lid, label, snewval) in
+          unify_exp env record ty_record;
+          if label.lbl_mut = Immutable then
+            raise(Error(loc, env, Label_not_mutable lid.txt));
+          rue {
+            exp_desc = Texp_setfield(record, label_loc, label, newval);
+            exp_loc = loc; exp_extra = [];
+            exp_type = instance_def Predef.type_unit;
+            exp_attributes = sexp.pexp_attributes;
+            exp_env = env }
+      | Method (mlid, s) ->
+          let fun_lid = Longident.Ldot (mlid, "set_" ^ s) in
+          type_expect ?in_function env
+            Ast_helper.(Exp.apply (Exp.ident (mknoloc fun_lid))
+                          [Nolabel, srecord; Nolabel, snewval])
+            ty_expected
+      end
+    | Pexp_array(sargl) ->
       let ty = newgenvar() in
       let to_unify = Predef.type_array ty in
       unify_exp_types loc env to_unify ty_expected;
@@ -2796,17 +2816,34 @@
     generalize_structure record.exp_type
   end;
   let ty_exp = record.exp_type in
-  let opath =
-    try
-      let (p0, p,_) = extract_concrete_record env ty_exp in
-      Some(p0, p, ty_exp.level = generic_level || not !Clflags.principal)
+  let ty_decl =
+    try Some (extract_concrete_typedecl env ty_exp)
     with Not_found -> None
   in
-  let labels = Typetexp.find_all_labels env lid.loc lid.txt in
-  let label =
-    wrap_disambiguate "This expression has" ty_exp
-      (Label.disambiguate lid env opath) labels in
-  (record, label, opath)
+  match ty_decl with
+  | Some (p0, p, {type_kind=Type_abstract}) ->
+      let rec lid_of_path = function
+        | Path.Pdot (p, s, _) -> Longident.Ldot (lid_of_path p, s)
+        | Path.Pident s -> Longident.Lident (Ident.name s)
+        | Path.Papply _ -> assert false (* XXX *)
+      in
+      begin match p, lid.txt with
+        | Path.Pdot (p, _, _), Longident.Lident s ->
+            Method (lid_of_path p, s)
+        | _ -> assert false
+      end
+  | _ ->
+      let opath =
+        match ty_decl with
+        | Some (p0, p, {type_kind=Type_record _}) ->
+            Some(p0, p, ty_exp.level = generic_level || not !Clflags.principal)
+        | _ -> None
+      in
+      let labels = Typetexp.find_all_labels env lid.loc lid.txt in
+      let label =
+        wrap_disambiguate "This expression has" ty_exp
+          (Label.disambiguate lid env opath) labels in
+      Record_access (record, label, opath <> None)

 (* Typing format strings for printing or reading.
    These formats are used by functions in modules Printf, Format, and Scanf.
Index: typing/ctype.ml
===================================================================
--- typing/ctype.ml	(revision 15965)
+++ typing/ctype.ml	(working copy)
@@ -1537,10 +1537,14 @@
       let decl = Env.find_type p env in
       if decl.type_kind <> Type_abstract then (p, p, decl) else
       let ty =
-        try try_expand_once env ty with Cannot_expand -> raise Not_found
+        try Some (try_expand_once env ty) with Cannot_expand -> None
       in
-      let (_, p', decl) = extract_concrete_typedecl env ty in
-        (p, p', decl)
+      begin match ty with
+      | None -> (p, p, decl)
+      | Some ty ->
+          let (_, p', decl) = extract_concrete_typedecl env ty in
+          (p, p', decl)
+      end
   | _ -> raise Not_found

 (* Implementing function [expand_head_opt], the compiler's own version of