Define Ocaml_common and Ocaml_413_extended internal libraries (ocaml-ppx#1774)

* Define Ocaml_common that contains common bits of Ocaml_413 and Ocaml_413_extended
* Define Ocaml_413_extended that is a copy of Ocaml_413 for now
* Align parse-wyc parser on Ocaml_413_extended
* Fix the distinction of std ast/extended ast in the AST validation made in Translation_unit/Normalize that show errors now that there are 2 distinct types

Author: Guillaume Petiot

lib/Cmts.ml

@@ -563,12 +563,12 @@ let diff (conf : Conf.t) x y =
             let len = String.length str - chars_removed in
             let source = String.sub ~pos:1 ~len str in
             match
-              Parse_with_comments.parse Extended_ast.Parse.ast Structure conf
+              Parse_with_comments.parse Std_ast.Parse.ast Structure conf
                 ~source
             with
             | exception _ -> norm_non_code z
             | {ast; _} ->
-                Caml.Format.asprintf "%a" Extended_ast.Pprintast.structure
+                Caml.Format.asprintf "%a" Std_ast.Pprintast.structure
                   (Normalize.normalize Structure conf ast)
           else norm_non_code z
     in

lib/Extended_ast.ml

@@ -9,6 +9,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Ocaml_413_extended
 include Parsetree
 
 let equal_core_type : core_type -> core_type -> bool = Poly.equal

lib/Extended_ast.mli

@@ -9,6 +9,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Ocaml_413_extended
+
 include module type of Parsetree
 
 type use_file = toplevel_phrase list

lib/Normalize.ml

@@ -11,12 +11,13 @@
 
 (** Normalize abstract syntax trees *)
 
-open Migrate_ast
-open Asttypes
-open Std_ast
-open Ast_helper
+type conf =
+  {conf: Conf.t; normalize_code: Std_ast.structure -> Std_ast.structure}
 
-type conf = {conf: Conf.t; normalize_code: structure -> structure}
+let is_doc = function
+  | Std_ast.{attr_name= {Location.txt= "ocaml.doc" | "ocaml.text"; _}; _} ->
+      true
+  | _ -> false
 
 (** Remove comments that duplicate docstrings (or other comments). *)
 let dedup_cmts fragment ast comments =
@@ -46,6 +47,34 @@ let dedup_cmts fragment ast comments =
   in
   Set.(to_list (diff (of_list (module Cmt) comments) (of_ast ast)))
 
+let dedup_cmts_std fragment ast comments =
+  let open Std_ast in
+  let open Ocaml_413 in
+  let of_ast ast =
+    let docs = ref (Set.empty (module Cmt)) in
+    let attribute m atr =
+      match atr with
+      | { attr_payload=
+            PStr
+              [ { pstr_desc=
+                    Pstr_eval
+                      ( { pexp_desc=
+                            Pexp_constant (Pconst_string (doc, _, None))
+                        ; pexp_loc
+                        ; _ }
+                      , [] )
+                ; _ } ]
+        ; _ }
+        when is_doc atr ->
+          docs := Set.add !docs (Cmt.create ("*" ^ doc) pexp_loc) ;
+          atr
+      | _ -> Ast_mapper.default_mapper.attribute m atr
+    in
+    map fragment {Ast_mapper.default_mapper with attribute} ast |> ignore ;
+    !docs
+  in
+  Set.(to_list (diff (of_list (module Cmt) comments) (of_ast ast)))
+
 let comment s =
   (* normalize consecutive whitespace chars to a single space *)
   String.concat ~sep:" "
@@ -102,19 +131,19 @@ let rec odoc_nestable_block_element c fmt = function
       let txt =
         try
           let ({ast; comments; _} : _ Parse_with_comments.with_comments) =
-            Parse_with_comments.parse Extended_ast.Parse.ast Structure c.conf
+            Parse_with_comments.parse Std_ast.Parse.ast Structure c.conf
               ~source:txt
           in
-          let comments = dedup_cmts Structure ast comments in
+          let comments = dedup_cmts_std Structure ast comments in
           let print_comments fmt (l : Cmt.t list) =
             List.sort l ~compare:(fun {Cmt.loc= a; _} {Cmt.loc= b; _} ->
-                Location.compare a b )
+                Migrate_ast.Location.compare a b )
             |> List.iter ~f:(fun {Cmt.txt; _} ->
                    Caml.Format.fprintf fmt "%s," txt )
           in
           let ast = c.normalize_code ast in
           Caml.Format.asprintf "AST,%a,COMMENTS,[%a]"
-            Extended_ast.Pprintast.structure ast print_comments comments
+            Std_ast.Pprintast.structure ast print_comments comments
         with _ -> txt
       in
       fpf fmt "Code_block(%a, %a)" (option (ign_loc str)) metadata str txt
@@ -174,10 +203,13 @@ let docstring c text =
     let parsed = Odoc_parser.parse_comment ~location ~text in
     Format.asprintf "Docstring(%a)%!" (odoc_docs c) (Odoc_parser.ast parsed)
 
-let sort_attributes : attributes -> attributes =
+let sort_attributes : Std_ast.attributes -> Std_ast.attributes =
   List.sort ~compare:Poly.compare
 
 let make_mapper conf ~ignore_doc_comments =
+  let open Std_ast in
+  let open Ocaml_413 in
+  let open Ast_helper in
   (* remove locations *)
   let location _ _ = Location.none in
   let attribute (m : Ast_mapper.mapper) (attr : attribute) =
@@ -190,7 +222,7 @@ let make_mapper conf ~ignore_doc_comments =
                       ; _ } as exp )
                   , [] )
             ; _ } as pstr ) ]
-      when Ast.Attr.is_doc attr ->
+      when is_doc attr ->
         let doc' = docstring {conf; normalize_code= m.structure m} doc in
         Ast_mapper.default_mapper.attribute m
           { attr with
@@ -211,7 +243,7 @@ let make_mapper conf ~ignore_doc_comments =
   let attributes (m : Ast_mapper.mapper) (atrs : attribute list) =
     let atrs =
       if ignore_doc_comments then
-        List.filter atrs ~f:(fun a -> not (Ast.Attr.is_doc a))
+        List.filter atrs ~f:(fun a -> not (is_doc a))
       else atrs
     in
     Ast_mapper.default_mapper.attributes m (sort_attributes atrs)
@@ -265,15 +297,17 @@ let make_mapper conf ~ignore_doc_comments =
   ; typ }
 
 let normalize fragment ~ignore_doc_comments c =
-  map fragment (make_mapper c ~ignore_doc_comments)
+  Std_ast.map fragment (make_mapper c ~ignore_doc_comments)
 
 let equal fragment ~ignore_doc_comments c ast1 ast2 =
   let map = normalize fragment c ~ignore_doc_comments in
-  equal fragment (map ast1) (map ast2)
+  Std_ast.equal fragment (map ast1) (map ast2)
 
 let normalize = normalize ~ignore_doc_comments:false
 
 let make_docstring_mapper docstrings =
+  let open Std_ast in
+  let open Ocaml_413 in
   let attribute (m : Ast_mapper.mapper) attr =
     match (attr.attr_name, attr.attr_payload) with
     | ( {txt= "ocaml.doc" | "ocaml.text"; loc}
@@ -290,14 +324,14 @@ let make_docstring_mapper docstrings =
   in
   (* sort attributes *)
   let attributes (m : Ast_mapper.mapper) atrs =
-    let atrs = List.filter atrs ~f:Ast.Attr.is_doc in
+    let atrs = List.filter atrs ~f:is_doc in
     Ast_mapper.default_mapper.attributes m (sort_attributes atrs)
   in
   {Ast_mapper.default_mapper with attribute; attributes}
 
-let docstrings (type a) (fragment : a t) s =
+let docstrings (type a) (fragment : a Std_ast.t) s =
   let docstrings = ref [] in
-  let (_ : a) = map fragment (make_docstring_mapper docstrings) s in
+  let (_ : a) = Std_ast.map fragment (make_docstring_mapper docstrings) s in
   !docstrings
 
 type docstring_error =

lib/Source.mli

@@ -9,7 +9,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Migrate_ast
 open Extended_ast
 
 type t

lib/Std_ast.ml

@@ -9,6 +9,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Ocaml_413
 include Parsetree
 
 type use_file = toplevel_phrase list

lib/Std_ast.mli

@@ -11,6 +11,8 @@
 
 (** Interface over the AST defined in vendor/ocaml-4.13 *)
 
+open Ocaml_413
+
 include module type of Parsetree
 
 type use_file = toplevel_phrase list

lib/Translation_unit.ml

@@ -276,7 +276,7 @@ let collect_strlocs (type a) (fg : a Extended_ast.t) (ast : a) :
   let compare (c1, _) (c2, _) = Stdlib.compare c1 c2 in
   List.sort ~compare !locs
 
-let format (type a) (fg : a Extended_ast.t) (std_fg : a Std_ast.t)
+let format (type a b) (fg : a Extended_ast.t) (std_fg : b Std_ast.t)
     ?output_file ~input_name ~prev_source ~parsed ~std_parsed conf opts =
   let open Result.Monad_infix in
   let dump_ast fg ~suffix ast =
@@ -365,10 +365,10 @@ let format (type a) (fg : a Extended_ast.t) (std_fg : a Std_ast.t)
           |> List.filter_map ~f:(fun (s, f_opt) ->
                  Option.map f_opt ~f:(fun f -> (s, String.sexp_of_t f)) )
         in
-        if equal std_fg ~ignore_doc_comments:true conf t t_new then
+        if equal std_fg ~ignore_doc_comments:true conf std_t std_t_new then
           let docstrings =
-            Normalize.moved_docstrings std_fg conf t.Parse_with_comments.ast
-              t_new.Parse_with_comments.ast
+            Normalize.moved_docstrings std_fg conf
+              std_t.Parse_with_comments.ast std_t_new.Parse_with_comments.ast
           in
           let args = args ~suffix:".unequal-docs" in
           internal_error (`Doc_comment docstrings) args
@@ -467,8 +467,8 @@ let normalize_eol ~strlocs ~line_endings s =
   in
   loop strlocs 0
 
-let parse_and_format (type a) (fg : a Extended_ast.t) (std_fg : a Std_ast.t)
-    ?output_file ~input_name ~source conf opts =
+let parse_and_format (type a b) (fg : a Extended_ast.t)
+    (std_fg : b Std_ast.t) ?output_file ~input_name ~source conf opts =
   Location.input_name := input_name ;
   parse_result Extended_ast.Parse.ast ~disable_w50:true fg conf ~source
     ~input_name
@@ -502,8 +502,8 @@ let check_range nlines (low, high) =
   else
     Error (Error.User_error (Format.sprintf "Invalid range %i-%i" low high))
 
-let numeric (type a) (fg : a list Extended_ast.t) (std_fg : a list Std_ast.t)
-    ~input_name ~source ~range conf opts =
+let numeric (type a b) (fg : a list Extended_ast.t)
+    (std_fg : b list Std_ast.t) ~input_name ~source ~range conf opts =
   let lines = String.split_lines source in
   let nlines = List.length lines in
   check_range nlines range

lib/dune

@@ -14,12 +14,20 @@
 (library
  (name ocamlformat_lib)
  (flags
-  (:standard -open Ocaml_413 -open Ocamlformat_stdlib))
+  (:standard
+   -open
+   Ocaml_common
+   -open
+   Ocaml_413_extended
+   -open
+   Ocamlformat_stdlib))
  (instrumentation
   (backend bisect_ppx))
  (libraries
   format_
+  ocaml_common
   ocaml_413
+  ocaml_413_extended
   ocamlformat_stdlib
   ocaml-version
   ocp-indent.lib