6 files changed, 44 insertions, 16 deletions
diff --git a/typing/printtyped.ml b/typing/printtyped.ml
index ec96b8050..c5905bb8f 100644
--- a/typing/printtyped.ml
+++ b/typing/printtyped.ml
@@ -477,6 +477,7 @@ and class_type_declaration i ppf x =
 
 and class_expr i ppf x =
   line i ppf "class_expr %a\n" fmt_location x.cl_loc;
+  attributes i ppf x.cl_attributes;
   let i = i+1 in
   match x.cl_desc with
   | Tcl_ident (li, _, l) ->
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 28eae0bd6..ceba5435c 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -45,6 +45,7 @@ type error =
   | Final_self_clash of (type_expr * type_expr) list
   | Mutability_mismatch of string * mutable_flag
   | No_overriding of string * string
+  | Extension of string
 
 exception Error of Location.t * Env.t * error
 
@@ -817,20 +818,26 @@ and class_expr cl_num val_env met_env scl =
         rc {cl_desc = Tcl_ident (path, lid, tyl);
             cl_loc = scl.pcl_loc;
             cl_type = clty';
-            cl_env = val_env}
+            cl_env = val_env;
+            cl_attributes = scl.pcl_attributes;
+           }
       in
       let (vals, meths, concrs) = extract_constraints clty in
       rc {cl_desc = Tcl_constraint (cl, None, vals, meths, concrs);
           cl_loc = scl.pcl_loc;
           cl_type = clty';
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
   | Pcl_structure cl_str ->
       let (desc, ty) =
         class_structure cl_num false val_env met_env scl.pcl_loc cl_str in
       rc {cl_desc = Tcl_structure desc;
           cl_loc = scl.pcl_loc;
           cl_type = Cty_signature ty;
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
   | Pcl_fun (l, Some default, spat, sbody) ->
       let loc = default.pexp_loc in
       let open Ast_helper in
@@ -909,7 +916,9 @@ and class_expr cl_num val_env met_env scl =
           cl_loc = scl.pcl_loc;
           cl_type = Cty_fun
             (l, Ctype.instance_def pat.pat_type, cl.cl_type);
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
   | Pcl_apply (scl', sargs) ->
       let cl = class_expr cl_num val_env met_env scl' in
       let rec nonopt_labels ls ty_fun =
@@ -1002,7 +1011,9 @@ and class_expr cl_num val_env met_env scl =
       rc {cl_desc = Tcl_apply (cl, args);
           cl_loc = scl.pcl_loc;
           cl_type = cty;
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
   | Pcl_let (rec_flag, sdefs, scl') ->
       let (defs, val_env) =
         try
@@ -1045,7 +1056,9 @@ and class_expr cl_num val_env met_env scl =
       rc {cl_desc = Tcl_let (rec_flag, defs, vals, cl);
           cl_loc = scl.pcl_loc;
           cl_type = cl.cl_type;
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
   | Pcl_constraint (scl', scty) ->
       Ctype.begin_class_def ();
       let context = Typetexp.narrow () in
@@ -1071,7 +1084,11 @@ and class_expr cl_num val_env met_env scl =
       rc {cl_desc = Tcl_constraint (cl, Some clty, vals, meths, concrs);
           cl_loc = scl.pcl_loc;
           cl_type = snd (Ctype.instance_class [] clty.cltyp_type);
-          cl_env = val_env}
+          cl_env = val_env;
+          cl_attributes = scl.pcl_attributes;
+         }
+  | Pcl_extension (s, _arg) ->
+      raise (Error (scl.pcl_loc, val_env, Extension s))
 
 (*******************************)
 
@@ -1727,6 +1744,8 @@ let report_error env ppf = function
         "instance variable"
   | No_overriding (kind, name) ->
       fprintf ppf "@[The %s `%s'@ has no previous definition@]" kind name
-	
+  | Extension s ->
+      fprintf ppf "Uninterpreted extension '%s'." s
+
 let report_error env ppf err =
   Printtyp.wrap_printing_env env (fun () -> report_error env ppf err)
diff --git a/typing/typeclass.mli b/typing/typeclass.mli
index c8f28013d..81e56bd1b 100644
--- a/typing/typeclass.mli
+++ b/typing/typeclass.mli
@@ -103,6 +103,7 @@ type error =
   | Final_self_clash of (type_expr * type_expr) list
   | Mutability_mismatch of string * mutable_flag
   | No_overriding of string * string
+  | Extension of string
 
 exception Error of Location.t * Env.t * error
 
diff --git a/typing/typecore.ml b/typing/typecore.ml
index d09d86e7a..18433d26c 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -192,6 +192,7 @@ let iter_expression f e =
     | Pcl_let (_, pel, ce) ->
         List.iter (fun (_, e) -> expr e) pel; class_expr ce
     | Pcl_constraint (ce, _) -> class_expr ce
+    | Pcl_extension _ -> ()
 
   and class_field cf =
     match cf.pcf_desc with
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 5ab71c62f..912f60845 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -114,10 +114,13 @@ and meth =
 (* Value expressions for the class language *)
 
 and class_expr =
-  { cl_desc: class_expr_desc;
-    cl_loc: Location.t;
-    cl_type: Types.class_type;
-    cl_env: Env.t }
+    {
+     cl_desc: class_expr_desc;
+     cl_loc: Location.t;
+     cl_type: Types.class_type;
+     cl_env: Env.t;
+     cl_attributes: attribute list;
+    }
 
 and class_expr_desc =
     Tcl_ident of Path.t * Longident.t loc * core_type list
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index 5b79ddbeb..b42967884 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -113,10 +113,13 @@ and meth =
 (* Value expressions for the class language *)
 
 and class_expr =
-  { cl_desc: class_expr_desc;
-    cl_loc: Location.t;
-    cl_type: Types.class_type;
-    cl_env: Env.t }
+    {
+     cl_desc: class_expr_desc;
+     cl_loc: Location.t;
+     cl_type: Types.class_type;
+     cl_env: Env.t;
+     cl_attributes: attribute list;
+    }
 
 and class_expr_desc =
     Tcl_ident of Path.t * Longident.t loc * core_type list