ast_{iter,mapper}: always traverse the attributes right after the loc…

…ation

Now that each node that supports attributes also has a location,
we want to make the attributed node's location robustly available
to AST traversal functions.

The best way to do this would be to change the "attributes" traverser
to take the node's location as extra parameter. However, doing this
changes the type of the traverser interface, with a risk of breaking
user code. This may be the right long-term change, but for now
we go with something weaker: we ensure that the attributes of a node
are always traversed right after the node's location, which lets
user track attributed location (if they wish) through a side-effect.

parsing/ast_iterator.ml

@@ -153,14 +153,18 @@ module T = struct
       {ptyext_path; ptyext_params;
        ptyext_constructors;
        ptyext_private = _;
+       ptyext_loc;
        ptyext_attributes} =
     iter_loc sub ptyext_path;
     List.iter (sub.extension_constructor sub) ptyext_constructors;
     List.iter (iter_fst (sub.typ sub)) ptyext_params;
+    sub.location sub ptyext_loc;
     sub.attributes sub ptyext_attributes
 
-  let iter_type_exception sub {ptyexn_constructor; ptyexn_attributes} =
+  let iter_type_exception sub
+      {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} =
     sub.extension_constructor sub ptyexn_constructor;
+    sub.location sub ptyexn_loc;
     sub.attributes sub ptyexn_attributes
 
   let iter_extension_constructor_kind sub = function
@@ -262,7 +266,8 @@ module MT = struct
     | Psig_class_type l ->
         List.iter (sub.class_type_declaration sub) l
     | Psig_extension (x, attrs) ->
-        sub.extension sub x; sub.attributes sub attrs
+        sub.attributes sub attrs;
+        sub.extension sub x
     | Psig_attribute x -> sub.attribute sub x
 end
 
@@ -291,7 +296,7 @@ module M = struct
     sub.location sub loc;
     match desc with
     | Pstr_eval (x, attrs) ->
-        sub.expr sub x; sub.attributes sub attrs
+        sub.attributes sub attrs; sub.expr sub x
     | Pstr_value (_r, vbs) -> List.iter (sub.value_binding sub) vbs
     | Pstr_primitive vd -> sub.value_description sub vd
     | Pstr_type (_rf, l) -> List.iter (sub.type_declaration sub) l
@@ -306,7 +311,7 @@ module M = struct
         List.iter (sub.class_type_declaration sub) l
     | Pstr_include x -> sub.include_declaration sub x
     | Pstr_extension (x, attrs) ->
-        sub.extension sub x; sub.attributes sub attrs
+        sub.attributes sub attrs; sub.extension sub x
     | Pstr_attribute x -> sub.attribute sub x
 end
 

parsing/ast_mapper.ml

@@ -90,13 +90,14 @@ module T = struct
 
   let row_field sub = function
     | Rtag (l, attrs, b, tl) ->
-        Rtag (map_loc sub l, sub.attributes sub attrs,
-              b, List.map (sub.typ sub) tl)
+        let attrs = sub.attributes sub attrs in
+        Rtag (map_loc sub l, attrs, b, List.map (sub.typ sub) tl)
     | Rinherit t -> Rinherit (sub.typ sub t)
 
   let object_field sub = function
     | Otag (l, attrs, t) ->
-        Otag (map_loc sub l, sub.attributes sub attrs, sub.typ sub t)
+        let attrs = sub.attributes sub attrs in
+        Otag (map_loc sub l, attrs, sub.typ sub t)
     | Oinherit t -> Oinherit (sub.typ sub t)
 
   let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} =
@@ -132,16 +133,16 @@ module T = struct
        ptype_manifest;
        ptype_attributes;
        ptype_loc} =
-    Type.mk (map_loc sub ptype_name)
+    let loc = sub.location sub ptype_loc in
+    let attrs = sub.attributes sub ptype_attributes in
+    Type.mk ~loc ~attrs (map_loc sub ptype_name)
       ~params:(List.map (map_fst (sub.typ sub)) ptype_params)
       ~priv:ptype_private
       ~cstrs:(List.map
                 (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub))
                 ptype_cstrs)
       ~kind:(sub.type_kind sub ptype_kind)
       ?manifest:(map_opt (sub.typ sub) ptype_manifest)
-      ~loc:(sub.location sub ptype_loc)
-      ~attrs:(sub.attributes sub ptype_attributes)
 
   let map_type_kind sub = function
     | Ptype_abstract -> Ptype_abstract
@@ -159,18 +160,22 @@ module T = struct
       {ptyext_path; ptyext_params;
        ptyext_constructors;
        ptyext_private;
+       ptyext_loc;
        ptyext_attributes} =
-    Te.mk
+    let loc = sub.location sub ptyext_loc in
+    let attrs = sub.attributes sub ptyext_attributes in
+    Te.mk ~loc ~attrs
       (map_loc sub ptyext_path)
       (List.map (sub.extension_constructor sub) ptyext_constructors)
       ~params:(List.map (map_fst (sub.typ sub)) ptyext_params)
       ~priv:ptyext_private
-      ~attrs:(sub.attributes sub ptyext_attributes)
 
-  let map_type_exception sub {ptyexn_constructor; ptyexn_attributes} =
-    Te.mk_exception
+  let map_type_exception sub
+      {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} =
+    let loc = sub.location sub ptyexn_loc in
+    let attrs = sub.attributes sub ptyexn_attributes in
+    Te.mk_exception ~loc ~attrs
       (sub.extension_constructor sub ptyexn_constructor)
-      ~attrs:(sub.attributes sub ptyexn_attributes)
 
   let map_extension_constructor_kind sub = function
       Pext_decl(ctl, cto) ->
@@ -183,11 +188,11 @@ module T = struct
        pext_kind;
        pext_loc;
        pext_attributes} =
-    Te.constructor
+    let loc = sub.location sub pext_loc in
+    let attrs = sub.attributes sub pext_attributes in
+    Te.constructor ~loc ~attrs
       (map_loc sub pext_name)
       (map_extension_constructor_kind sub pext_kind)
-      ~loc:(sub.location sub pext_loc)
-      ~attrs:(sub.attributes sub pext_attributes)
 
 end
 
@@ -279,7 +284,8 @@ module MT = struct
     | Psig_class_type l ->
         class_type ~loc (List.map (sub.class_type_declaration sub) l)
     | Psig_extension (x, attrs) ->
-        extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs)
+        let attrs = sub.attributes sub attrs in
+        extension ~loc ~attrs (sub.extension sub x)
     | Psig_attribute x -> attribute ~loc (sub.attribute sub x)
 end
 
@@ -311,7 +317,8 @@ module M = struct
     let loc = sub.location sub loc in
     match desc with
     | Pstr_eval (x, attrs) ->
-        eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x)
+        let attrs = sub.attributes sub attrs in
+        eval ~loc ~attrs (sub.expr sub x)
     | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs)
     | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd)
     | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l)
@@ -326,7 +333,8 @@ module M = struct
         class_type ~loc (List.map (sub.class_type_declaration sub) l)
     | Pstr_include x -> include_ ~loc (sub.include_declaration sub x)
     | Pstr_extension (x, attrs) ->
-        extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs)
+        let attrs = sub.attributes sub attrs in
+        extension ~loc ~attrs (sub.extension sub x)
     | Pstr_attribute x -> attribute ~loc (sub.attribute sub x)
 end
 
@@ -500,13 +508,13 @@ module CE = struct
 
   let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr;
                          pci_loc; pci_attributes} =
-    Ci.mk
+    let loc = sub.location sub pci_loc in
+    let attrs = sub.attributes sub pci_attributes in
+    Ci.mk ~loc ~attrs
      ~virt:pci_virt
      ~params:(List.map (map_fst (sub.typ sub)) pl)
       (map_loc sub pci_name)
       (f pci_expr)
-      ~loc:(sub.location sub pci_loc)
-      ~attrs:(sub.attributes sub pci_attributes)
 end
 
 (* Now, a generic AST mapper, to be extended to cover all kinds and