Starting to keep attributes in the typedtree.

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/extension_points@13440 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

19 files changed, 361 insertions, 206 deletions

diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index 195dcc99b..2488e8da9 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -298,7 +298,7 @@ and transl_structure fields cc rootpath = function
   | Tstr_exception( id, _, decl) ->
       Llet(Strict, id, transl_exception id (field_path rootpath id) decl,
            transl_structure (id :: fields) cc rootpath rem)
-  | Tstr_exn_rebind( id, _, path, _) ->
+  | Tstr_exn_rebind( id, _, path, _, _) ->
       Llet(Strict, id, transl_path path,
            transl_structure (id :: fields) cc rootpath rem)
   | Tstr_module( id, _, modl) ->
@@ -312,10 +312,6 @@ and transl_structure fields cc rootpath = function
           transl_module Tcoerce_none (field_path rootpath id) modl)
         bindings
         (transl_structure ext_fields cc rootpath rem)
-  | Tstr_modtype(id, _, decl) ->
-      transl_structure fields cc rootpath rem
-  | Tstr_open (path, _) ->
-      transl_structure fields cc rootpath rem
   | Tstr_class cl_list ->
       let ids = List.map (fun (ci,_,_) -> ci.ci_id_class) cl_list in
       Lletrec(List.map
@@ -325,9 +321,7 @@ and transl_structure fields cc rootpath = function
                   (id, transl_class ids id meths cl vf ))
                 cl_list,
               transl_structure (List.rev ids @ fields) cc rootpath rem)
-  | Tstr_class_type cl_list ->
-      transl_structure fields cc rootpath rem
-  | Tstr_include(modl, ids) ->
+  | Tstr_include(modl, ids, _) ->
       let mid = Ident.create "include" in
       let rec rebind_idents pos newfields = function
         [] ->
@@ -338,6 +332,12 @@ and transl_structure fields cc rootpath = function
       Llet(Strict, mid, transl_module Tcoerce_none None modl,
            rebind_idents 0 fields ids)
 
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_class_type _
+  | Tstr_attribute _ ->
+      transl_structure fields cc rootpath rem
+
 (* Update forward declaration in Translcore *)
 let _ =
   Translcore.transl_module := transl_module
@@ -366,16 +366,17 @@ let rec defined_idents = function
     | Tstr_primitive(id, _, descr) -> defined_idents rem
     | Tstr_type decls -> defined_idents rem
     | Tstr_exception(id, _, decl) -> id :: defined_idents rem
-    | Tstr_exn_rebind(id, _, path, _) -> id :: defined_idents rem
+    | Tstr_exn_rebind(id, _, path, _, _) -> id :: defined_idents rem
     | Tstr_module(id, _, modl) -> id :: defined_idents rem
     | Tstr_recmodule decls ->
       List.map (fun (id, _, _, _) -> id) decls @ defined_idents rem
     | Tstr_modtype(id, _, decl) -> defined_idents rem
-    | Tstr_open (path, _) -> defined_idents rem
+    | Tstr_open (path, _, _) -> defined_idents rem
     | Tstr_class cl_list ->
       List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ defined_idents rem
     | Tstr_class_type cl_list -> defined_idents rem
-    | Tstr_include(modl, ids) -> ids @ defined_idents rem
+    | Tstr_include(modl, ids, _) -> ids @ defined_idents rem
+    | Tstr_attribute _ -> []
 
 (* second level idents (module M = struct ... let id = ... end), and all sub-levels idents *)
 let rec more_idents = function
@@ -387,16 +388,17 @@ let rec more_idents = function
     | Tstr_primitive(id, _, descr) -> more_idents rem
     | Tstr_type decls -> more_idents rem
     | Tstr_exception(id, _, decl) -> more_idents rem
-    | Tstr_exn_rebind(id, _, path, _) -> more_idents rem
+    | Tstr_exn_rebind(id, _, path, _, _) -> more_idents rem
     | Tstr_recmodule decls -> more_idents rem
     | Tstr_modtype(id, _, decl) -> more_idents rem
-    | Tstr_open (path, _) -> more_idents rem
+    | Tstr_open (path, _, _) -> more_idents rem
     | Tstr_class cl_list -> more_idents rem
     | Tstr_class_type cl_list -> more_idents rem
-    | Tstr_include(modl, ids) -> more_idents rem
+    | Tstr_include(modl, ids, _) -> more_idents rem
     | Tstr_module(id, _, { mod_desc = Tmod_structure str }) ->
       all_idents str.str_items @ more_idents rem
     | Tstr_module(id, _, _) -> more_idents rem
+    | Tstr_attribute _ -> []
 
 and all_idents = function
     [] -> []
@@ -408,18 +410,19 @@ and all_idents = function
     | Tstr_primitive(id, _, descr) -> all_idents rem
     | Tstr_type decls -> all_idents rem
     | Tstr_exception(id, _, decl) -> id :: all_idents rem
-    | Tstr_exn_rebind(id, _, path, _) -> id :: all_idents rem
+    | Tstr_exn_rebind(id, _, path, _, _) -> id :: all_idents rem
     | Tstr_recmodule decls ->
       List.map (fun (id, _, _, _) -> id) decls @ all_idents rem
     | Tstr_modtype(id, _, decl) -> all_idents rem
-    | Tstr_open (path, _) -> all_idents rem
+    | Tstr_open (path, _, _) -> all_idents rem
     | Tstr_class cl_list ->
       List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list @ all_idents rem
     | Tstr_class_type cl_list -> all_idents rem
-    | Tstr_include(modl, ids) -> ids @ all_idents rem
+    | Tstr_include(modl, ids, _) -> ids @ all_idents rem
     | Tstr_module(id, _, { mod_desc = Tmod_structure str }) ->
       id :: all_idents str.str_items @ all_idents rem
     | Tstr_module(id, _, _) -> id :: all_idents rem
+    | Tstr_attribute _ -> []
 
 
 (* A variant of transl_structure used to compile toplevel structure definitions
@@ -466,7 +469,7 @@ let transl_store_structure glob map prims str =
       let lam = transl_exception id (field_path rootpath id) decl in
       Lsequence(Llet(Strict, id, lam, store_ident id),
                 transl_store rootpath (add_ident false id subst) rem)
-  | Tstr_exn_rebind( id, _, path, _) ->
+  | Tstr_exn_rebind( id, _, path, _, _) ->
       let lam = subst_lambda subst (transl_path path) in
       Lsequence(Llet(Strict, id, lam, store_ident id),
                 transl_store rootpath (add_ident false id subst) rem)
@@ -500,10 +503,6 @@ let transl_store_structure glob map prims str =
         bindings
         (Lsequence(store_idents ids,
                    transl_store rootpath (add_idents true ids subst) rem))
-  | Tstr_modtype(id, _, decl) ->
-      transl_store rootpath subst rem
-  | Tstr_open (path, _) ->
-      transl_store rootpath subst rem
   | Tstr_class cl_list ->
       let ids = List.map (fun (ci, _, _) -> ci.ci_id_class) cl_list in
       let lam =
@@ -516,9 +515,7 @@ let transl_store_structure glob map prims str =
                 store_idents ids) in
       Lsequence(subst_lambda subst lam,
                 transl_store rootpath (add_idents false ids subst) rem)
-  | Tstr_class_type cl_list ->
-      transl_store rootpath subst rem
-  | Tstr_include(modl, ids) ->
+  | Tstr_include(modl, ids, _attrs) ->
       let mid = Ident.create "include" in
       let rec store_idents pos = function
         [] -> transl_store rootpath (add_idents true ids subst) rem
@@ -528,6 +525,11 @@ let transl_store_structure glob map prims str =
       Llet(Strict, mid,
            subst_lambda subst (transl_module Tcoerce_none None modl),
            store_idents 0 ids)
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_class_type _
+  | Tstr_attribute _ ->
+      transl_store rootpath subst rem
 
   and store_ident id =
     try
@@ -669,13 +671,9 @@ let transl_toplevel_item item =
       let idents = let_bound_idents pat_expr_list in
       transl_let rec_flag pat_expr_list
                  (make_sequence toploop_setvalue_id idents)
-  | Tstr_primitive(id, _, descr) ->
-      lambda_unit
-  | Tstr_type(decls) ->
-      lambda_unit
   | Tstr_exception(id, _, decl) ->
       toploop_setvalue id (transl_exception id None decl)
-  | Tstr_exn_rebind(id, _, path, _) ->
+  | Tstr_exn_rebind(id, _, path, _, _) ->
       toploop_setvalue id (transl_path path)
   | Tstr_module(id, _, modl) ->
       (* we need to use the unique name for the module because of issues
@@ -689,10 +687,6 @@ let transl_toplevel_item item =
         (fun id modl -> transl_module Tcoerce_none (Some(Pident id)) modl)
         bindings
         (make_sequence toploop_setvalue_id idents)
-  | Tstr_modtype(id, _, decl) ->
-      lambda_unit
-  | Tstr_open (path, _) ->
-      lambda_unit
   | Tstr_class cl_list ->
       (* we need to use unique names for the classes because there might
          be a value named identically *)
@@ -707,9 +701,7 @@ let transl_toplevel_item item =
               make_sequence
                 (fun (ci, _, _) -> toploop_setvalue_id ci.ci_id_class)
                 cl_list)
-  | Tstr_class_type cl_list ->
-      lambda_unit
-  | Tstr_include(modl, ids) ->
+  | Tstr_include(modl, ids, _attrs) ->
       let mid = Ident.create "include" in
       let rec set_idents pos = function
         [] ->
@@ -718,6 +710,13 @@ let transl_toplevel_item item =
           Lsequence(toploop_setvalue id (Lprim(Pfield pos, [Lvar mid])),
                     set_idents (pos + 1) ids) in
       Llet(Strict, mid, transl_module Tcoerce_none None modl, set_idents 0 ids)
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_primitive _
+  | Tstr_type _
+  | Tstr_class_type _
+  | Tstr_attribute _ ->
+      lambda_unit
 
 let transl_toplevel_item_and_close itm =
   close_toplevel_term (transl_label_init (transl_toplevel_item itm))
diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml
index d364dd199..b5aafd7d9 100644
--- a/ocamldoc/odoc_ast.ml
+++ b/ocamldoc/odoc_ast.ml
@@ -77,7 +77,7 @@ module Typedtree_search =
           Hashtbl.add table (MT (Name.from_ident ident)) tt
       | Typedtree.Tstr_exception (ident, _, _) ->
           Hashtbl.add table (E (Name.from_ident ident)) tt
-      | Typedtree.Tstr_exn_rebind (ident, _, _, _) ->
+      | Typedtree.Tstr_exn_rebind (ident, _, _, _, _) ->
           Hashtbl.add table (ER (Name.from_ident ident)) tt
       | Typedtree.Tstr_type ident_type_decl_list ->
           List.iter
@@ -111,6 +111,7 @@ module Typedtree_search =
       | Typedtree.Tstr_open _ -> ()
       | Typedtree.Tstr_include _ -> ()
       | Typedtree.Tstr_eval _ -> ()
+      | Typedtree.Tstr_attribute _ -> ()
 
     let tables typedtree =
       let t = Hashtbl.create 13 in
@@ -135,7 +136,7 @@ module Typedtree_search =
 
     let search_exception_rebind table name =
       match Hashtbl.find table (ER name) with
-      | (Typedtree.Tstr_exn_rebind (_, _, p, _)) -> p
+      | (Typedtree.Tstr_exn_rebind (_, _, p, _, _)) -> p
       | _ -> assert false
 
     let search_type_declaration table name =
@@ -885,7 +886,7 @@ module Analyser =
     let tt_get_included_module_list tt_structure =
       let f acc item =
         match item.str_desc with
-          Typedtree.Tstr_include (mod_expr, _) ->
+          Typedtree.Tstr_include (mod_expr, _, _) ->
             acc @ [
                   { (* A VOIR : chercher dans les modules et les module types, avec quel env ? *)
                     im_name = tt_name_from_module_expr mod_expr ;
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index 3874f89fd..19407e498 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -673,19 +673,21 @@ let rec search_pos_structure ~pos str =
         search_pos_pat pat ~pos ~env;
         search_pos_expr exp ~pos
       end
-  | Tstr_primitive (_, _, vd) ->()
-  | Tstr_type _ -> ()
-  | Tstr_exception _ -> ()
-  | Tstr_exn_rebind(_, _, _, _) -> ()
   | Tstr_module (_, _, m) -> search_pos_module_expr m ~pos
   | Tstr_recmodule bindings ->
       List.iter bindings ~f:(fun (_, _, _, m) -> search_pos_module_expr m ~pos)
-  | Tstr_modtype _ -> ()
-  | Tstr_open _ -> ()
   | Tstr_class l ->
       List.iter l ~f:(fun (cl, _, _) -> search_pos_class_expr cl.ci_expr ~pos)
-  | Tstr_class_type _ -> ()
-  | Tstr_include (m, _) -> search_pos_module_expr m ~pos
+  | Tstr_include (m, _, _) -> search_pos_module_expr m ~pos
+  | Tstr_primitive _
+  | Tstr_type _
+  | Tstr_exception _
+  | Tstr_modtype _
+  | Tstr_open _
+  | Tstr_class_type _
+  | Tstr_exn_rebind _
+  | Tstr_attribute _
+    -> ()
   end
 
 and search_pos_class_structure ~pos cls =
diff --git a/parsing/printast.ml b/parsing/printast.ml
index ba9a8188c..17ed88a68 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -378,10 +378,11 @@ and type_declaration i ppf x =
   option (i+1) core_type ppf x.ptype_manifest
 
 and attributes i ppf l =
+  let i = i + 1 in
   List.iter
     (fun (s, arg) ->
       line i ppf "attribute \"%s\"\n" s;
-      expression i ppf arg;
+      expression (i + 1) ppf arg;
     )
     l
 
diff --git a/parsing/printast.mli b/parsing/printast.mli
index a941da9e4..fdfd13075 100644
--- a/parsing/printast.mli
+++ b/parsing/printast.mli
@@ -16,3 +16,5 @@ open Format;;
 val interface : formatter -> signature_item list -> unit;;
 val implementation : formatter -> structure_item list -> unit;;
 val top_phrase : formatter -> toplevel_phrase -> unit;;
+
+val expression: int -> formatter -> expression -> unit
diff --git a/tools/tast_iter.ml b/tools/tast_iter.ml
index b02a4d2df..60b4420fc 100644
--- a/tools/tast_iter.ml
+++ b/tools/tast_iter.ml
@@ -26,7 +26,7 @@ let structure_item sub x =
   | Tstr_type list ->
       List.iter (fun (_id, _, decl) -> sub # type_declaration decl) list
   | Tstr_exception (_id, _, decl) -> sub # exception_declaration decl
-  | Tstr_exn_rebind (_id, _, _p, _) -> ()
+  | Tstr_exn_rebind (_id, _, _p, _, _) -> ()
   | Tstr_module (_id, _, mexpr) -> sub # module_expr mexpr
   | Tstr_recmodule list ->
       List.iter
@@ -41,7 +41,8 @@ let structure_item sub x =
       List.iter (fun (ci, _, _) -> sub # class_expr ci.ci_expr) list
   | Tstr_class_type list ->
       List.iter (fun (_id, _, ct) -> sub # class_type ct.ci_expr) list
-  | Tstr_include (mexpr, _) -> sub # module_expr mexpr
+  | Tstr_include (mexpr, _, _) -> sub # module_expr mexpr
+  | Tstr_attribute _ -> ()
 
 let value_description sub x =
   sub # core_type x.val_desc
@@ -68,7 +69,7 @@ let pattern sub pat =
     | Tpat_unpack -> ()
     | Tpat_constraint ct -> sub # core_type ct
   in
-  List.iter (fun (c, _) -> extra c) pat.pat_extra;
+  List.iter (fun (c, _, _) -> extra c) pat.pat_extra;
   match pat.pat_desc with
   | Tpat_any
   | Tpat_var _
@@ -90,7 +91,7 @@ let expression sub exp =
     | Texp_newtype _ -> ()
     | Texp_poly cto -> opt (sub # core_type) cto
   in
-  List.iter (function (c, _) -> extra c) exp.exp_extra;
+  List.iter (fun (c, _, _) -> extra c) exp.exp_extra;
   match exp.exp_desc with
   | Texp_ident _
   | Texp_constant _ -> ()
@@ -183,11 +184,12 @@ let signature_item sub item =
   | Tsig_modtype (_id, _, mdecl) ->
       sub # modtype_declaration mdecl
   | Tsig_open _ -> ()
-  | Tsig_include (mty,_) -> sub # module_type mty
+  | Tsig_include (mty,_,_) -> sub # module_type mty
   | Tsig_class list ->
       List.iter (sub # class_description) list
   | Tsig_class_type list ->
       List.iter (sub # class_type_declaration) list
+  | Tsig_attribute _ -> ()
 
 let modtype_declaration sub mdecl =
   match mdecl with
diff --git a/tools/untypeast.ml b/tools/untypeast.ml
index 7b663214e..be14f0554 100644
--- a/tools/untypeast.ml
+++ b/tools/untypeast.ml
@@ -55,8 +55,8 @@ and untype_structure_item item =
               untype_type_declaration name decl) list)
     | Tstr_exception (_id, name, decl) ->
         Pstr_exception (untype_exception_declaration name decl)
-    | Tstr_exn_rebind (_id, name, _p, lid) ->
-        Pstr_exn_rebind (name, lid, [])
+    | Tstr_exn_rebind (_id, name, _p, lid, attrs) ->
+        Pstr_exn_rebind (name, lid, attrs)
     | Tstr_module (_id, name, mexpr) ->
         Pstr_module (Mb.mk name (untype_module_expr mexpr))
     | Tstr_recmodule list ->
@@ -73,7 +73,7 @@ and untype_structure_item item =
     | Tstr_modtype (_id, name, mtype) ->
         Pstr_modtype {pmtb_name=name; pmtb_type=untype_module_type mtype;
                       pmtb_attributes=[]}
-    | Tstr_open (_path, lid) -> Pstr_open (lid, [])
+    | Tstr_open (_path, lid, attrs) -> Pstr_open (lid, attrs)
     | Tstr_class list ->
         Pstr_class (List.map (fun (ci, _, _) ->
               { pci_virt = ci.ci_virt;
@@ -82,7 +82,7 @@ and untype_structure_item item =
                 pci_expr = untype_class_expr ci.ci_expr;
                 pci_variance = ci.ci_variance;
                 pci_loc = ci.ci_loc;
-                pci_attributes = [];
+                pci_attributes = ci.ci_attributes;
               }
           ) list)
     | Tstr_class_type list ->
@@ -94,11 +94,13 @@ and untype_structure_item item =
                 pci_expr = untype_class_type ct.ci_expr;
                 pci_variance = ct.ci_variance;
                 pci_loc = ct.ci_loc;
-                pci_attributes = [];
+                pci_attributes = ct.ci_attributes;
               }
           ) list)
-    | Tstr_include (mexpr, _) ->
-        Pstr_include (untype_module_expr mexpr, [])
+    | Tstr_include (mexpr, _, attrs) ->
+        Pstr_include (untype_module_expr mexpr, attrs)
+    | Tstr_attribute x ->
+        Pstr_attribute x
   in
   { pstr_desc = desc; pstr_loc = item.str_loc; }
 
@@ -108,7 +110,7 @@ and untype_value_description name v =
    pval_prim = v.val_prim;
    pval_type = untype_core_type v.val_desc;
    pval_loc = v.val_loc;
-   pval_attributes = [];
+   pval_attributes = v.val_attributes;
   }
 
 and untype_type_declaration name decl =
@@ -138,7 +140,7 @@ and untype_type_declaration name decl =
         None -> None
       | Some ct -> Some (untype_core_type ct));
     ptype_variance = decl.typ_variance;
-    ptype_attributes = []; (* TODO *)
+    ptype_attributes = decl.typ_attributes;
     ptype_loc = decl.typ_loc;
   }
 
@@ -146,15 +148,15 @@ and untype_exception_declaration name decl =
   {
    ped_name = name;
    ped_args = List.map untype_core_type decl.exn_params;
-   ped_attributes = [];
+   ped_attributes = decl.exn_attributes;
   }
 
 and untype_pattern pat =
   let desc =
   match pat with
-      { pat_extra=[Tpat_unpack, _]; pat_desc = Tpat_var (_,name); _ } -> Ppat_unpack name
-    | { pat_extra=[Tpat_type (_path, lid), _]; _ } -> Ppat_type lid
-    | { pat_extra= (Tpat_constraint ct, _) :: rem; _ } ->
+      { pat_extra=[Tpat_unpack, _, _attrs]; pat_desc = Tpat_var (_,name); _ } -> Ppat_unpack name
+    | { pat_extra=[Tpat_type (_path, lid), _, _attrs]; _ } -> Ppat_type lid
+    | { pat_extra= (Tpat_constraint ct, _, _attrs) :: rem; _ } ->
         Ppat_constraint (untype_pattern { pat with pat_extra=rem }, untype_core_type ct)
     | _ ->
     match pat.pat_desc with
@@ -193,11 +195,11 @@ and untype_pattern pat =
     | Tpat_or (p1, p2, _) -> Ppat_or (untype_pattern p1, untype_pattern p2)
     | Tpat_lazy p -> Ppat_lazy (untype_pattern p)
   in
-  Pat.mk ~loc:pat.pat_loc desc
+  Pat.mk ~loc:pat.pat_loc ~attrs:pat.pat_attributes desc (* todo: fix attributes on extras *)
 
 and option f x = match x with None -> None | Some e -> Some (f e)
 
-and untype_extra (extra, loc) sexp =
+and untype_extra (extra, loc, attrs) sexp =
   let desc =
     match extra with
       Texp_constraint (cty1, cty2) ->
@@ -208,7 +210,7 @@ and untype_extra (extra, loc) sexp =
     | Texp_poly cto -> Pexp_poly (sexp, option untype_core_type cto)
     | Texp_newtype s -> Pexp_newtype (s, sexp)
   in
-  Exp.mk ~loc desc
+  Exp.mk ~loc ~attrs desc
 
 and untype_expression exp =
   let desc =
@@ -309,7 +311,7 @@ and untype_expression exp =
         Pexp_pack (untype_module_expr mexpr)
   in
   List.fold_right untype_extra exp.exp_extra
-    (Exp.mk ~loc:exp.exp_loc desc)
+    (Exp.mk ~loc:exp.exp_loc ~attrs:exp.exp_attributes desc)
 
 and untype_package_type pack =
   (pack.pack_txt,
@@ -338,12 +340,14 @@ and untype_signature_item item =
                pmd_attributes = []}) list)
     | Tsig_modtype (_id, name, mdecl) ->
         Psig_modtype {pmtd_name=name; pmtd_type=untype_modtype_declaration mdecl; pmtd_attributes=[]}
-    | Tsig_open (_path, lid) -> Psig_open (lid, [])
-    | Tsig_include (mty, _lid) -> Psig_include (untype_module_type mty, [])
+    | Tsig_open (_path, lid, attrs) -> Psig_open (lid, attrs)
+    | Tsig_include (mty, _lid, attrs) -> Psig_include (untype_module_type mty, attrs)
     | Tsig_class list ->
         Psig_class (List.map untype_class_description list)
     | Tsig_class_type list ->
         Psig_class_type (List.map untype_class_type_declaration list)
+    | Tsig_attribute x ->
+        Psig_attribute x
   in
   { psig_desc = desc;
     psig_loc = item.sig_loc;
@@ -362,7 +366,7 @@ and untype_class_description cd =
     pci_expr = untype_class_type cd.ci_expr;
     pci_variance = cd.ci_variance;
     pci_loc = cd.ci_loc;
-    pci_attributes = [];
+    pci_attributes = cd.ci_attributes;
   }
 
 and untype_class_type_declaration cd =
@@ -373,7 +377,7 @@ and untype_class_type_declaration cd =
     pci_expr = untype_class_type cd.ci_expr;
     pci_variance = cd.ci_variance;
     pci_loc = cd.ci_loc;
-    pci_attributes = [];
+    pci_attributes = cd.ci_attributes;
   }
 
 and untype_module_type mty =
diff --git a/typing/cmt_format.ml b/typing/cmt_format.ml
index 433bc5c49..9953c3b01 100644
--- a/typing/cmt_format.ml
+++ b/typing/cmt_format.ml
@@ -75,8 +75,8 @@ module ClearEnv  = TypedtreeMap.MakeMap (struct
   let leave_pattern p = { p with pat_env = keep_only_summary p.pat_env }
   let leave_expression e =
     let exp_extra = List.map (function
-        (Texp_open (path, lloc, env), loc) ->
-          (Texp_open (path, lloc, keep_only_summary env), loc)
+        (Texp_open (path, lloc, env), loc, attrs) ->
+          (Texp_open (path, lloc, keep_only_summary env), loc, attrs)
       | exp_extra -> exp_extra) e.exp_extra in
     { e with
       exp_env = keep_only_summary e.exp_env;
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index fdbcb39ee..323d5f944 100644
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -23,7 +23,9 @@ open Typedtree
 
 let make_pat desc ty tenv =
   {pat_desc = desc; pat_loc = Location.none; pat_extra = [];
-   pat_type = ty ; pat_env = tenv }
+   pat_type = ty ; pat_env = tenv;
+   pat_attributes = [];
+  }
 
 let omega = make_pat Tpat_any Ctype.none Env.empty
 
@@ -181,7 +183,7 @@ let pretty_const c = match c with
 
 let rec pretty_val ppf v =
   match v.pat_extra with
-      (cstr,_) :: rem ->
+      (cstr, _loc, _attrs) :: rem ->
         begin match cstr with
           | Tpat_unpack ->
             fprintf ppf "@[(module %a)@]" pretty_val { v with pat_extra = rem }
diff --git a/typing/printtyped.ml b/typing/printtyped.ml
index f1351d076..36f4b769e 100644
--- a/typing/printtyped.ml
+++ b/typing/printtyped.ml
@@ -130,6 +130,15 @@ let string_loc i ppf s = line i ppf "\"%s\"\n" s.txt;;
 let bool i ppf x = line i ppf "%s\n" (string_of_bool x);;
 let label i ppf x = line i ppf "label=\"%s\"\n" x;;
 
+let attributes i ppf l =
+  let i = i + 1 in
+  List.iter
+    (fun (s, arg) ->
+      line i ppf "attribute \"%s\"\n" s;
+      Printast.expression (i + 1) ppf arg;
+    )
+    l
+
 let rec core_type i ppf x =
   line i ppf "core_type %a\n" fmt_location x.ctyp_loc;
   let i = i+1 in
@@ -184,17 +193,21 @@ and core_field_type i ppf x =
 
 and pattern i ppf x =
   line i ppf "pattern %a\n" fmt_location x.pat_loc;
+  attributes i ppf x.pat_attributes;
   let i = i+1 in
   match x.pat_extra with
-    | (Tpat_unpack, _) :: rem ->
+    | (Tpat_unpack, _, attrs) :: rem ->
         line i ppf "Tpat_unpack\n";
+        attributes i ppf attrs;
         pattern i ppf { x with pat_extra = rem }
-    | (Tpat_constraint cty, _) :: rem ->
+    | (Tpat_constraint cty, _, attrs) :: rem ->
         line i ppf "Tpat_constraint\n";
+        attributes i ppf attrs;
         core_type i ppf cty;
         pattern i ppf { x with pat_extra = rem }
-    | (Tpat_type (id, _), _) :: rem ->
+    | (Tpat_type (id, _), _, attrs) :: rem ->
         line i ppf "Tpat_type %a\n" fmt_path id;
+        attributes i ppf attrs;
         pattern i ppf { x with pat_extra = rem }
     | [] ->
   match x.pat_desc with
@@ -228,24 +241,29 @@ and pattern i ppf x =
       line i ppf "Ppat_lazy\n";
       pattern i ppf p;
 
-and expression_extra i ppf x =
+and expression_extra i ppf x attrs =
   match x with
   | Texp_constraint (cto1, cto2) ->
       line i ppf "Pexp_constraint\n";
+      attributes i ppf attrs;
       option i core_type ppf cto1;
       option i core_type ppf cto2;
   | Texp_open (m, _, _) ->
       line i ppf "Pexp_open \"%a\"\n" fmt_path m;
+      attributes i ppf attrs;
   | Texp_poly cto ->
       line i ppf "Pexp_poly\n";
+      attributes i ppf attrs;
       option i core_type ppf cto;
   | Texp_newtype s ->
       line i ppf "Pexp_newtype \"%s\"\n" s;
+      attributes i ppf attrs;
 
 and expression i ppf x =
   line i ppf "expression %a\n" fmt_location x.exp_loc;
+  attributes i ppf x.exp_attributes;
   let i =
-    List.fold_left (fun i (extra,_) -> expression_extra i ppf extra; i+1)
+    List.fold_left (fun i (extra,_,attrs) -> expression_extra i ppf extra attrs; i+1)
       (i+1) x.exp_extra
   in
   match x.exp_desc with
@@ -579,16 +597,22 @@ and signature_item i ppf x =
   | Tsig_modtype (s, _, md) ->
       line i ppf "Psig_modtype \"%a\"\n" fmt_ident s;
       modtype_declaration i ppf md;
-  | Tsig_open (li,_) -> line i ppf "Psig_open %a\n" fmt_path li;
-  | Tsig_include (mt, _) ->
+  | Tsig_open (li,_,attrs) ->
+      line i ppf "Psig_open %a\n" fmt_path li;
+      attributes i ppf attrs
+  | Tsig_include (mt, _, attrs) ->
       line i ppf "Psig_include\n";
       module_type i ppf mt;
+      attributes i ppf attrs
   | Tsig_class (l) ->
       line i ppf "Psig_class\n";
       list i class_description ppf l;
   | Tsig_class_type (l) ->
       line i ppf "Psig_class_type\n";
       list i class_type_declaration ppf l;
+  | Tsig_attribute (s, arg) ->
+      line i ppf "Psig_attribute \"%s\"\n" s;
+      Printast.expression i ppf arg
 
 and modtype_declaration i ppf x =
   match x with
@@ -657,8 +681,9 @@ and structure_item i ppf x =
   | Tstr_exception (s, _, ed) ->
       line i ppf "Pstr_exception \"%a\"\n" fmt_ident s;
       exception_declaration i ppf ed.exn_params;
-  | Tstr_exn_rebind (s, _, li, _) ->
+  | Tstr_exn_rebind (s, _, li, _, attrs) ->
       line i ppf "Pstr_exn_rebind \"%a\" %a\n" fmt_ident s fmt_path li;
+      attributes i ppf attrs
   | Tstr_module (s, _, me) ->
       line i ppf "Pstr_module \"%a\"\n" fmt_ident s;
       module_expr i ppf me;
@@ -668,16 +693,22 @@ and structure_item i ppf x =
   | Tstr_modtype (s, _, mt) ->
       line i ppf "Pstr_modtype \"%a\"\n" fmt_ident s;
       module_type i ppf mt;
-  | Tstr_open (li, _) -> line i ppf "Pstr_open %a\n" fmt_path li;
+  | Tstr_open (li, _, attrs) ->
+      line i ppf "Pstr_open %a\n" fmt_path li;
+      attributes i ppf attrs
   | Tstr_class (l) ->
       line i ppf "Pstr_class\n";
       list i class_declaration ppf (List.map (fun (cl, _,_) -> cl) l);
   | Tstr_class_type (l) ->
       line i ppf "Pstr_class_type\n";
       list i class_type_declaration ppf (List.map (fun (_, _, cl) -> cl) l);
-  | Tstr_include (me, _) ->
+  | Tstr_include (me, _, attrs) ->
       line i ppf "Pstr_include";
-      module_expr i ppf me
+      module_expr i ppf me;
+      attributes i ppf attrs
+  | Tstr_attribute (s, arg) ->
+      line i ppf "Pstr_attribute \"%s\"\n" s;
+      Printast.expression i ppf arg
 
 and string_x_type_declaration i ppf (s, _, td) =
   ident i ppf s;
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 745df7131..6b7fccbec 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -51,7 +51,7 @@ exception Error of Location.t * Env.t * error
 open Typedtree
 
 let ctyp desc typ env loc =
-  { ctyp_desc = desc; ctyp_type = typ; ctyp_loc = loc; ctyp_env = env }
+  { ctyp_desc = desc; ctyp_type = typ; ctyp_loc = loc; ctyp_env = env; ctyp_attributes = [] }
 let cltyp desc typ env loc =
   { cltyp_desc = desc; cltyp_type = typ; cltyp_loc = loc; cltyp_env = env }
 let mkcf desc loc = { cf_desc = desc; cf_loc = loc }
@@ -883,6 +883,7 @@ and class_expr cl_num val_env met_env scl =
               Texp_ident(path, mknoloc (Longident.Lident (Ident.name id)), vd);
               exp_loc = Location.none; exp_extra = [];
               exp_type = Ctype.instance val_env' vd.val_type;
+              exp_attributes = []; (* check *)
               exp_env = val_env'})
           end
           pv
@@ -897,6 +898,7 @@ and class_expr cl_num val_env met_env scl =
            {exp_desc = Texp_constant (Asttypes.Const_int 1);
             exp_loc = Location.none; exp_extra = [];
             exp_type = Ctype.none;
+            exp_attributes = [];
             exp_env = Env.empty }]
       in
       Ctype.raise_nongen_level ();
@@ -1022,6 +1024,7 @@ and class_expr cl_num val_env met_env scl =
                 Texp_ident(path, mknoloc(Longident.Lident (Ident.name id)),vd);
                 exp_loc = Location.none; exp_extra = [];
                 exp_type = Ctype.instance val_env vd.val_type;
+                exp_attributes = [];
                 exp_env = val_env;
                }
              in
@@ -1402,16 +1405,17 @@ let final_decl env define_class
    { ci_variance = cl.pci_variance;
      ci_loc = cl.pci_loc;
      ci_virt = cl.pci_virt;
-      ci_params = cl.pci_params;
+     ci_params = cl.pci_params;
 (* TODO : check that we have the correct use of identifiers *)
-      ci_id_name = cl.pci_name;
-      ci_id_class = id;
-      ci_id_class_type = ty_id;
-      ci_id_object = obj_id;
-      ci_id_typesharp = cl_id;
+     ci_id_name = cl.pci_name;
+     ci_id_class = id;
+     ci_id_class_type = ty_id;
+     ci_id_object = obj_id;
+     ci_id_typesharp = cl_id;
      ci_expr = expr;
      ci_decl = clty;
      ci_type_decl = cltydef;
+     ci_attributes = cl.pci_attributes;
  })
 (*   (cl.pci_variance, cl.pci_loc)) *)
 
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 0993e5aec..c6f940a8f 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -232,7 +232,7 @@ let type_option ty =
   newty (Tconstr(Predef.path_option,[ty], ref Mnil))
 
 let mkexp exp_desc exp_type exp_loc exp_env =
-  { exp_desc; exp_type; exp_loc; exp_env; exp_extra = [] }
+  { exp_desc; exp_type; exp_loc; exp_env; exp_extra = []; exp_attributes = [] }
 
 let option_none ty loc =
   let lid = Longident.Lident "None" in
@@ -503,7 +503,7 @@ let build_or_pat env loc lid =
             (l, Reither(true,[], true, ref None)) :: fields
         | Rpresent (Some ty) ->
             (l, Some {pat_desc=Tpat_any; pat_loc=Location.none; pat_env=env;
-                      pat_type=ty; pat_extra=[];})
+                      pat_type=ty; pat_extra=[]; pat_attributes=[]})
             :: pats,
             (l, Reither(false, [ty], true, ref None)) :: fields
         | _ -> pats, fields)
@@ -517,7 +517,7 @@ let build_or_pat env loc lid =
   let row' = ref {row with row_more=newvar()} in
   let pats =
     List.map (fun (l,p) -> {pat_desc=Tpat_variant(l,p,row'); pat_loc=gloc;
-                            pat_env=env; pat_type=ty; pat_extra=[];})
+                            pat_env=env; pat_type=ty; pat_extra=[]; pat_attributes=[]})
       pats
   in
   match pats with
@@ -526,7 +526,7 @@ let build_or_pat env loc lid =
       let r =
         List.fold_left
           (fun pat pat0 -> {pat_desc=Tpat_or(pat0,pat,Some row0); pat_extra=[];
-                            pat_loc=gloc; pat_env=env; pat_type=ty})
+                            pat_loc=gloc; pat_env=env; pat_type=ty; pat_attributes=[]})
           pat pats in
       (path, rp { r with pat_loc = loc },ty)
 
@@ -852,6 +852,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_any;
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_var name ->
       let id = enter_variable loc name expected_ty in
@@ -859,14 +860,16 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_var (id, name);
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_unpack name ->
       let id = enter_variable loc name expected_ty ~is_module:true in
       rp {
         pat_desc = Tpat_var (id, name);
         pat_loc = sp.ppat_loc;
-        pat_extra=[Tpat_unpack, loc];
+        pat_extra=[Tpat_unpack, loc, sp.ppat_attributes];
         pat_type = expected_ty;
+        pat_attributes = [];
         pat_env = !env }
   | Ppat_constraint({ppat_desc=Ppat_var name; ppat_loc=lloc},
                     ({ptyp_desc=Ptyp_poly _} as sty)) ->
@@ -885,8 +888,9 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
           rp {
             pat_desc = Tpat_var (id, name);
             pat_loc = lloc;
-            pat_extra = [Tpat_constraint cty, loc];
+            pat_extra = [Tpat_constraint cty, loc, sp.ppat_attributes];
             pat_type = ty;
+            pat_attributes = [];
             pat_env = !env
           }
       | _ -> assert false
@@ -902,6 +906,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_alias(q, id, name);
         pat_loc = loc; pat_extra=[];
         pat_type = q.pat_type;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_constant cst ->
       unify_pat_types loc !env (type_constant cst) expected_ty;
@@ -909,6 +914,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_constant cst;
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_tuple spl ->
       let spl_ann = List.map (fun p -> (p,newvar ())) spl in
@@ -919,6 +925,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_tuple pl;
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_construct(lid, sarg, explicit_arity) ->
       let opath =
@@ -973,6 +980,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc=Tpat_construct(lid, constr, args,explicit_arity);
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_variant(l, sarg) ->
       let arg = may_map (fun p -> type_pat p (newvar())) sarg in
@@ -989,6 +997,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_variant(l, arg, ref {row with row_more = newvar()});
         pat_loc = loc; pat_extra=[];
         pat_type =  expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_record(lid_sp_list, closed) ->
       let opath, record_ty =
@@ -1029,6 +1038,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_record (lbl_pat_list, closed);
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_array spl ->
       let ty_elt = newvar() in
@@ -1040,6 +1050,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_array pl;
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_or(sp1, sp2) ->
       let initial_pattern_variables = !pattern_variables in
@@ -1055,6 +1066,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_or(p1, alpha_pat alpha_env p2, None);
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_lazy sp1 ->
       let nv = newvar () in
@@ -1065,6 +1077,7 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_desc = Tpat_lazy p1;
         pat_loc = loc; pat_extra=[];
         pat_type = expected_ty;
+        pat_attributes = sp.ppat_attributes;
         pat_env = !env }
   | Ppat_constraint(sp, sty) ->
       (* Separate when not already separated by !principal *)
@@ -1085,20 +1098,21 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         Printtyp.raw_type_expr ty
         Printtyp.raw_type_expr p.pat_type;*)
       pattern_force := force :: !pattern_force;
+      let extra = (Tpat_constraint cty, loc, sp.ppat_attributes) in
       if separate then
         match p.pat_desc with
           Tpat_var (id,s) ->
             {p with pat_type = ty;
-             pat_desc = Tpat_alias ({p with pat_desc = Tpat_any}, id,s);
-             pat_extra = [Tpat_constraint cty, loc];
+             pat_desc = Tpat_alias ({p with pat_desc = Tpat_any; pat_attributes = []}, id,s);
+             pat_extra = [extra];
             }
         | _ -> {p with pat_type = ty;
-                pat_extra = (Tpat_constraint cty,loc) :: p.pat_extra}
+                pat_extra = extra :: p.pat_extra}
       else p
   | Ppat_type lid ->
       let (path, p,ty) = build_or_pat !env loc lid.txt in
       unify_pat_types loc !env ty expected_ty;
-      { p with pat_extra = (Tpat_type (path, lid), loc) :: p.pat_extra }
+      { p with pat_extra = (Tpat_type (path, lid), loc, sp.ppat_attributes) :: p.pat_extra }
   | Ppat_extension (s, _arg) ->
       raise (Error (loc, !env, Extension s))
 
@@ -1324,12 +1338,13 @@ and is_nonexpansive_mod mexp =
           | Tstr_open _ | Tstr_class_type _ | Tstr_exn_rebind _ -> true
           | Tstr_value (_, pat_exp_list) ->
               List.for_all (fun (_, exp) -> is_nonexpansive exp) pat_exp_list
-          | Tstr_module (_, _, m) | Tstr_include (m, _) -> is_nonexpansive_mod m
+          | Tstr_module (_, _, m) | Tstr_include (m, _, _) -> is_nonexpansive_mod m
           | Tstr_recmodule id_mod_list ->
               List.for_all (fun (_, _, _, m) -> is_nonexpansive_mod m)
                 id_mod_list
           | Tstr_exception _ -> false (* true would be unsound *)
           | Tstr_class _ -> false (* could be more precise *)
+          | Tstr_attribute _ -> true
         )
         str.str_items
   | Tmod_apply _ -> false
@@ -1838,6 +1853,7 @@ and type_expect_ ?in_function env sexp ty_expected =
           end;
           exp_loc = loc; exp_extra = [];
           exp_type = instance env desc.val_type;
+          exp_attributes = sexp.pexp_attributes;
           exp_env = env }
       end
   | Pexp_constant(Const_string s as cst) ->
@@ -1851,12 +1867,14 @@ and type_expect_ ?in_function env sexp ty_expected =
                type_format loc s
            | _ -> instance_def Predef.type_string
            end;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_constant cst ->
       rue {
         exp_desc = Texp_constant cst;
         exp_loc = loc; exp_extra = [];
         exp_type = type_constant cst;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_let(Nonrecursive, [spat, sval], sbody) when contains_gadt env spat ->
       type_expect ?in_function env
@@ -1877,6 +1895,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_let(rec_flag, pat_exp_list, body);
         exp_loc = loc; exp_extra = [];
         exp_type = body.exp_type;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_function (l, Some default, [spat, sbody]) ->
       let default_loc = default.pexp_loc in
@@ -1954,6 +1973,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_function(l,cases, partial);
         exp_loc = loc; exp_extra = [];
         exp_type = instance env (newgenty (Tarrow(l, ty_arg, ty_res, Cok)));
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_apply(sfunct, sargs) ->
       begin_def (); (* one more level for non-returning functions *)
@@ -1983,6 +2003,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_apply(funct, args);
         exp_loc = loc; exp_extra = [];
         exp_type = ty_res;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_match(sarg, caselist) ->
       begin_def ();
@@ -1997,6 +2018,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_match(arg, cases, partial);
         exp_loc = loc; exp_extra = [];
         exp_type = instance env ty_expected;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_try(sbody, caselist) ->
       let body = type_expect env sbody ty_expected in
@@ -2006,6 +2028,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_try(body, cases);
         exp_loc = loc; exp_extra = [];
         exp_type = body.exp_type;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_tuple sexpl ->
       let subtypes = List.map (fun _ -> newgenvar ()) sexpl in
@@ -2019,9 +2042,10 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_loc = loc; exp_extra = [];
         (* Keep sharing *)
         exp_type = newty (Ttuple (List.map (fun e -> e.exp_type) expl));
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_construct(lid, sarg, explicit_arity) ->
-      type_construct env loc lid sarg explicit_arity ty_expected
+      type_construct env loc lid sarg explicit_arity ty_expected sexp.pexp_attributes
   | Pexp_variant(l, sarg) ->
       (* Keep sharing *)
       let ty_expected0 = instance env ty_expected in
@@ -2036,6 +2060,7 @@ and type_expect_ ?in_function env sexp ty_expected =
               re { exp_desc = Texp_variant(l, Some arg);
                    exp_loc = loc; exp_extra = [];
                    exp_type = ty_expected0;
+                   exp_attributes = sexp.pexp_attributes;
                    exp_env = env }
           | _ -> raise Not_found
           end
@@ -2052,6 +2077,7 @@ and type_expect_ ?in_function env sexp ty_expected =
                                     row_closed = false;
                                     row_fixed = false;
                                     row_name = None});
+          exp_attributes = sexp.pexp_attributes;
           exp_env = env }
       end
   | Pexp_record(lid_sexp_list, opt_sexp) ->
@@ -2146,6 +2172,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_record(lbl_exp_list, opt_exp);
         exp_loc = loc; exp_extra = [];
         exp_type = instance env ty_expected;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_field(srecord, lid) ->
       let (record, label, _) = type_label_access env loc srecord lid in
@@ -2155,6 +2182,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_field(record, lid, label);
         exp_loc = loc; exp_extra = [];
         exp_type = ty_arg;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_setfield(srecord, lid, snewval) ->
       let (record, label, opath) = type_label_access env loc srecord lid in
@@ -2168,6 +2196,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         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) ->
       let ty = newgenvar() in
@@ -2178,6 +2207,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_array argl;
         exp_loc = loc; exp_extra = [];
         exp_type = instance env ty_expected;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_ifthenelse(scond, sifso, sifnot) ->
       let cond = type_expect env scond Predef.type_bool in
@@ -2188,6 +2218,7 @@ and type_expect_ ?in_function env sexp ty_expected =
             exp_desc = Texp_ifthenelse(cond, ifso, None);
             exp_loc = loc; exp_extra = [];
             exp_type = ifso.exp_type;
+            exp_attributes = sexp.pexp_attributes;
             exp_env = env }
       | Some sifnot ->
           let ifso = type_expect env sifso ty_expected in
@@ -2198,6 +2229,7 @@ and type_expect_ ?in_function env sexp ty_expected =
             exp_desc = Texp_ifthenelse(cond, ifso, Some ifnot);
             exp_loc = loc; exp_extra = [];
             exp_type = ifso.exp_type;
+            exp_attributes = sexp.pexp_attributes;
             exp_env = env }
       end
   | Pexp_sequence(sexp1, sexp2) ->
@@ -2207,6 +2239,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_sequence(exp1, exp2);
         exp_loc = loc; exp_extra = [];
         exp_type = exp2.exp_type;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_while(scond, sbody) ->
       let cond = type_expect env scond Predef.type_bool in
@@ -2215,6 +2248,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_while(cond, body);
         exp_loc = loc; exp_extra = [];
         exp_type = instance_def Predef.type_unit;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_for(param, slow, shigh, dir, sbody) ->
       let low = type_expect env slow Predef.type_int in
@@ -2229,6 +2263,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_for(id, param, low, high, dir, body);
         exp_loc = loc; exp_extra = [];
         exp_type = instance_def Predef.type_unit;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_constraint(sarg, sty, sty') ->
       let separate = true (* always separate, 1% slowdown for lablgtk *)
@@ -2328,8 +2363,9 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = arg.exp_desc;
         exp_loc = arg.exp_loc;
         exp_type = ty';
+        exp_attributes = arg.exp_attributes;
         exp_env = env;
-        exp_extra = (Texp_constraint (cty, cty'), loc) :: arg.exp_extra;
+        exp_extra = (Texp_constraint (cty, cty'), loc, sexp.pexp_attributes) :: arg.exp_extra;
       }
   | Pexp_when(scond, sbody) ->
       let cond = type_expect env scond Predef.type_bool in
@@ -2338,6 +2374,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_when(cond, body);
         exp_loc = loc; exp_extra = [];
         exp_type = body.exp_type;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_send (e, met) ->
       if !Clflags.principal then begin_def ();
@@ -2380,17 +2417,20 @@ and type_expect_ ?in_function env sexp ty_expected =
                                             Types.val_loc = Location.none});
                                 exp_loc = loc; exp_extra = [];
                                 exp_type = method_type;
+                                exp_attributes = []; (* check *)
                                 exp_env = env},
                           ["",
                             Some {exp_desc = Texp_ident(path, lid, desc);
                                   exp_loc = obj.exp_loc; exp_extra = [];
                                   exp_type = desc.val_type;
+                                  exp_attributes = []; (* check *)
                                   exp_env = env},
                                Required])
                   in
                   (Tmeth_name met, Some (re {exp_desc = exp;
                                              exp_loc = loc; exp_extra = [];
                                              exp_type = typ;
+                                             exp_attributes = []; (* check *)
                                              exp_env = env}), typ)
               |  _ ->
                   assert false
@@ -2425,6 +2465,7 @@ and type_expect_ ?in_function env sexp ty_expected =
           exp_desc = Texp_send(obj, meth, exp);
           exp_loc = loc; exp_extra = [];
           exp_type = typ;
+          exp_attributes = sexp.pexp_attributes;
           exp_env = env }
       with Unify _ ->
         raise(Error(e.pexp_loc, env, Undefined_method (obj.exp_type, met)))
@@ -2439,6 +2480,7 @@ and type_expect_ ?in_function env sexp ty_expected =
               exp_desc = Texp_new (cl_path, cl, cl_decl);
               exp_loc = loc; exp_extra = [];
               exp_type = instance_def ty;
+              exp_attributes = sexp.pexp_attributes;
               exp_env = env }
         end
   | Pexp_setinstvar (lab, snewval) ->
@@ -2455,6 +2497,7 @@ and type_expect_ ?in_function env sexp ty_expected =
               exp_desc = Texp_setinstvar(path_self, path, lab, newval);
               exp_loc = loc; exp_extra = [];
               exp_type = instance_def Predef.type_unit;
+              exp_attributes = sexp.pexp_attributes;
               exp_env = env }
         | Val_ivar _ ->
             raise(Error(loc, env, Instance_variable_not_mutable(true,lab.txt)))
@@ -2497,6 +2540,7 @@ and type_expect_ ?in_function env sexp ty_expected =
             exp_desc = Texp_override(path_self, modifs);
             exp_loc = loc; exp_extra = [];
             exp_type = self_ty;
+            exp_attributes = sexp.pexp_attributes;
             exp_env = env }
       | _ ->
           assert false
@@ -2528,6 +2572,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_letmodule(id, name, modl, body);
         exp_loc = loc; exp_extra = [];
         exp_type = ty;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_assert (e) ->
       let cond = type_expect env e Predef.type_bool in
@@ -2535,6 +2580,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_assert (cond);
         exp_loc = loc; exp_extra = [];
         exp_type = instance_def Predef.type_unit;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
   | Pexp_assertfalse ->
@@ -2542,6 +2588,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_assertfalse;
         exp_loc = loc; exp_extra = [];
         exp_type = instance env ty_expected;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
   | Pexp_lazy e ->
@@ -2553,6 +2600,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_lazy arg;
         exp_loc = loc; exp_extra = [];
         exp_type = instance env ty_expected;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
   | Pexp_object s ->
@@ -2561,6 +2609,7 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_object (desc, (*sign,*) meths);
         exp_loc = loc; exp_extra = [];
         exp_type = sign.cty_self;
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env;
       }
   | Pexp_poly(sbody, sty) ->
@@ -2602,7 +2651,7 @@ and type_expect_ ?in_function env sexp ty_expected =
             exp
         | _ -> assert false
       in
-      re { exp with exp_extra = (Texp_poly cty, loc) :: exp.exp_extra }
+      re { exp with exp_extra = (Texp_poly cty, loc, sexp.pexp_attributes) :: exp.exp_extra }
   | Pexp_newtype(name, sbody) ->
       let ty = newvar () in
       (* remember original level *)
@@ -2647,7 +2696,7 @@ and type_expect_ ?in_function env sexp ty_expected =
       (* non-expansive if the body is non-expansive, so we don't introduce
          any new extra node in the typed AST. *)
       rue { body with exp_loc = loc; exp_type = ety;
-            exp_extra = (Texp_newtype name, loc) :: body.exp_extra }
+            exp_extra = (Texp_newtype name, loc, sexp.pexp_attributes) :: body.exp_extra }
   | Pexp_pack m ->
       let (p, nl, tl) =
         match Ctype.expand_head env (instance env ty_expected) with
@@ -2668,12 +2717,13 @@ and type_expect_ ?in_function env sexp ty_expected =
         exp_desc = Texp_pack modl;
         exp_loc = loc; exp_extra = [];
         exp_type = newty (Tpackage (p, nl, tl'));
+        exp_attributes = sexp.pexp_attributes;
         exp_env = env }
   | Pexp_open (lid, e) ->
       let (path, newenv) = !type_open env sexp.pexp_loc lid in
       let exp = type_expect newenv e ty_expected in
       { exp with
-        exp_extra = (Texp_open (path, lid, newenv), loc) :: exp.exp_extra;
+        exp_extra = (Texp_open (path, lid, newenv), loc, sexp.pexp_attributes) :: exp.exp_extra;
       }
   | Pexp_extension (s, _arg) ->
       raise (Error (loc, env, Extension s))
@@ -2795,9 +2845,10 @@ and type_argument env sarg ty_expected' ty_expected =
       let var_pair name ty =
         let id = Ident.create name in
         {pat_desc = Tpat_var (id, mknoloc name); pat_type = ty;pat_extra=[];
+         pat_attributes = [];
          pat_loc = Location.none; pat_env = env},
         {exp_type = ty; exp_loc = Location.none; exp_env = env;
-         exp_extra = [];
+         exp_extra = []; exp_attributes = [];
          exp_desc =
          Texp_ident(Path.Pident id, mknoloc (Longident.Lident name),
                     {val_type = ty; val_kind = Val_reg;
@@ -3012,7 +3063,7 @@ and type_application env funct sargs =
       else
         type_args [] [] ty (instance env ty) ty sargs []
 
-and type_construct env loc lid sarg explicit_arity ty_expected =
+and type_construct env loc lid sarg explicit_arity ty_expected attrs =
   let opath =
     try
       let (p0, p,_) = extract_concrete_variant env ty_expected in
@@ -3039,6 +3090,7 @@ and type_construct env loc lid sarg explicit_arity ty_expected =
       exp_desc = Texp_construct(lid, constr, [],explicit_arity);
       exp_loc = loc; exp_extra = [];
       exp_type = ty_res;
+      exp_attributes = attrs;
       exp_env = env } in
   if separate then begin
     end_def ();
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index da1ef0628..7a2646d4f 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -263,6 +263,7 @@ let transl_declaration env sdecl id =
       typ_kind = tkind;
       typ_variance = sdecl.ptype_variance;
       typ_private = sdecl.ptype_private;
+      typ_attributes = sdecl.ptype_attributes;
     } in
     (id, sdecl.ptype_name, tdecl)
 
@@ -883,7 +884,7 @@ let transl_exception env loc excdecl =
   let types = List.map (fun cty -> cty.ctyp_type) ttypes in
   List.iter Ctype.generalize types;
   let exn_decl = { exn_args = types; Types.exn_loc = loc } in
-  { exn_params = ttypes; exn_exn = exn_decl; Typedtree.exn_loc = loc }
+  { exn_params = ttypes; exn_exn = exn_decl; Typedtree.exn_loc = loc; exn_attributes = excdecl.ped_attributes }
 
 (* Translate an exception rebinding *)
 let transl_exn_rebind env loc lid =
@@ -919,7 +920,9 @@ let transl_value_decl env loc valdecl =
   in
   { val_desc = cty; val_val = v;
     val_prim = valdecl.pval_prim;
-    val_loc = valdecl.pval_loc; }
+    val_loc = valdecl.pval_loc;
+    val_attributes = valdecl.pval_attributes;
+   }
 
 (* Translate a "with" constraint -- much simplified version of
     transl_type_decl. *)
@@ -985,6 +988,7 @@ let transl_with_constraint env id row_path orig_decl sdecl =
     typ_kind = Ttype_abstract;
     typ_variance = sdecl.ptype_variance;
     typ_private = sdecl.ptype_private;
+    typ_attributes = sdecl.ptype_attributes;
   }
 
 (* Approximate a type declaration: just make all types abstract *)
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 29aa97d3b..13fe7bbcb 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -21,12 +21,16 @@ open Types
 type partial = Partial | Total
 type optional = Required | Optional
 
+type attribute = string * Parsetree.expression
+
 type pattern =
   { pat_desc: pattern_desc;
     pat_loc: Location.t;
-    pat_extra : (pat_extra * Location.t) list;
+    pat_extra : (pat_extra * Location.t * attribute list) list;
     pat_type: type_expr;
-    mutable pat_env: Env.t }
+    mutable pat_env: Env.t;
+    pat_attributes: attribute list;
+   }
 
 and pat_extra =
   | Tpat_constraint of core_type
@@ -52,9 +56,11 @@ and pattern_desc =
 and expression =
   { exp_desc: expression_desc;
     exp_loc: Location.t;
-    exp_extra : (exp_extra * Location.t) list;
+    exp_extra: (exp_extra * Location.t * attribute list) list;
     exp_type: type_expr;
-    exp_env: Env.t }
+    exp_env: Env.t;
+    exp_attributes: attribute list;
+   }
 
 and exp_extra =
   | Texp_constraint of core_type option * core_type option
@@ -114,7 +120,7 @@ and class_expr =
     cl_env: Env.t }
 
 and class_expr_desc =
-    Tcl_ident of Path.t * Longident.t loc * core_type list (* Pcl_constr *)
+    Tcl_ident of Path.t * Longident.t loc * core_type list
   | Tcl_structure of class_structure
   | Tcl_fun of
       label * pattern * (Ident.t * string loc * expression) list * class_expr *
@@ -195,14 +201,15 @@ and structure_item_desc =
   | Tstr_primitive of Ident.t * string loc * value_description
   | Tstr_type of (Ident.t * string loc * type_declaration) list
   | Tstr_exception of Ident.t * string loc * exception_declaration
-  | Tstr_exn_rebind of Ident.t * string loc * Path.t * Longident.t loc
+  | Tstr_exn_rebind of Ident.t * string loc * Path.t * Longident.t loc * attribute list
   | Tstr_module of Ident.t * string loc * module_expr
   | Tstr_recmodule of (Ident.t * string loc * module_type * module_expr) list
   | Tstr_modtype of Ident.t * string loc * module_type
-  | Tstr_open of Path.t * Longident.t loc
+  | Tstr_open of Path.t * Longident.t loc * attribute list
   | Tstr_class of (class_declaration * string list * virtual_flag) list
   | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
-  | Tstr_include of module_expr * Ident.t list
+  | Tstr_include of module_expr * Ident.t list * attribute list
+  | Tstr_attribute of attribute
 
 and module_coercion =
     Tcoerce_none
@@ -213,8 +220,10 @@ and module_coercion =
 and module_type =
   { mty_desc: module_type_desc;
     mty_type : Types.module_type;
-    mty_env : Env.t; (* BINANNOT ADDED *)
-    mty_loc: Location.t }
+    mty_env : Env.t;
+    mty_loc: Location.t;
+    mty_attributes: attribute list;
+   }
 
 and module_type_desc =
     Tmty_ident of Path.t * Longident.t loc
@@ -241,10 +250,11 @@ and signature_item_desc =
   | Tsig_module of Ident.t * string loc * module_type
   | Tsig_recmodule of (Ident.t * string loc * module_type) list
   | Tsig_modtype of Ident.t * string loc * modtype_declaration
-  | Tsig_open of Path.t * Longident.t loc
-  | Tsig_include of module_type * Types.signature
+  | Tsig_open of Path.t * Longident.t loc * attribute list
+  | Tsig_include of module_type * Types.signature * attribute list
   | Tsig_class of class_description list
   | Tsig_class_type of class_type_declaration list
+  | Tsig_attribute of attribute
 
 and modtype_declaration =
     Tmodtype_abstract
@@ -261,7 +271,9 @@ and core_type =
   { mutable ctyp_desc : core_type_desc;
     mutable ctyp_type : type_expr;
     ctyp_env : Env.t; (* BINANNOT ADDED *)
-    ctyp_loc : Location.t }
+    ctyp_loc : Location.t;
+    ctyp_attributes: attribute list;
+   }
 
 and core_type_desc =
     Ttyp_any
@@ -300,6 +312,7 @@ and value_description =
     val_val : Types.value_description;
     val_prim : string list;
     val_loc : Location.t;
+    val_attributes: attribute list;
     }
 
 and type_declaration =
@@ -310,7 +323,9 @@ and type_declaration =
     typ_private: private_flag;
     typ_manifest: core_type option;
     typ_variance: (bool * bool) list;
-    typ_loc: Location.t }
+    typ_loc: Location.t;
+    typ_attributes: attribute list;
+   }
 
 and type_kind =
     Ttype_abstract
@@ -321,7 +336,9 @@ and type_kind =
 and exception_declaration =
   { exn_params : core_type list;
     exn_exn : Types.exception_declaration;
-    exn_loc : Location.t }
+    exn_loc : Location.t;
+    exn_attributes: attribute list;
+   }
 
 and class_type =
   { cltyp_desc: class_type_desc;
@@ -374,7 +391,9 @@ and 'a class_infos =
     ci_decl: Types.class_declaration;
     ci_type_decl : Types.class_type_declaration;
     ci_variance: (bool * bool) list;
-    ci_loc: Location.t }
+    ci_loc: Location.t;
+    ci_attributes: attribute list;
+   }
 
 (* Auxiliary functions over the a.s.t. *)
 
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index d18058c34..787b0acde 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -20,12 +20,16 @@ open Types
 type partial = Partial | Total
 type optional = Required | Optional
 
+type attribute = string * Parsetree.expression
+
 type pattern =
   { pat_desc: pattern_desc;
     pat_loc: Location.t;
-    pat_extra : (pat_extra * Location.t) list;
+    pat_extra : (pat_extra * Location.t * attribute list) list;
     pat_type: type_expr;
-    mutable pat_env: Env.t }
+    mutable pat_env: Env.t;
+    pat_attributes: attribute list;
+   }
 
 and pat_extra =
   | Tpat_constraint of core_type
@@ -51,9 +55,11 @@ and pattern_desc =
 and expression =
   { exp_desc: expression_desc;
     exp_loc: Location.t;
-    exp_extra : (exp_extra * Location.t) list;
+    exp_extra: (exp_extra * Location.t * attribute list) list;
     exp_type: type_expr;
-    exp_env: Env.t }
+    exp_env: Env.t;
+    exp_attributes: attribute list;
+   }
 
 and exp_extra =
   | Texp_constraint of core_type option * core_type option
@@ -194,14 +200,15 @@ and structure_item_desc =
   | Tstr_primitive of Ident.t * string loc * value_description
   | Tstr_type of (Ident.t * string loc * type_declaration) list
   | Tstr_exception of Ident.t * string loc * exception_declaration
-  | Tstr_exn_rebind of Ident.t * string loc * Path.t * Longident.t loc
+  | Tstr_exn_rebind of Ident.t * string loc * Path.t * Longident.t loc * attribute list
   | Tstr_module of Ident.t * string loc * module_expr
   | Tstr_recmodule of (Ident.t * string loc * module_type * module_expr) list
   | Tstr_modtype of Ident.t * string loc * module_type
-  | Tstr_open of Path.t * Longident.t loc
+  | Tstr_open of Path.t * Longident.t loc * attribute list
   | Tstr_class of (class_declaration * string list * virtual_flag) list
   | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
-  | Tstr_include of module_expr * Ident.t list
+  | Tstr_include of module_expr * Ident.t list * attribute list
+  | Tstr_attribute of attribute
 
 and module_coercion =
     Tcoerce_none
@@ -213,7 +220,9 @@ and module_type =
   { mty_desc: module_type_desc;
     mty_type : Types.module_type;
     mty_env : Env.t;
-    mty_loc: Location.t }
+    mty_loc: Location.t;
+    mty_attributes: attribute list;
+   }
 
 and module_type_desc =
     Tmty_ident of Path.t * Longident.t loc
@@ -240,10 +249,11 @@ and signature_item_desc =
   | Tsig_module of Ident.t * string loc * module_type
   | Tsig_recmodule of (Ident.t * string loc * module_type) list
   | Tsig_modtype of Ident.t * string loc * modtype_declaration
-  | Tsig_open of Path.t * Longident.t loc
-  | Tsig_include of module_type * Types.signature
+  | Tsig_open of Path.t * Longident.t loc * attribute list
+  | Tsig_include of module_type * Types.signature * attribute list
   | Tsig_class of class_description list
   | Tsig_class_type of class_type_declaration list
+  | Tsig_attribute of attribute
 
 and modtype_declaration =
     Tmodtype_abstract
@@ -260,7 +270,9 @@ and core_type =
   { mutable ctyp_desc : core_type_desc;
     mutable ctyp_type : type_expr;
     ctyp_env : Env.t; (* BINANNOT ADDED *)
-    ctyp_loc : Location.t }
+    ctyp_loc : Location.t;
+    ctyp_attributes: attribute list;
+   }
 
 and core_type_desc =
     Ttyp_any
@@ -299,6 +311,7 @@ and value_description =
     val_val : Types.value_description;
     val_prim : string list;
     val_loc : Location.t;
+    val_attributes: attribute list;
     }
 
 and type_declaration =
@@ -309,7 +322,9 @@ and type_declaration =
     typ_private: private_flag;
     typ_manifest: core_type option;
     typ_variance: (bool * bool) list;
-    typ_loc: Location.t }
+    typ_loc: Location.t;
+    typ_attributes: attribute list;
+   }
 
 and type_kind =
     Ttype_abstract
@@ -320,7 +335,9 @@ and type_kind =
 and exception_declaration =
   { exn_params : core_type list;
     exn_exn : Types.exception_declaration;
-    exn_loc : Location.t }
+    exn_loc : Location.t;
+    exn_attributes: attribute list;
+   }
 
 and class_type =
   { cltyp_desc: class_type_desc;
@@ -373,7 +390,9 @@ and 'a class_infos =
     ci_decl: Types.class_declaration;
     ci_type_decl : Types.class_type_declaration;
     ci_variance: (bool * bool) list;
-    ci_loc: Location.t }
+    ci_loc: Location.t;
+    ci_attributes: attribute list;
+   }
 
 (* Auxiliary functions over the a.s.t. *)
 
diff --git a/typing/typedtreeIter.ml b/typing/typedtreeIter.ml
index 7815556fc..1cf0af113 100644
--- a/typing/typedtreeIter.ml
+++ b/typing/typedtreeIter.ml
@@ -132,7 +132,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
         | Tstr_type list ->
             List.iter (fun (id, _, decl) -> iter_type_declaration decl) list
         | Tstr_exception (id, _, decl) -> iter_exception_declaration decl
-        | Tstr_exn_rebind (id, _, p, _) -> ()
+        | Tstr_exn_rebind _ -> ()
         | Tstr_module (id, _, mexpr) ->
             iter_module_expr mexpr
         | Tstr_recmodule list ->
@@ -154,8 +154,10 @@ module MakeIterator(Iter : IteratorArgument) : sig
                 iter_class_type ct.ci_expr;
                 Iter.leave_class_type_declaration ct;
             ) list
-        | Tstr_include (mexpr, _) ->
+        | Tstr_include (mexpr, _, _attrs) ->
             iter_module_expr mexpr
+        | Tstr_attribute _ ->
+            ()
       end;
       Iter.leave_structure_item item
 
@@ -194,7 +196,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
 
     and iter_pattern pat =
       Iter.enter_pattern pat;
-      List.iter (fun (cstr, _) -> match cstr with
+      List.iter (fun (cstr, _, _attrs) -> match cstr with
               | Tpat_type _ -> ()
               | Tpat_unpack -> ()
               | Tpat_constraint ct -> iter_core_type ct) pat.pat_extra;
@@ -225,7 +227,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
 
     and iter_expression exp =
       Iter.enter_expression exp;
-      List.iter (function (cstr, _) ->
+      List.iter (function (cstr, _, _attrs) ->
         match cstr with
           Texp_constraint (cty1, cty2) ->
             option iter_core_type cty1; option iter_core_type cty2
@@ -354,11 +356,12 @@ module MakeIterator(Iter : IteratorArgument) : sig
         | Tsig_modtype (id, _, mdecl) ->
             iter_modtype_declaration mdecl
         | Tsig_open _ -> ()
-        | Tsig_include (mty,_) -> iter_module_type mty
+        | Tsig_include (mty, _, _attrs) -> iter_module_type mty
         | Tsig_class list ->
             List.iter iter_class_description list
         | Tsig_class_type list ->
             List.iter iter_class_type_declaration list
+        | Tsig_attribute _ -> ()
       end;
       Iter.leave_signature_item item;
 
diff --git a/typing/typedtreeMap.ml b/typing/typedtreeMap.ml
index f455b2edd..a1cd0f811 100644
--- a/typing/typedtreeMap.ml
+++ b/typing/typedtreeMap.ml
@@ -108,8 +108,8 @@ module MakeMap(Map : MapArgument) = struct
               (id, name, map_type_declaration decl) ) list)
         | Tstr_exception (id, name, decl) ->
           Tstr_exception (id, name, map_exception_declaration decl)
-        | Tstr_exn_rebind (id, name, path, lid) ->
-          Tstr_exn_rebind (id, name, path, lid)
+        | Tstr_exn_rebind (id, name, path, lid, attrs) ->
+          Tstr_exn_rebind (id, name, path, lid, attrs)
         | Tstr_module (id, name, mexpr) ->
           Tstr_module (id, name, map_module_expr mexpr)
         | Tstr_recmodule list ->
@@ -121,7 +121,7 @@ module MakeMap(Map : MapArgument) = struct
           Tstr_recmodule list
         | Tstr_modtype (id, name, mtype) ->
           Tstr_modtype (id, name, map_module_type mtype)
-        | Tstr_open (path, lid) -> Tstr_open (path, lid)
+        | Tstr_open (path, lid, attrs) -> Tstr_open (path, lid, attrs)
         | Tstr_class list ->
           let list =
             List.map (fun (ci, string_list, virtual_flag) ->
@@ -139,8 +139,9 @@ module MakeMap(Map : MapArgument) = struct
             (id, name, Map.leave_class_infos { ct with ci_expr = ci_expr})
           ) list in
           Tstr_class_type list
-        | Tstr_include (mexpr, idents) ->
-          Tstr_include (map_module_expr mexpr, idents)
+        | Tstr_include (mexpr, idents, attrs) ->
+          Tstr_include (map_module_expr mexpr, idents, attrs)
+        | Tstr_attribute x -> Tstr_attribute x
     in
     Map.leave_structure_item { item with str_desc = str_desc}
 
@@ -183,7 +184,9 @@ module MakeMap(Map : MapArgument) = struct
     let exn_params = List.map map_core_type decl.exn_params in
     let decl =       { exn_params = exn_params;
                        exn_exn = decl.exn_exn;
-                       exn_loc = decl.exn_loc } in
+                       exn_loc = decl.exn_loc;
+                       exn_attributes = decl.exn_attributes;
+                      } in
     Map.leave_exception_declaration decl;
 
   and map_pattern pat =
@@ -220,8 +223,8 @@ module MakeMap(Map : MapArgument) = struct
 
   and map_pat_extra pat_extra =
     match pat_extra with
-      | Tpat_constraint ct, loc -> (Tpat_constraint (map_core_type  ct), loc)
-      | (Tpat_type _ | Tpat_unpack), _ -> pat_extra
+      | Tpat_constraint ct, loc, attrs -> (Tpat_constraint (map_core_type  ct), loc, attrs)
+      | (Tpat_type _ | Tpat_unpack), _, _ -> pat_extra
 
   and map_expression exp =
     let exp = Map.enter_expression exp in
@@ -349,20 +352,19 @@ module MakeMap(Map : MapArgument) = struct
     Map.leave_expression {
       exp with
         exp_desc = exp_desc;
-        exp_extra = exp_extra }
+        exp_extra = exp_extra; }
 
-  and map_exp_extra exp_extra =
-    let loc = snd exp_extra in
-    match fst exp_extra with
+  and map_exp_extra ((desc, loc, attrs) as exp_extra) =
+    match desc with
       | Texp_constraint (Some ct, None) ->
-        Texp_constraint (Some (map_core_type ct), None), loc
+        Texp_constraint (Some (map_core_type ct), None), loc, attrs
       | Texp_constraint (None, Some ct) ->
-        Texp_constraint (None, Some (map_core_type ct)), loc
+        Texp_constraint (None, Some (map_core_type ct)), loc, attrs
       | Texp_constraint (Some ct1, Some ct2) ->
         Texp_constraint (Some (map_core_type ct1),
-                         Some (map_core_type ct2)), loc
+                         Some (map_core_type ct2)), loc, attrs
       | Texp_poly (Some ct) ->
-        Texp_poly (Some ( map_core_type ct )), loc
+        Texp_poly (Some ( map_core_type ct )), loc, attrs
       | Texp_newtype _
       | Texp_constraint (None, None)
       | Texp_open _
@@ -401,11 +403,12 @@ module MakeMap(Map : MapArgument) = struct
               (id, name, map_module_type mtype) ) list)
         | Tsig_modtype (id, name, mdecl) ->
           Tsig_modtype (id, name, map_modtype_declaration mdecl)
-        | Tsig_open (path, lid) -> item.sig_desc
-        | Tsig_include (mty, lid) -> Tsig_include (map_module_type mty, lid)
+        | Tsig_open (path, lid, _attrs) -> item.sig_desc
+        | Tsig_include (mty, lid, attrs) -> Tsig_include (map_module_type mty, lid, attrs)
         | Tsig_class list -> Tsig_class (List.map map_class_description list)
         | Tsig_class_type list ->
           Tsig_class_type (List.map map_class_type_declaration list)
+        | Tsig_attribute _ as x -> x
     in
     Map.leave_signature_item { item with sig_desc = sig_desc }
 
diff --git a/typing/typemod.ml b/typing/typemod.ml
index c91cebe90..b2a8f9d7e 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -391,12 +391,13 @@ let transl_modtype_longident loc env lid =
   let (path, info) = Typetexp.find_modtype env loc lid in
   path
 
-let mkmty desc typ env loc =
+let mkmty desc typ env loc attrs =
   let mty = {
     mty_desc = desc;
     mty_type = typ;
     mty_loc = loc;
     mty_env = env;
+    mty_attributes = attrs;
     } in
   Cmt_format.add_saved_type (Cmt_format.Partial_module_type mty);
   mty
@@ -414,15 +415,18 @@ let rec transl_modtype env smty =
     Pmty_ident lid ->
       let path = transl_modtype_longident loc env lid.txt in
       mkmty (Tmty_ident (path, lid)) (Mty_ident path) env loc
+        smty.pmty_attributes
   | Pmty_signature ssg ->
       let sg = transl_signature env ssg in
       mkmty (Tmty_signature sg) (Mty_signature sg.sig_type) env loc
+        smty.pmty_attributes
   | Pmty_functor(param, sarg, sres) ->
       let arg = transl_modtype env sarg in
       let (id, newenv) = Env.enter_module param.txt arg.mty_type env in
       let res = transl_modtype newenv sres in
       mkmty (Tmty_functor (id, param, arg, res))
       (Mty_functor(id, arg.mty_type, res.mty_type)) env loc
+        smty.pmty_attributes
   | Pmty_with(sbody, constraints) ->
       let body = transl_modtype env sbody in
       let init_sg = extract_sig env sbody.pmty_loc body.mty_type in
@@ -435,10 +439,11 @@ let rec transl_modtype env smty =
         )
         ([],init_sg) constraints in
       mkmty (Tmty_with ( body, tcstrs))
-      (Mtype.freshen (Mty_signature final_sg)) env loc
+        (Mtype.freshen (Mty_signature final_sg)) env loc
+        smty.pmty_attributes
   | Pmty_typeof smod ->
       let tmty, mty = !type_module_type_of_fwd env smod in
-      mkmty (Tmty_typeof tmty) mty env loc
+      mkmty (Tmty_typeof tmty) mty env loc smty.pmty_attributes
   | Pmty_extension (s, _arg) ->
       raise (Error (smty.pmty_loc, env, Extension s))
 
@@ -512,11 +517,11 @@ and transl_signature env sg =
             mksig (Tsig_modtype (id, name, tinfo)) env loc :: trem,
             Sig_modtype(id, info) :: rem,
             final_env
-        | Psig_open (lid, _attrs) ->
+        | Psig_open (lid, attrs) ->
             let (path, newenv) = type_open env item.psig_loc lid in
             let (trem, rem, final_env) = transl_sig newenv srem in
-            mksig (Tsig_open (path,lid)) env loc :: trem, rem, final_env
-        | Psig_include (smty, _attrs) ->
+            mksig (Tsig_open (path,lid,attrs)) env loc :: trem, rem, final_env
+        | Psig_include (smty, attrs) ->
             let tmty = transl_modtype env smty in
             let mty = tmty.mty_type in
             let sg = Subst.signature Subst.identity
@@ -527,7 +532,7 @@ and transl_signature env sg =
               sg;
             let newenv = Env.add_signature sg env in
             let (trem, rem, final_env) = transl_sig newenv srem in
-            mksig (Tsig_include (tmty, sg)) env loc :: trem,
+            mksig (Tsig_include (tmty, sg, attrs)) env loc :: trem,
             remove_values (get_values rem) sg @ rem, final_env
         | Psig_class cl ->
             List.iter
@@ -571,8 +576,9 @@ and transl_signature env sg =
                     Sig_type(i'', d'', rs)])
                  classes [rem]),
             final_env
-        | Psig_attribute _ ->
-            transl_sig env srem
+        | Psig_attribute x ->
+            let (trem,rem, final_env) = transl_sig env srem in
+            mksig (Tsig_attribute x) env loc :: trem, rem, final_env
         | Psig_extension ((s, _), _) ->
             raise (Error (loc, env, Extension s))
   in
@@ -997,10 +1003,10 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
         (item :: str_rem,
          Sig_exception(id, arg.exn_exn) :: sig_rem,
          final_env)
-    | Pstr_exn_rebind(name, longid, _attrs) ->
+    | Pstr_exn_rebind(name, longid, attrs) ->
         let (path, arg) = Typedecl.transl_exn_rebind env loc longid.txt in
         let (id, newenv) = Env.enter_exception name.txt arg env in
-        let item = mk (Tstr_exn_rebind(id, name, path, longid)) in
+        let item = mk (Tstr_exn_rebind(id, name, path, longid, attrs)) in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (item :: str_rem,
          Sig_exception(id, arg) :: sig_rem,
@@ -1063,9 +1069,9 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
         (item :: str_rem,
          Sig_modtype(id, Modtype_manifest mty.mty_type) :: sig_rem,
          final_env)
-    | Pstr_open (lid, _attrs) ->
+    | Pstr_open (lid, attrs) ->
         let (path, newenv) = type_open ~toplevel env loc lid in
-        let item = mk (Tstr_open (path, lid)) in
+        let item = mk (Tstr_open (path, lid, attrs)) in
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (item :: str_rem, sig_rem, final_env)
     | Pstr_class cl ->
@@ -1125,7 +1131,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
                   Sig_type(i'', d'', rs)])
               classes [sig_rem]),
          final_env)
-    | Pstr_include (smodl, _attrs) ->
+    | Pstr_include (smodl, attrs) ->
         let modl = type_module true funct_body None env smodl in
         (* Rename all identifiers bound by this signature to avoid clashes *)
         let sg = Subst.signature Subst.identity
@@ -1133,15 +1139,16 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
         List.iter
           (check_sig_item type_names module_names modtype_names loc) sg;
         let new_env = Env.add_signature sg env in
-        let item = mk (Tstr_include (modl, bound_value_identifiers sg)) in
+        let item = mk (Tstr_include (modl, bound_value_identifiers sg, attrs)) in
         let (str_rem, sig_rem, final_env) = type_struct new_env srem in
         (item :: str_rem,
          sg @ sig_rem,
          final_env)
     | Pstr_extension ((s, _), _) ->
         raise (Error (loc, env, Extension s))
-    | Pstr_attribute _ ->
-        type_struct env srem
+    | Pstr_attribute x ->
+        let (str_rem, sig_rem, final_env) = type_struct env srem in
+        mk (Tstr_attribute x) :: str_rem, sig_rem, final_env
   in
   if !Clflags.annotations then
     (* moved to genannot *)
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 83f8b3be2..64664bd5f 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -212,11 +212,11 @@ let rec swap_list = function
 
 type policy = Fixed | Extensible | Univars
 
-let ctyp ctyp_desc ctyp_type ctyp_env ctyp_loc =
-  { ctyp_desc; ctyp_type; ctyp_env; ctyp_loc }
-
 let rec transl_type env policy styp =
   let loc = styp.ptyp_loc in
+  let ctyp ctyp_desc ctyp_type =
+    { ctyp_desc; ctyp_type; ctyp_env = env; ctyp_loc = loc; ctyp_attributes = styp.ptyp_attributes }
+  in
   match styp.ptyp_desc with
     Ptyp_any ->
       let ty =
@@ -225,7 +225,7 @@ let rec transl_type env policy styp =
             raise (Error (styp.ptyp_loc, env, Unbound_type_variable "_"))
           else newvar ()
       in
-      ctyp Ttyp_any ty env loc
+      ctyp Ttyp_any ty
   | Ptyp_var name ->
     let ty =
       if name <> "" && name.[0] = '_' then
@@ -242,16 +242,16 @@ let rec transl_type env policy styp =
         v
       end
     in
-    ctyp (Ttyp_var name) ty env loc
+    ctyp (Ttyp_var name) ty
   | Ptyp_arrow(l, st1, st2) ->
     let cty1 = transl_type env policy st1 in
     let cty2 = transl_type env policy st2 in
     let ty = newty (Tarrow(l, cty1.ctyp_type, cty2.ctyp_type, Cok)) in
-    ctyp (Ttyp_arrow (l, cty1, cty2)) ty env loc
+    ctyp (Ttyp_arrow (l, cty1, cty2)) ty
   | Ptyp_tuple stl ->
     let ctys = List.map (transl_type env policy) stl in
     let ty = newty (Ttuple (List.map (fun ctyp -> ctyp.ctyp_type) ctys)) in
-    ctyp (Ttyp_tuple ctys) ty env loc
+    ctyp (Ttyp_tuple ctys) ty
   | Ptyp_constr(lid, stl) ->
       let (path, decl) = find_type env styp.ptyp_loc lid.txt in
       if List.length stl <> decl.type_arity then
@@ -278,7 +278,7 @@ let rec transl_type env policy styp =
       with Unify trace ->
         raise (Error(styp.ptyp_loc, env, Type_mismatch trace))
       end;
-        ctyp (Ttyp_constr (path, lid, args)) constr env loc
+      ctyp (Ttyp_constr (path, lid, args)) constr
   | Ptyp_object fields ->
       let fields = List.map
           (fun pf ->
@@ -292,7 +292,7 @@ let rec transl_type env policy styp =
             { field_desc = desc; field_loc = pf.pfield_loc })
           fields in
       let ty = newobj (transl_fields env policy [] fields) in
-        ctyp (Ttyp_object fields) ty env loc
+      ctyp (Ttyp_object fields) ty
   | Ptyp_class(lid, stl, present) ->
       let (path, decl, is_variant) =
         try
@@ -375,7 +375,7 @@ let rec transl_type env policy styp =
       | _ ->
           assert false
       in
-        ctyp (Ttyp_class (path, lid, args, present)) ty env loc
+      ctyp (Ttyp_class (path, lid, args, present)) ty
   | Ptyp_alias(st, alias) ->
       let cty =
         try
@@ -412,7 +412,7 @@ let rec transl_type env policy styp =
           end;
           { ty with ctyp_type = t }
       in
-      ctyp (Ttyp_alias (cty, alias)) cty.ctyp_type env loc
+      ctyp (Ttyp_alias (cty, alias)) cty.ctyp_type
   | Ptyp_variant(fields, closed, present) ->
       let name = ref None in
       let mkfield l f =
@@ -514,7 +514,7 @@ let rec transl_type env policy styp =
         else { row with row_more = new_pre_univar () }
       in
       let ty = newty (Tvariant row) in
-      ctyp (Ttyp_variant (tfields, closed, present)) ty env loc
+      ctyp (Ttyp_variant (tfields, closed, present)) ty
    | Ptyp_poly(vars, st) ->
       begin_def();
       let new_univars = List.map (fun name -> name, newvar ~name ()) vars in
@@ -541,7 +541,7 @@ let rec transl_type env policy styp =
       in
       let ty' = Btype.newgenty (Tpoly(ty, List.rev ty_list)) in
       unify_var env (newvar()) ty';
-      ctyp (Ttyp_poly (vars, cty)) ty' env loc
+      ctyp (Ttyp_poly (vars, cty)) ty'
   | Ptyp_package (p, l) ->
       let l, mty = create_package_mty true styp.ptyp_loc env (p, l) in
       let z = narrow () in
@@ -555,12 +555,12 @@ let rec transl_type env policy styp =
                        List.map (fun (s, pty) -> s.txt) l,
                        List.map (fun (_,cty) -> cty.ctyp_type) ptys))
       in
-        ctyp (Ttyp_package {
-                pack_name = path;
-                pack_type = mty.mty_type;
-                pack_fields = ptys;
-                pack_txt = p;
-              }) ty env loc
+      ctyp (Ttyp_package {
+            pack_name = path;
+            pack_type = mty.mty_type;
+            pack_fields = ptys;
+            pack_txt = p;
+           }) ty
   | Ptyp_extension (s, _arg) ->
       raise (Error (loc, env, Extension s))