Skip to content

Commit

Permalink
Define Ocaml_common and Ocaml_413_extended internal libraries (ocaml-…
Browse files Browse the repository at this point in the history
…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
gpetiot authored Aug 23, 2021
1 parent 0b52d14 commit cfcc40d
Showing 38 changed files with 11,050 additions and 37 deletions.
4 changes: 2 additions & 2 deletions lib/Cmts.ml
Original file line number Diff line number Diff line change
@@ -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
1 change: 1 addition & 0 deletions lib/Extended_ast.ml
Original file line number Diff line number Diff line change
@@ -9,6 +9,7 @@
(* *)
(**************************************************************************)

open Ocaml_413_extended
include Parsetree

let equal_core_type : core_type -> core_type -> bool = Poly.equal
2 changes: 2 additions & 0 deletions lib/Extended_ast.mli
Original file line number Diff line number Diff line change
@@ -9,6 +9,8 @@
(* *)
(**************************************************************************)

open Ocaml_413_extended

include module type of Parsetree

type use_file = toplevel_phrase list
68 changes: 51 additions & 17 deletions lib/Normalize.ml
Original file line number Diff line number Diff line change
@@ -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 =
1 change: 0 additions & 1 deletion lib/Source.mli
Original file line number Diff line number Diff line change
@@ -9,7 +9,6 @@
(* *)
(**************************************************************************)

open Migrate_ast
open Extended_ast

type t
1 change: 1 addition & 0 deletions lib/Std_ast.ml
Original file line number Diff line number Diff line change
@@ -9,6 +9,7 @@
(* *)
(**************************************************************************)

open Ocaml_413
include Parsetree

type use_file = toplevel_phrase list
2 changes: 2 additions & 0 deletions lib/Std_ast.mli
Original file line number Diff line number Diff line change
@@ -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
16 changes: 8 additions & 8 deletions lib/Translation_unit.ml
Original file line number Diff line number Diff line change
@@ -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
10 changes: 9 additions & 1 deletion lib/dune
Original file line number Diff line number Diff line change
@@ -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
Loading
Oops, something went wrong.

0 comments on commit cfcc40d

Please sign in to comment.