这是indexloc提供的服务,不要输入任何密码
Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 8 additions & 0 deletions doc/manpage_ocamlformat.mld
Original file line number Diff line number Diff line change
Expand Up @@ -334,6 +334,9 @@ OPTIONS (CODE FORMATTING STYLE)
--no-parse-toplevel-phrases
Unset parse-toplevel-phrases.

--no-preserve-ambiguous-line-comment
Unset preserve-ambiguous-line-comment.

--no-space-around-arrays
Unset space-around-arrays.

Expand Down Expand Up @@ -401,6 +404,11 @@ OPTIONS (CODE FORMATTING STYLE)
Parse and format toplevel phrases and their output. The flag is
unset by default.

--preserve-ambiguous-line-comment
Do not format comments that are one-line long and may contain
whitespace-sensitive code (e.g. strings) The flag is unset by
default.

--sequence-blank-line={preserve-one|compact}
Blank line between expressions of a sequence. preserve will keep a
blank line between two expressions of a sequence if the input
Expand Down
72 changes: 28 additions & 44 deletions lib/Cmt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -93,36 +93,6 @@ type decoded_kind =

type decoded = {prefix: string; suffix: string; kind: decoded_kind}

(** [~content_offset] indicates at which column the body of the comment
starts (1-indexed). [~max_idnent] indicates the maximum amount of
indentation to trim. *)
let unindent_lines ?(max_indent = Stdlib.max_int) ~content_offset first_line
tl_lines =
let tl_indent =
List.fold_left ~init:max_indent
~f:(fun acc s ->
Option.value_map ~default:acc ~f:(min acc) (String.indent_of_line s) )
tl_lines
in
(* The indentation of the first line must account for the location of the
comment opening. Don't account for the first line if it's empty.
[fl_trim] is the number of characters to remove from the first line. *)
let fl_trim, fl_indent =
match String.indent_of_line first_line with
| Some i ->
(max 0 (min i (tl_indent - content_offset)), i + content_offset - 1)
| None -> (String.length first_line, max_indent)
in
let min_indent = min tl_indent fl_indent in
let first_line = String.drop_prefix first_line fl_trim in
first_line
:: List.map ~f:(fun s -> String.drop_prefix s min_indent) tl_lines

let unindent_lines ?max_indent ~content_offset txt =
match String.split ~on:'\n' txt with
| [] -> []
| hd :: tl -> unindent_lines ?max_indent ~content_offset hd tl

let is_all_whitespace s = String.for_all s ~f:Char.is_whitespace

let split_asterisk_prefixed =
Expand All @@ -147,18 +117,19 @@ let split_asterisk_prefixed =
Some (fst_line :: List.map tl ~f:drop_prefix)
| _ -> None

let ambiguous_line line =
String.contains line '"' || String.contains line '{'
|| String.contains line '}'

let mk ?(prefix = "") ?(suffix = "") kind = {prefix; suffix; kind}

let decode_comment ~parse_comments_as_doc txt loc =
let decode_comment ~parse_comments_as_doc ~preserve_ambiguous_line_comments
txt loc =
let txt =
(* Windows compatibility *)
let f = function '\r' -> false | _ -> true in
String.filter txt ~f
in
let opn_offset =
let {Lexing.pos_cnum; pos_bol; _} = loc.Location.loc_start in
pos_cnum - pos_bol + 1
in
if String.length txt >= 2 then
match txt.[0] with
| '$' when not (Char.is_whitespace txt.[1]) -> mk (Verbatim txt)
Expand All @@ -173,15 +144,25 @@ let decode_comment ~parse_comments_as_doc txt loc =
| '=' -> mk (Verbatim txt)
| _ when is_all_whitespace txt ->
mk (Verbatim " ") (* Make sure not to format to [(**)]. *)
| _ when parse_comments_as_doc -> mk (Doc txt)
| _ -> (
| c -> (
let lines =
let content_offset = opn_offset + 2 in
unindent_lines ~content_offset txt
txt |> String.split ~on:'\n'
|> function
| [] -> [] | hd :: tl -> hd :: List.map ~f:String.lstrip tl
in
match split_asterisk_prefixed lines with
| Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
| None -> mk (Normal txt) )
match lines with
| [line] when preserve_ambiguous_line_comments && ambiguous_line line
->
mk (Verbatim txt)
| _ -> (
match split_asterisk_prefixed lines with
| Some deprefixed_lines -> mk (Asterisk_prefixed deprefixed_lines)
| None ->
if parse_comments_as_doc then
match c with
| '_' -> mk ~prefix:"_" (Doc (String.subo ~pos:1 txt))
| _ -> mk (Doc txt)
else mk (Normal txt) ) )
else
match txt with
(* "(**)" is not parsed as a docstring but as a regular comment
Expand All @@ -197,6 +178,9 @@ let decode_docstring _loc = function
| txt when is_all_whitespace txt -> mk (Verbatim " ")
| txt -> mk ~prefix:"*" (Doc txt)

let decode ~parse_comments_as_doc = function
| Comment {txt; loc} -> decode_comment ~parse_comments_as_doc txt loc
let decode ~parse_comments_as_doc ~preserve_ambiguous_line_comments =
function
| Comment {txt; loc} ->
decode_comment ~parse_comments_as_doc ~preserve_ambiguous_line_comments
txt loc
| Docstring {txt; loc} -> decode_docstring loc txt
6 changes: 5 additions & 1 deletion lib/Cmt.mli
Original file line number Diff line number Diff line change
Expand Up @@ -48,4 +48,8 @@ type decoded =
; suffix: string (** Just before the closing. *)
; kind: decoded_kind }

val decode : parse_comments_as_doc:bool -> t -> decoded
val decode :
parse_comments_as_doc:bool
-> preserve_ambiguous_line_comments:bool
-> t
-> decoded
36 changes: 15 additions & 21 deletions lib/Cmts.ml
Original file line number Diff line number Diff line change
Expand Up @@ -611,38 +611,32 @@ end

module Doc = struct
let fmt ~pro ~epi ~fmt_code conf ~loc txt ~offset =
(* Whether the doc starts and ends with an empty line. *)
let pre_nl, trail_nl =
let lines = String.split ~on:'\n' txt in
match lines with
| [] | [_] -> (false, false)
| h :: _ ->
let l = List.last_exn lines in
(is_only_whitespaces h, is_only_whitespaces l)
let trail_nl =
String.split ~on:'\n' txt |> List.last_exn |> is_only_whitespaces
in
let txt = if pre_nl then String.lstrip txt else txt in
let txt = if trail_nl then String.rstrip txt else txt in
let trail_asterisk = String.is_suffix ~suffix:"*" txt in
let txt = String.rstrip txt in
let parsed = Docstring.parse ~loc ~pro txt in
(* Disable warnings when parsing of code blocks fails. *)
let quiet = Conf_t.Elt.make true `Default in
let conf = {conf with Conf.opr_opts= {conf.Conf.opr_opts with quiet}} in
let doc =
Fmt_odoc.fmt_parsed conf ~actually_a_doc_comment:false ~fmt_code
~input:txt ~offset parsed
in
let doc = Fmt_odoc.fmt_parsed conf ~fmt_code ~input:txt ~offset parsed in
let open Fmt in
hvbox 2
( str pro
$ fmt_if pre_nl "@;<1000 1>"
$ doc
$ fmt_if trail_nl "@;<1000 -2>"
$ epi )
let trailing_space =
if trail_asterisk then noop else fmt_or trail_nl "@;<1000 -2>" " "
in
hvbox 2 (str pro $ doc $ trailing_space $ epi)
end

let fmt_cmt (conf : Conf.t) cmt ~fmt_code =
let open Fmt in
let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
let decoded = Cmt.decode ~parse_comments_as_doc cmt in
let preserve_ambiguous_line_comments =
conf.fmt_opts.preserve_ambiguous_line_comments.v
in
let decoded =
Cmt.decode ~parse_comments_as_doc ~preserve_ambiguous_line_comments cmt
in
(* TODO: Offset should be computed from location. *)
let offset = 2 + String.length decoded.prefix in
let pro_str = "(*" ^ decoded.prefix
Expand Down
17 changes: 17 additions & 0 deletions lib/Conf.ml
Original file line number Diff line number Diff line change
Expand Up @@ -112,6 +112,7 @@ let conventional_profile from =
; type_decl= elt `Compact
; type_decl_indent= elt 2
; wrap_comments= elt false
; preserve_ambiguous_line_comments= elt false
; wrap_docstrings= elt true
; wrap_fun_args= elt true }

Expand Down Expand Up @@ -183,6 +184,7 @@ let ocamlformat_profile from =
; type_decl= elt `Compact
; type_decl_indent= elt 2
; wrap_comments= elt false
; preserve_ambiguous_line_comments= elt false
; wrap_docstrings= elt true
; wrap_fun_args= elt true }

Expand Down Expand Up @@ -253,6 +255,7 @@ let janestreet_profile from =
; type_decl= elt `Sparse
; type_decl_indent= elt 2
; wrap_comments= elt true
; preserve_ambiguous_line_comments= elt true
; wrap_docstrings= elt true
; wrap_fun_args= elt false }

Expand Down Expand Up @@ -1310,6 +1313,19 @@ module Formatting = struct
(fun conf elt -> update conf ~f:(fun f -> {f with wrap_comments= elt}))
(fun conf -> conf.fmt_opts.wrap_comments)

let preserve_ambiguous_line_comments =
let doc =
"Do not format comments that are one-line long and may contain \
whitespace-sensitive code (e.g. strings)"
in
Decl.flag ~default
~names:["preserve-ambiguous-line-comment"]
~doc ~kind
(fun conf elt ->
update conf ~f:(fun f ->
{f with preserve_ambiguous_line_comments= elt} ) )
(fun conf -> conf.fmt_opts.preserve_ambiguous_line_comments)

let wrap_fun_args =
let doc = "Style for function call." in
let names = ["wrap-fun-args"] in
Expand Down Expand Up @@ -1378,6 +1394,7 @@ module Formatting = struct
; elt type_decl
; elt type_decl_indent
; elt wrap_comments
; elt preserve_ambiguous_line_comments
; elt wrap_fun_args
; (* removed options *)
elt align_cases
Expand Down
1 change: 1 addition & 0 deletions lib/Conf_t.ml
Original file line number Diff line number Diff line change
Expand Up @@ -120,6 +120,7 @@ type fmt_opts =
; type_decl: [`Compact | `Sparse] elt
; type_decl_indent: int elt
; wrap_comments: bool elt
; preserve_ambiguous_line_comments: bool elt
; wrap_docstrings: bool elt
; wrap_fun_args: bool elt }

Expand Down
3 changes: 3 additions & 0 deletions lib/Conf_t.mli
Original file line number Diff line number Diff line change
Expand Up @@ -118,6 +118,9 @@ type fmt_opts =
; type_decl: [`Compact | `Sparse] elt
; type_decl_indent: int elt
; wrap_comments: bool elt (** Wrap comments at margin. *)
; preserve_ambiguous_line_comments: bool elt
(** If a comment's contents may contain code whose semantics depend on whitespace, do
not wrap it. *)
; wrap_docstrings: bool elt
; wrap_fun_args: bool elt }

Expand Down
16 changes: 9 additions & 7 deletions lib/Fmt_ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -424,13 +424,15 @@ let fmt_parsed_docstring c ~loc ?pro ~epi input parsed =
pos.pos_cnum - pos.pos_bol + 3
and fmt_code = c.fmt_code in
let doc =
if
c.conf.fmt_opts.parse_docstrings.v
&& String.for_all ~f:Char.is_whitespace input
then noop
else
Fmt_odoc.fmt_parsed c.conf ~actually_a_doc_comment:true ~fmt_code
~offset ~input parsed
match input with
| "/*" ->
(* Special-case the form that toggles odoc: [(**/**)] *) str input
| _ ->
if
c.conf.fmt_opts.parse_docstrings.v
&& String.for_all ~f:Char.is_whitespace input
then noop
else Fmt_odoc.fmt_parsed c.conf ~fmt_code ~offset ~input parsed
in
let closing_space =
match parsed with
Expand Down
40 changes: 22 additions & 18 deletions lib/Fmt_odoc.ml
Original file line number Diff line number Diff line change
Expand Up @@ -74,9 +74,24 @@ let escape_balanced_brackets s =
in
insert_ats s "\\" (brackets_to_escape [] [] 0)

let looks_like_number w =
let w =
match String.chop_suffix w ~suffix:")" with
| Some w -> Some (String.chop_prefix_if_exists w ~prefix:"(")
| None -> (
match String.chop_suffix w ~suffix:"]" with
| Some w -> String.chop_prefix w ~prefix:"["
| None -> String.chop_suffix w ~suffix:"." )
in
match w |> Option.map ~f:String.to_list with
| Some [c] -> Char.is_alphanum c && not Char.(equal c '0')
| Some (leading :: _ as w) ->
List.for_all ~f:Char.is_digit w && not Char.(equal leading '0')
| Some [] | None -> false

let escape_all s =
let escapeworthy = function '{' | '}' | '[' | ']' -> true | _ -> false in
ensure_escape ~escapeworthy s
if looks_like_number s then s else ensure_escape ~escapeworthy s

let split_on_whitespaces =
String.split_on_chars ~on:['\t'; '\n'; '\011'; '\012'; '\r'; ' ']
Expand Down Expand Up @@ -211,17 +226,6 @@ let space_elt c : inline_element with_location =
let sp = if c.conf.fmt_opts.wrap_docstrings.v then "" else " " in
Loc.(at (span []) (`Space sp))

let looks_like_number w =
let w =
match String.chop_suffix w ~suffix:")" with
| Some w -> Some (String.chop_prefix_if_exists w ~prefix:"(")
| None -> String.chop_suffix w ~suffix:"."
in
match w |> Option.map ~f:String.to_list with
| Some [c] -> Char.is_alphanum c
| Some (_ :: _ as w) -> List.for_all ~f:Char.is_digit w
| Some [] | None -> false

let non_wrap_space sp = if String.contains sp '\n' then fmt "@\n" else str sp

let rec fmt_inline_elements c elements =
Expand Down Expand Up @@ -249,7 +253,10 @@ let rec fmt_inline_elements c elements =
(non_wrap_space sp)
$ aux t
| `Word w :: t ->
fmt_if (String.is_prefix ~prefix:"@" w) "\\"
fmt_if
( String.is_prefix ~prefix:"@" w
&& List.mem Odoc_parser.tag_list ~equal:String.equal w )
"\\"
$ str_normalized c w $ aux t
| `Code_span s :: t -> fmt_code_span s $ aux t
| `Math_span s :: t -> fmt_math_span s $ aux t
Expand Down Expand Up @@ -407,8 +414,7 @@ let beginning_offset (conf : Conf.t) input =
whitespace_count
else min whitespace_count 1

let fmt_parsed (conf : Conf.t) ~actually_a_doc_comment ~fmt_code ~input
~offset parsed =
let fmt_parsed (conf : Conf.t) ~fmt_code ~input ~offset parsed =
let open Fmt in
let begin_offset = beginning_offset conf input in
(* The offset is used to adjust the margin when formatting code blocks. *)
Expand All @@ -420,9 +426,7 @@ let fmt_parsed (conf : Conf.t) ~actually_a_doc_comment ~fmt_code ~input
str (String.make begin_offset ' ') $ fmt_ast conf ~fmt_code parsed
in
match parsed with
| _ when not (conf.fmt_opts.parse_docstrings.v && actually_a_doc_comment)
->
str input
| _ when not conf.fmt_opts.parse_docstrings.v -> str input
| Ok parsed -> fmt_parsed parsed
| Error msgs ->
if (not conf.opr_opts.quiet.v) && conf.opr_opts.check_odoc_parsing.v
Expand Down
1 change: 0 additions & 1 deletion lib/Fmt_odoc.mli
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,6 @@ val fmt_ast : Conf.t -> fmt_code:fmt_code -> Odoc_parser.Ast.t -> Fmt.t

val fmt_parsed :
Conf.t
-> actually_a_doc_comment:bool
-> fmt_code:fmt_code
-> input:string
-> offset:int
Expand Down
11 changes: 10 additions & 1 deletion lib/Normalize_extended_ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -245,7 +245,16 @@ let normalize_cmt (conf : Conf.t) =
let parse_comments_as_doc = conf.fmt_opts.ocp_indent_compat.v in
object (self)
method cmt c =
let decoded = Cmt.decode ~parse_comments_as_doc c in
(* Always pass [~preserve_ambiguous_line_comments:false] because we may
sometimes turn a multi-line comment that deserves formatting into a
single-line comment that does not. In this case, if we passed the
[preserve_ambiguous_line_comments] from the config, the former AST
would decode the comment as a [Doc] comment and the latter as
[Verbatim]. *)
let decoded =
Cmt.decode ~parse_comments_as_doc
~preserve_ambiguous_line_comments:false c
in
match decoded.Cmt.kind with
| Verbatim txt -> txt
| Doc txt ->
Expand Down
Loading