Absorb Parse_with_comments into Extended_ast, simplify Translation_unit

Move the parsing pipeline (warnings, hash-bang, tokens, Source.t
creation) from Parse_with_comments into Extended_ast:

- Extended_ast.parse is the full parsing pipeline
- 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

Simplify Translation_unit: remove std_fg/std_parsed parameters from
format and parse_and_format, use Extended_ast.equivalent for AST
validation. Translation_unit no longer references Std_ast directly.

Rewrite printast tool to use the unified Extended_ast.parse API.

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

Author: hhugo

lib/Extended_ast.ml

@@ -425,6 +425,146 @@ module Asttypes = struct
   let is_recursive = function Recursive -> true | Nonrecursive -> false
 end
 
+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 )
+
 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 =

lib/Extended_ast.mli

@@ -39,17 +39,6 @@ type any_t = Any : 'a t -> any_t [@@unboxed]
 
 val of_syntax : Syntax.t -> any_t
 
-module Parse : sig
-  val ast :
-       'a t
-    -> ocaml_version:Ocaml_version.t
-    -> preserve_beginend:bool
-    -> prefer_let_puns:bool option
-    -> input_name:string
-    -> string
-    -> 'a
-end
-
 val map : 'a t -> Ast_mapper.mapper -> 'a -> 'a
 
 module Printast : sig
@@ -66,6 +55,36 @@ module Asttypes : sig
   val is_recursive : rec_flag -> bool
 end
 
+module Parsed : sig
+  type 'a t =
+    {ast: 'a; comments: Cmt.t list; prefix: string; source: Source.t}
+end
+
+exception Warning50 of (Location.t * Warnings.t) list
+
+val parse :
+     ?disable_w50:bool
+  -> ?disable_deprecated:bool
+  -> 'a t
+  -> Conf.t
+  -> input_name:string
+  -> source:string
+  -> 'a Parsed.t
+(** Parse source with warning handling, hash-bang detection, and token
+    collection. For paired fragment types, also parses with the standard
+    parser. *)
+
+val parse_toplevel :
+     ?disable_w50:bool
+  -> ?disable_deprecated:bool
+  -> Conf.t
+  -> input_name:string
+  -> source:string
+  -> ( (use_file, Std_parsetree.toplevel_phrase list) paired Parsed.t
+     , repl_file Parsed.t )
+     Either.t
+(** Parse source as toplevel phrases or REPL phrases depending on content. *)
+
 type std_value = Std_value : 'a Std_ast.t * 'a -> std_value
 
 val get_std : 'a t -> 'a -> std_value option

lib/Fmt_ast.ml

@@ -5144,13 +5144,13 @@ let fmt_code ~debug =
     let warn = fmt_opts.parse_toplevel_phrases.v in
     let input_name = !Location.input_name in
     match
-      Parse_with_comments.parse_toplevel ~disable_deprecated:true conf
-        ~input_name ~source:s
+      Extended_ast.parse_toplevel ~disable_deprecated:true conf ~input_name
+        ~source:s
     with
-    | Either.First {ast; comments; source; prefix= _} ->
+    | Either.First {Parsed.ast; comments; source; prefix= _} ->
         fmt_parse_result conf ~debug Use_file ast source comments ~set_margin
           ~fmt_code
-    | Second {ast; comments; source; prefix= _} ->
+    | Second {Parsed.ast; comments; source; prefix= _} ->
         fmt_parse_result conf ~debug Repl_file ast source comments
           ~set_margin ~fmt_code
     | exception Syntaxerr.Error (Expecting (_, x)) when warn ->

lib/Normalize_extended_ast.ml

@@ -54,11 +54,11 @@ let normalize_parse_result ~normalize_cmt ast_kind ast comments =
 let normalize_code ~normalize_cmt conf (m : Ast_mapper.mapper) txt =
   let input_name = "<output>" in
   let normalize_cmt = normalize_cmt conf in
-  match Parse_with_comments.parse_toplevel conf ~input_name ~source:txt with
-  | First {ast; comments; _} ->
+  match Extended_ast.parse_toplevel conf ~input_name ~source:txt with
+  | First {Parsed.ast; comments; _} ->
       normalize_parse_result ~normalize_cmt Use_file (map Use_file m ast)
         comments
-  | Second {ast; comments; _} ->
+  | Second {Parsed.ast; comments; _} ->
       normalize_parse_result ~normalize_cmt Repl_file
         (List.map ~f:(m.repl_phrase m) ast)
         comments