Simplify Extended_ast vs Std_ast

Make Extended_ast the single entry point for parsing, validation, and
AST operations. Std_ast becomes a purely internal implementation detail.

Extended_ast.t GADT now uses paired wrapper types that embed both the
extended and standard ASTs: `('a, 'b) paired = {extended: 'a; std: 'b}`.
For the 7 OCaml fragment types (Structure, Signature, Use_file,
Core_type, Module_type, Expression, Pattern), parsing produces both
ASTs in one operation. Repl_file and Documentation have no std
counterpart.

Main changes:

- Add `('a, 'b) paired` record type to Extended_ast, used by the GADT
  for fragments with std parser support

- Extended_ast.Parse.ast now internally calls Std_ast.Parse.ast to
  produce the paired result. A `paired` helper factors out the common
  parse-normalize-pair pattern.

- Absorb Parse_with_comments into Extended_ast:
  - `Extended_ast.parse` is the full parsing pipeline (warnings,
    hash-bang, tokens, Source.t creation)
  - `Extended_ast.parse_toplevel` dispatches Use_file vs Repl_file
  - `Extended_ast.Parsed.t` replaces `Parse_with_comments.with_comments`
  - `Extended_ast.Warning50` replaces `Parse_with_comments.Warning50`
  - Delete Parse_with_comments.ml/.mli

- Documentation bypasses the OCaml parsing pipeline entirely (no
  hash-bang handling, no w50, no token collection)

- Add `Extended_ast.equivalent` to check AST preservation using the
  embedded std ASTs, returning `Ast_preserved | Docstrings_moved _
  | Ast_changed`. Includes a TODO for Repl_file/Documentation which
  currently skip the check.

- Add `Extended_ast.dump` and `dump_normalized` for debug output,
  falling back to extended AST printing for fragments without std

- Break Normalize_std_ast -> Normalize_extended_ast dependency by
  making `normalize_code` a parameter instead of an import

- Simplify Translation_unit: remove `std_fg`/`std_parsed` parameters
  from `format` and `parse_and_format`, remove `(type std)`, use
  `Extended_ast.equivalent` for validation. Translation_unit no longer
  references Std_ast directly.

- Clean up Std_ast: remove `of_syntax`, `any_t`, `Repl_file`,
  `Documentation` constructors, comment collection from Parse.ast

- Remove unused `Extended_ast.equal`, `equal_core_type`,
  `Normalize_extended_ast.equal`, `Normalize_extended_ast.ast`

- Break Source -> Extended_ast cycle (Source.ml only needs Parsetree)

- Document why Std_ast exists: the standard parser is used to verify
  formatting preserves semantics (two programs are equivalent if the
  compiler parses them identically)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>

Author: hhugo

lib/Extended_ast.ml

@@ -12,20 +12,22 @@
 open Ocamlformat_parser_extended
 include Parsetree
 
-let equal_core_type : core_type -> core_type -> bool = Poly.equal
-
 type use_file = toplevel_phrase list
 
 type repl_file = repl_phrase list
 
+module Std_parsetree = Ocamlformat_parser_standard.Parsetree
+
+type ('a, 'b) paired = {extended: 'a; std: 'b}
+
 type 'a t =
-  | Structure : structure t
-  | Signature : signature t
-  | Use_file : use_file t
-  | Core_type : core_type t
-  | Module_type : module_type t
-  | Expression : expression t
-  | Pattern : pattern t
+  | Structure : (structure, Std_parsetree.structure) paired t
+  | Signature : (signature, Std_parsetree.signature) paired t
+  | Use_file : (use_file, Std_parsetree.toplevel_phrase list) paired t
+  | Core_type : (core_type, Std_parsetree.core_type) paired t
+  | Module_type : (module_type, Std_parsetree.module_type) paired t
+  | Expression : (expression, Std_parsetree.expression) paired t
+  | Pattern : (pattern, Std_parsetree.pattern) paired t
   | Repl_file : repl_file t
   | Documentation : Ocamlformat_odoc_parser.Ast.t t
 
@@ -42,17 +44,16 @@ let of_syntax = function
   | Repl_file -> Any Repl_file
   | Documentation -> Any Documentation
 
-let equal (type a) (_ : a t) : a -> a -> bool = Poly.equal
-
 let map (type a) (x : a t) (m : Ast_mapper.mapper) : a -> a =
   match x with
-  | Structure -> m.structure m
-  | Signature -> m.signature m
-  | Use_file -> List.map ~f:(m.toplevel_phrase m)
-  | Core_type -> m.typ m
-  | Module_type -> m.module_type m
-  | Expression -> m.expr m
-  | Pattern -> m.pat m
+  | Structure -> fun v -> {v with extended= m.structure m v.extended}
+  | Signature -> fun v -> {v with extended= m.signature m v.extended}
+  | Use_file ->
+      fun v -> {v with extended= List.map ~f:(m.toplevel_phrase m) v.extended}
+  | Core_type -> fun v -> {v with extended= m.typ m v.extended}
+  | Module_type -> fun v -> {v with extended= m.module_type m v.extended}
+  | Expression -> fun v -> {v with extended= m.expr m v.extended}
+  | Pattern -> fun v -> {v with extended= m.pat m v.extended}
   | Repl_file -> List.map ~f:(m.repl_phrase m)
   | Documentation -> Fn.id
 
@@ -346,23 +347,51 @@ module Parse = struct
 
   let ast (type a) (fg : a t) ~ocaml_version ~preserve_beginend
       ~prefer_let_puns ~input_name str : a =
-    map fg
-      (normalize_mapper ~ocaml_version ~preserve_beginend ~prefer_let_puns)
-    @@
+    let nm =
+      normalize_mapper ~ocaml_version ~preserve_beginend ~prefer_let_puns
+    in
     let lexbuf = Lexing.from_string str in
-    let ocaml_version =
+    let ocaml_version_pair =
       Some Ocaml_version.(major ocaml_version, minor ocaml_version)
     in
     Location.init_info lexbuf input_name ;
+    let parse_std std_fg =
+      (* Suppress warnings during raw std parse to avoid duplicate w50
+         warnings — w50 handling is done separately by parse_ocaml *)
+      Warning.with_warning_filter
+        ~filter_warning:(fun _loc _warn -> false)
+        ~filter_alert:(fun _loc _alert -> false)
+        ~f:(fun () -> Std_ast.Parse.ast std_fg ~ocaml_version ~input_name str)
+    in
+    let paired normalize parse_ext std_fg =
+      let extended =
+        normalize nm (parse_ext ~ocaml_version:ocaml_version_pair lexbuf)
+      in
+      {extended; std= parse_std std_fg}
+    in
     match fg with
-    | Structure -> Parse.implementation ~ocaml_version lexbuf
-    | Signature -> Parse.interface ~ocaml_version lexbuf
-    | Use_file -> Parse.use_file ~ocaml_version lexbuf
-    | Core_type -> Parse.core_type ~ocaml_version lexbuf
-    | Module_type -> Parse.module_type ~ocaml_version lexbuf
-    | Expression -> Parse.expression ~ocaml_version lexbuf
-    | Pattern -> Parse.pattern ~ocaml_version lexbuf
-    | Repl_file -> Toplevel_lexer.repl_file ~ocaml_version lexbuf
+    | Structure ->
+        paired
+          (fun nm -> nm.structure nm)
+          Parse.implementation Std_ast.Structure
+    | Signature ->
+        paired (fun nm -> nm.signature nm) Parse.interface Std_ast.Signature
+    | Use_file ->
+        paired
+          (fun nm -> List.map ~f:(nm.toplevel_phrase nm))
+          Parse.use_file Std_ast.Use_file
+    | Core_type ->
+        paired (fun nm -> nm.typ nm) Parse.core_type Std_ast.Core_type
+    | Module_type ->
+        paired
+          (fun nm -> nm.module_type nm)
+          Parse.module_type Std_ast.Module_type
+    | Expression ->
+        paired (fun nm -> nm.expr nm) Parse.expression Std_ast.Expression
+    | Pattern -> paired (fun nm -> nm.pat nm) Parse.pattern Std_ast.Pattern
+    | Repl_file ->
+        List.map ~f:(nm.repl_phrase nm)
+          (Toplevel_lexer.repl_file ~ocaml_version:ocaml_version_pair lexbuf)
     | Documentation ->
         let pos = (Location.curr lexbuf).loc_start in
         let pos = {pos with pos_fname= input_name} in
@@ -377,13 +406,13 @@ module Printast = struct
   let repl_file = Format.pp_print_list repl_phrase
 
   let ast (type a) : a t -> _ -> a -> _ = function
-    | Structure -> implementation
-    | Signature -> interface
-    | Use_file -> use_file
-    | Core_type -> core_type
-    | Module_type -> module_type
-    | Expression -> expression
-    | Pattern -> pattern
+    | Structure -> fun fmt v -> implementation fmt v.extended
+    | Signature -> fun fmt v -> interface fmt v.extended
+    | Use_file -> fun fmt v -> use_file fmt v.extended
+    | Core_type -> fun fmt v -> core_type fmt v.extended
+    | Module_type -> fun fmt v -> module_type fmt v.extended
+    | Expression -> fun fmt v -> expression fmt v.extended
+    | Pattern -> fun fmt v -> pattern fmt v.extended
     | Repl_file -> repl_file
     | Documentation -> Docstring.dump
 end
@@ -395,3 +424,216 @@ module Asttypes = struct
 
   let is_recursive = function Recursive -> true | Nonrecursive -> false
 end
+
+type std_value = Std_value : 'a Std_ast.t * 'a -> std_value
+
+let get_std (type a) (fg : a t) (v : a) : std_value option =
+  match fg with
+  | Structure -> Some (Std_value (Structure, v.std))
+  | Signature -> Some (Std_value (Signature, v.std))
+  | Use_file -> Some (Std_value (Use_file, v.std))
+  | Core_type -> Some (Std_value (Core_type, v.std))
+  | Module_type -> Some (Std_value (Module_type, v.std))
+  | Expression -> Some (Std_value (Expression, v.std))
+  | Pattern -> Some (Std_value (Pattern, v.std))
+  | Repl_file -> None
+  | Documentation -> None
+
+type std_pair = Std_pair : 'a Std_ast.t * 'a * 'a -> std_pair
+
+let get_std_pair (type a) (fg : a t) (v1 : a) (v2 : a) : std_pair option =
+  match fg with
+  | Structure -> Some (Std_pair (Structure, v1.std, v2.std))
+  | Signature -> Some (Std_pair (Signature, v1.std, v2.std))
+  | Use_file -> Some (Std_pair (Use_file, v1.std, v2.std))
+  | Core_type -> Some (Std_pair (Core_type, v1.std, v2.std))
+  | Module_type -> Some (Std_pair (Module_type, v1.std, v2.std))
+  | Expression -> Some (Std_pair (Expression, v1.std, v2.std))
+  | Pattern -> Some (Std_pair (Pattern, v1.std, v2.std))
+  | Repl_file -> None
+  | Documentation -> None
+
+let dump (type a) (fg : a t) fmt (v : a) =
+  match get_std fg v with
+  | Some (Std_value (std_fg, std_v)) -> Std_ast.Printast.ast std_fg fmt std_v
+  | None -> Printast.ast fg fmt v
+
+let dump_normalized (type a) (fg : a t) ~normalize_code conf fmt (v : a) =
+  match get_std fg v with
+  | Some (Std_value (std_fg, std_v)) ->
+      Std_ast.Printast.ast std_fg fmt
+        (Normalize_std_ast.ast std_fg ~normalize_code conf std_v)
+  | None -> Printast.ast fg fmt v
+
+type ast_check_result =
+  | Ast_preserved
+  | Docstrings_moved of Cmt.error list
+  | Ast_changed
+
+let equivalent (type a) (fg : a t) ~normalize_code conf (old_v : a)
+    (new_v : a) : ast_check_result =
+  match get_std_pair fg old_v new_v with
+  | None ->
+      (* TODO: Repl_file and Documentation have no std AST, so we skip the
+         equivalence check.
+         - Repl_file: each toplevel phrase is OCaml code that could be
+           validated individually by parsing it with the standard parser.
+         - Documentation: OCaml code blocks inside .mld files are formatted
+           but never validated for AST preservation. We should check each
+           formatted code block by parsing it with the standard parser and
+           comparing. *)
+      Ast_preserved
+  | Some (Std_pair (std_fg, old_std, new_std)) ->
+      if
+        Normalize_std_ast.equal std_fg ~normalize_code
+          ~ignore_doc_comments:(not conf.Conf.opr_opts.comment_check.v)
+          conf old_std new_std
+      then Ast_preserved
+      else if
+        Normalize_std_ast.equal std_fg ~normalize_code
+          ~ignore_doc_comments:true conf old_std new_std
+      then
+        Docstrings_moved
+          (Normalize_std_ast.moved_docstrings ~normalize_code std_fg conf
+             old_std new_std )
+      else Ast_changed
+
+module Parsed = struct
+  type 'a t =
+    {ast: 'a; comments: Cmt.t list; prefix: string; source: Source.t}
+end
+
+exception Warning50 of (Location.t * Warnings.t) list
+
+module W = struct
+  type t = int
+
+  let in_lexer : t list = [1; 2; 3; 14; 29]
+
+  let disable x = -abs x
+
+  let enable x = abs x
+
+  let to_string x =
+    String.concat ~sep:"" (List.map ~f:(Format.sprintf "%+d") x)
+end
+
+let tokens lexbuf =
+  let rec loop acc =
+    match Lexer.token_with_comments lexbuf with
+    (* The location in lexbuf are invalid for comments *)
+    | COMMENT (_, loc) as tok -> loop ((tok, loc) :: acc)
+    | DOCSTRING ds as tok -> loop ((tok, Docstrings.docstring_loc ds) :: acc)
+    | tok -> (
+        let loc = Migrate_ast.Location.of_lexbuf lexbuf in
+        let acc = (tok, loc) :: acc in
+        match tok with EOF -> List.rev acc | _ -> loop acc )
+  in
+  loop []
+
+let fresh_lexbuf source =
+  let lexbuf = Lexing.from_string source in
+  Location.init_info lexbuf !Location.input_name ;
+  let hash_bang =
+    Lexer.skip_hash_bang lexbuf ;
+    let len = lexbuf.lex_last_pos in
+    String.sub source ~pos:0 ~len
+  in
+  (lexbuf, hash_bang)
+
+let split_hash_bang source =
+  let lexbuf = Lexing.from_string source in
+  Location.init_info lexbuf !Location.input_name ;
+  Lexer.skip_hash_bang lexbuf ;
+  let len = lexbuf.lex_last_pos in
+  let hash_bang = String.sub source ~pos:0 ~len in
+  let rest = String.sub source ~pos:len ~len:(String.length source - len) in
+  (rest, hash_bang)
+
+let collect_comments () =
+  List.map (Lexer.comments ()) ~f:(function
+    | `Comment txt, loc -> Cmt.create_comment txt loc
+    | `Docstring txt, loc -> Cmt.create_docstring txt loc )
+
+let parse_ocaml ?(disable_w50 = false) ?(disable_deprecated = false) fg
+    (conf : Conf.t) ~input_name ~source =
+  let warnings =
+    if conf.opr_opts.quiet.v then List.map ~f:W.disable W.in_lexer else []
+  in
+  let warnings = if disable_w50 then warnings else W.enable 50 :: warnings in
+  ignore @@ Warnings.parse_options false (W.to_string warnings) ;
+  let w50 = ref [] in
+  let t =
+    let source, hash_bang = split_hash_bang source in
+    Warning.with_warning_filter
+      ~filter_warning:(fun loc warn ->
+        if
+          Warning.is_unexpected_docstring warn
+          && conf.opr_opts.comment_check.v
+        then (
+          w50 := (loc, warn) :: !w50 ;
+          false )
+        else not conf.opr_opts.quiet.v )
+      ~filter_alert:(fun _loc alert ->
+        if Warning.is_deprecated_alert alert && disable_deprecated then false
+        else not conf.opr_opts.quiet.v )
+      ~f:(fun () ->
+        let ocaml_version = conf.opr_opts.ocaml_version.v in
+        let preserve_beginend =
+          Poly.(conf.fmt_opts.exp_grouping.v = `Preserve)
+        in
+        let prefer_let_puns =
+          match conf.fmt_opts.letop_punning.v with
+          | `Always -> Some true
+          | `Never -> Some false
+          | `Preserve -> None
+        in
+        let ast =
+          Parse.ast fg ~ocaml_version ~preserve_beginend ~prefer_let_puns
+            ~input_name source
+        in
+        let comments = collect_comments () in
+        Warnings.check_fatal () ;
+        let tokens =
+          let lexbuf, _ = fresh_lexbuf source in
+          tokens lexbuf
+        in
+        let source = Source.create ~text:source ~tokens in
+        {Parsed.ast; comments; prefix= hash_bang; source} )
+  in
+  match List.rev !w50 with [] -> t | w50 -> raise (Warning50 w50)
+
+let parse (type a) ?disable_w50 ?disable_deprecated (fg : a t) conf
+    ~input_name ~source : a Parsed.t =
+  match fg with
+  | Documentation ->
+      let pos = {Lexing.dummy_pos with pos_fname= input_name} in
+      let ast = Docstring.parse_file pos source in
+      { Parsed.ast
+      ; comments= []
+      ; prefix= ""
+      ; source= Source.create ~text:source ~tokens:[] }
+  | fg ->
+      parse_ocaml ?disable_w50 ?disable_deprecated fg conf ~input_name
+        ~source
+
+(** [is_repl_block x] returns whether [x] is a list of REPL phrases and
+    outputs of the form:
+
+    {v
+    # let this is = some phrase;;
+    this is some output
+    v} *)
+let is_repl_block x =
+  String.length x >= 2 && Char.equal x.[0] '#' && Char.is_whitespace x.[1]
+
+let parse_toplevel ?disable_w50 ?disable_deprecated (conf : Conf.t)
+    ~input_name ~source =
+  if is_repl_block source && conf.fmt_opts.parse_toplevel_phrases.v then
+    Either.Second
+      (parse ?disable_w50 ?disable_deprecated Repl_file conf ~input_name
+         ~source )
+  else
+    First
+      (parse ?disable_w50 ?disable_deprecated Use_file conf ~input_name
+         ~source )