Adress review comments

bin/ocamlformat/dune

@@ -14,6 +14,7 @@
  (public_name ocamlformat)
  (package ocamlformat)
  (modules main)
+ (modes native byte)
  (flags
   (:standard -open Ocamlformat_stdlib))
  (instrumentation

lib/Exposed.ml

@@ -59,7 +59,7 @@ module Right = struct
     | {pcd_args= args; _} -> constructor_arguments args
 
   let type_declaration = function
-    | {ptype_attributes; _} when Ast.Ext_attrs.has_attrs ptype_attributes ->
+    | {ptype_attributes={attrs_after=_::_; _}; _} ->
         false
     | {ptype_cstrs= _ :: _ as cstrs; _} ->
         (* type a = ... constraint left = < ... > *)

lib/Fmt_ast.ml

@@ -3554,6 +3554,7 @@ and fmt_type_exception ~pre c ctx
   let {pext_attributes= cons_attrs; _} = ptyexn_constructor in
   (* Here, the order is very important. We need the attrs_after to be at the
      end of the list. *)
+  (* On 4.08 the doc is attached to the constructor *)
   let docs, cons_attrs = extract_doc_attrs [] cons_attrs in
   let docs, attrs_after = extract_doc_attrs docs item_attrs.attrs_after in
   let docs, attrs_before = extract_doc_attrs docs item_attrs.attrs_before in
@@ -4390,7 +4391,7 @@ and fmt_structure_item c ~last:last_item ~semisemi {ctx= parent_ctx; ast= si}
       fmt_recmodule c ctx mbs fmt_module_binding (fun x -> Mb x) sub_mb
   | Pstr_type (rec_flag, decls) -> fmt_type c rec_flag decls ctx
   | Pstr_typext te -> fmt_type_extension c ctx te
-  | Pstr_value {pvbs_rec= rec_flag; pvbs_bindings= bindings; pvbs_has_ext= _}
+  | Pstr_value {pvbs_rec= rec_flag; pvbs_bindings= bindings }
     ->
       let update_config c i =
         update_config ~quiet:true c

test/passing/tests/attributes.ml

@@ -1,3 +1,5 @@
+[%foo type[@foo] t = < .. > ]
+
 let _ = (function[@warning "-4"] None -> true | _ -> false) None
 
 let f (x [@warning ""]) = ()

test/passing/tests/attributes.ml.err

@@ -1 +1 @@
-Warning: tests/attributes.ml:340 exceeds the margin
+Warning: tests/attributes.ml:342 exceeds the margin

vendor/parser-extended/ast_mapper.ml

@@ -636,9 +636,9 @@ module E = struct
 end
 
 module PVB = struct
-  let map_value_bindings sub { pvbs_bindings; pvbs_rec; pvbs_has_ext } =
+  let map_value_bindings sub { pvbs_bindings; pvbs_rec } =
     let pvbs_bindings = List.map (sub.value_binding sub) pvbs_bindings in
-    { pvbs_bindings; pvbs_rec; pvbs_has_ext }
+    { pvbs_bindings; pvbs_rec }
 end
 
 module P = struct

vendor/parser-extended/parser.mly

@@ -476,7 +476,7 @@ let mklbs rf lb =
   } in
   addlb lbs lb
 
-let mk_let_bindings { lbs_bindings; lbs_rec; lbs_has_ext } =
+let mk_let_bindings { lbs_bindings; lbs_rec; lbs_has_ext=_ } =
   let pvbs_bindings =
     List.rev_map
       (fun lb ->
@@ -485,7 +485,7 @@ let mk_let_bindings { lbs_bindings; lbs_rec; lbs_has_ext } =
            lb.lb_pattern lb.lb_args lb.lb_expression)
       lbs_bindings
   in
-  { pvbs_bindings; pvbs_rec = lbs_rec; pvbs_has_ext = lbs_has_ext }
+  { pvbs_bindings; pvbs_rec = lbs_rec }
 
 let val_of_let_bindings ~loc lbs =
   mkstr ~loc (Pstr_value (mk_let_bindings lbs))
@@ -1494,27 +1494,27 @@ module_type_declaration:
 (* Opens. *)
 
 open_declaration:
-    OPEN
-    override = override_flag
-    ext = ext
-    before = attributes
-    me = module_expr
-    after = post_item_attributes
-    { let attrs = Attr.ext_attrs ?ext ~before ~after () in
-      let loc = make_loc $sloc in
-      let docs = symbol_docs $sloc in
-      Opn.mk me ~override ~attrs ~loc ~docs }
+  OPEN
+  override = override_flag
+  ext = ext
+  attrs1 = attributes
+  me = module_expr
+  attrs2 = post_item_attributes
+  { let attrs = Attr.ext_attrs ?ext ~before:attrs1 ~after:attrs2 () in
+    let loc = make_loc $sloc in
+    let docs = symbol_docs $sloc in
+    Opn.mk me ~override ~attrs ~loc ~docs }
 ;
 
 open_description:
   OPEN
   override = override_flag
   ext = ext
-  before = attributes
+  attrs1 = attributes
   id = mkrhs(mod_ext_longident)
-  after = post_item_attributes
+  attrs2 = post_item_attributes
   {
-    let attrs = Attr.ext_attrs ?ext ~before ~after () in
+    let attrs = Attr.ext_attrs ?ext ~before:attrs1 ~after:attrs2 () in
     let loc = make_loc $sloc in
     let docs = symbol_docs $sloc in
     Opn.mk id ~override ~attrs ~loc ~docs
@@ -2524,25 +2524,25 @@ let_bindings(EXT):
 %inline let_binding(EXT):
   LET
   ext = EXT
-  before = attributes
+  attrs1 = attributes
   rec_flag = rec_flag
   body = let_binding_body
-  after = post_item_attributes
+  attrs2 = post_item_attributes
     {
       let docs = symbol_docs $sloc in
-      let attrs = Attr.ext_attrs ?ext ~after ~before () in
+      let attrs = Attr.ext_attrs ?ext ~before:attrs1 ~after:attrs2 () in
       mklbs rec_flag (mklb ~loc:$sloc body ~docs attrs)
     }
 ;
 and_let_binding:
   AND
-  before = attributes
+  attrs1 = attributes
   body = let_binding_body
-  after = post_item_attributes
+  attrs2 = post_item_attributes
     {
       let text = symbol_text $symbolstartpos in
       let docs = symbol_docs $sloc in
-      let attrs = Attr.ext_attrs ~after ~before () in
+      let attrs = Attr.ext_attrs ~before:attrs1 ~after:attrs2 () in
       mklb ~text ~docs ~loc:$sloc body attrs
     }
 ;
@@ -3089,33 +3089,33 @@ str_exception_declaration:
     { $1 }
 | EXCEPTION
   ext = ext
-  before = attributes
+  attrs1 = attributes
   id = mkrhs(constr_ident)
   EQUAL
   lid = mkrhs(constr_longident)
-  attrs_inside = attributes
-  after = post_item_attributes
+  attrs2 = attributes
+  attrs = post_item_attributes
   { let loc = make_loc $sloc in
     let docs = symbol_docs $sloc in
-    let attrs = Attr.ext_attrs ~before ~after ?ext () in
+    let attrs = Attr.ext_attrs ~before:attrs1 ~after:attrs ?ext () in
     Te.mk_exception ~attrs
-      (Te.rebind id lid ~attrs:attrs_inside ~loc ~docs)
+      (Te.rebind id lid ~attrs:attrs2 ~loc ~docs)
   }
 ;
 sig_exception_declaration:
   EXCEPTION
   ext = ext
-  before = attributes
+  attrs1 = attributes
   id = mkrhs(constr_ident)
   vars_args_res = generalized_constructor_arguments
-  attrs_inside = attributes
-  after = post_item_attributes
+  attrs2 = attributes
+  attrs = post_item_attributes
     { let vars, args, res = vars_args_res in
-      let loc = make_loc ($startpos, $endpos(attrs_inside)) in
+      let loc = make_loc ($startpos, $endpos(attrs2)) in
       let docs = symbol_docs $sloc in
-      let attrs = Attr.ext_attrs ~before ~after ?ext () in
+      let attrs = Attr.ext_attrs ~before:attrs1 ~after:attrs ?ext () in
       Te.mk_exception ~attrs
-        (Te.decl id ~vars ~args ?res ~attrs:attrs_inside ~loc ~docs)
+        (Te.decl id ~vars ~args ?res ~attrs:attrs2 ~loc ~docs)
     }
 ;
 %inline let_exception_declaration:
@@ -3177,16 +3177,16 @@ label_declaration_semi:
 %inline type_extension(declaration):
   TYPE
   ext = ext
-  before = attributes
+  attrs1 = attributes
   no_nonrec_flag
   params = type_parameters
   tid = mkrhs(type_longident)
   PLUSEQ
   priv = private_flag
   cs = bar_llist(declaration)
-  after = post_item_attributes
+  attrs2 = post_item_attributes
     { let docs = symbol_docs $sloc in
-      let attrs = Attr.ext_attrs ?ext ~before ~after () in
+      let attrs = Attr.ext_attrs ?ext ~before:attrs1 ~after:attrs2 () in
       Te.mk tid cs ~params ~priv ~attrs ~docs }
 ;
 %inline extension_constructor(opening):

vendor/parser-extended/parsetree.mli

@@ -1115,7 +1115,6 @@ and value_binding =
 and value_bindings =
   {
     pvbs_bindings: value_binding list;
-    pvbs_has_ext: bool;
     pvbs_rec: rec_flag;
   }