+23 -2

src/document/codefmt.ml

··· 42 42 flush state) 43 43 end 44 44 45 45 + let rec compute_length_source (t : Types.Source.t) : int = 46 46 + let f (acc : int) = function 47 47 + | Types.Source.Elt t -> acc + compute_length_inline t 48 48 + | Types.Source.Tag (_, t) -> acc + compute_length_source t 49 49 + in 50 50 + List.fold_left f 0 t 51 51 + 52 52 + and compute_length_inline (t : Types.Inline.t) : int = 53 53 + let f (acc : int) { Types.Inline.desc; _ } = 54 54 + match desc with 55 55 + | Text s -> acc + String.length s 56 56 + | Entity _e -> acc + 1 57 57 + | Linebreak -> 0 (* TODO *) 58 58 + | Styled (_, t) | Link { content = t; _ } -> acc + compute_length_inline t 59 59 + | Source s -> acc + compute_length_source s 60 60 + | Math _ -> assert false 61 61 + | Raw_markup _ -> assert false 62 62 + (* TODO *) 63 63 + in 64 64 + List.fold_left f 0 t 65 65 + 45 66 (** Modern implementation using semantic tags, Only for 4.08+ *) 46 67 47 68 (* ··· 79 100 80 101 let elt ppf elt = 81 102 Format.pp_open_stag ppf (Elt elt); 82 82 - Format.pp_print_as ppf (Utils.compute_length_inline elt) ""; 103 103 + Format.pp_print_as ppf (compute_length_inline elt) ""; 83 104 Format.pp_close_stag ppf () 84 105 85 106 let ignore ppf txt = ··· 140 161 141 162 let elt ppf (elt : Inline.t) = 142 163 Format.fprintf ppf "@{<tag:%s>%t@}" (Marshal.to_string elt []) (fun fmt -> 143 143 - Format.pp_print_as fmt (Utils.compute_length_inline elt) "") 164 164 + Format.pp_print_as fmt (compute_length_inline elt) "") 144 165 145 166 let ignore ppf txt = Format.fprintf ppf "@{<ignore-tag>%t@}" txt 146 167 end

+4 -3

src/document/comment.ml

··· 14 14 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 15 *) 16 16 17 17 + open Odoc_utils 17 18 open Types 18 19 module Comment = Odoc_model.Comment 19 20 open Odoc_model.Names ··· 67 68 | `TAbsolutePath -> "/" 68 69 | `TCurrentPackage -> "//" 69 70 in 70 70 - tag ^ String.concat "/" cs 71 71 + tag ^ String.concat ~sep:"/" cs 71 72 72 73 let rec render_unresolved : Reference.t -> string = 73 74 let open Reference in ··· 412 413 match Comment.synopsis docs with Some p -> [ paragraph p ] | None -> [] 413 414 414 415 let standalone docs = 415 415 - Utils.flatmap ~f:item_element 416 416 + List.concat_map item_element 416 417 @@ List.map (fun x -> x.Odoc_model.Location_.value) docs 417 418 418 419 let to_ir (docs : Comment.elements) = 419 419 - Utils.flatmap ~f:block_element 420 420 + List.concat_map block_element 420 421 @@ List.map (fun x -> x.Odoc_model.Location_.value) docs 421 422 422 423 let has_doc docs = docs <> []

+16 -11

src/document/doctree.ml

··· 1 1 + open Odoc_utils 1 2 open Types 2 3 3 4 module Take = struct ··· 97 98 val compute : Page.t -> Subpage.t list 98 99 end = struct 99 100 let rec walk_documentedsrc (l : DocumentedSrc.t) = 100 100 - Utils.flatmap l ~f:(function 101 101 - | DocumentedSrc.Code _ -> [] 102 102 - | Documented _ -> [] 103 103 - | Nested { code; _ } -> walk_documentedsrc code 104 104 - | Subpage p -> [ p ] 105 105 - | Alternative (Expansion r) -> walk_documentedsrc r.expansion) 101 101 + List.concat_map 102 102 + (function 103 103 + | DocumentedSrc.Code _ -> [] 104 104 + | Documented _ -> [] 105 105 + | Nested { code; _ } -> walk_documentedsrc code 106 106 + | Subpage p -> [ p ] 107 107 + | Alternative (Expansion r) -> walk_documentedsrc r.expansion) 108 108 + l 106 109 107 110 let rec walk_items (l : Item.t list) = 108 108 - Utils.flatmap l ~f:(function 109 109 - | Item.Text _ -> [] 110 110 - | Heading _ -> [] 111 111 - | Declaration { content; _ } -> walk_documentedsrc content 112 112 - | Include i -> walk_items i.content.content) 111 111 + List.concat_map 112 112 + (function 113 113 + | Item.Text _ -> [] 114 114 + | Heading _ -> [] 115 115 + | Declaration { content; _ } -> walk_documentedsrc content 116 116 + | Include i -> walk_items i.content.content) 117 117 + l 113 118 114 119 let compute (p : Page.t) = walk_items (p.preamble @ p.items) 115 120 end

+23 -21

src/document/generator.ml

··· 14 14 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 15 *) 16 16 17 17 + open Odoc_utils 17 18 open Odoc_model.Names 18 19 module Location = Odoc_model.Location_ 19 20 module Paths = Odoc_model.Paths ··· 76 77 rest is inserted into [items]. *) 77 78 let prepare_preamble comment items = 78 79 let preamble, first_comment = 79 79 - Utils.split_at 80 80 + List.split_at 80 81 ~f:(function 81 82 | { Odoc_model.Location_.value = `Heading _; _ } -> true | _ -> false) 82 83 comment ··· 213 214 let in_bound x = min (max x 0) (String.length src) in 214 215 let a = in_bound a and b = in_bound b in 215 216 let a, b = (min a b, max a b) in 216 216 - String.sub src a (b - a) 217 217 + String.with_range src ~first:a ~len:(b - a) 217 218 in 218 219 let plain_code = function 219 220 | "" -> [] ··· 358 359 | Open -> O.txt "[> " ++ elements ++ O.txt " ]" 359 360 | Closed [] -> O.txt "[< " ++ elements ++ O.txt " ]" 360 361 | Closed lst -> 361 361 - let constrs = String.concat " " lst in 362 362 + let constrs = String.concat ~sep:" " lst in 362 363 O.txt "[< " ++ elements ++ O.txt (" " ^ constrs ^ " ]")) 363 364 364 365 and te_object (t : Odoc_model.Lang.TypeExpr.Object.t) = ··· 461 462 format_type_path ~delim:`brackets args 462 463 (Link.from_path (path :> Paths.Path.t)) 463 464 | Poly (polyvars, t) -> 464 464 - O.txt ("'" ^ String.concat " '" polyvars ^ ". ") ++ type_expr t 465 465 + O.txt ("'" ^ String.concat ~sep:" '" polyvars ^ ". ") ++ type_expr t 465 466 | Package pkg -> 466 467 enclose ~l:"(" ~r:")" 467 468 (O.keyword "module" ++ O.txt " " ··· 747 748 | Closed [] -> 748 749 (O.documentedSrc (O.txt "[< "), O.documentedSrc (O.txt " ]")) 749 750 | Closed lst -> 750 750 - let constrs = String.concat " " lst in 751 751 + let constrs = String.concat ~sep:" " lst in 751 752 ( O.documentedSrc (O.txt "[< "), 752 753 O.documentedSrc (O.txt (" " ^ constrs ^ " ]")) ) 753 754 in ··· 773 774 | Some Odoc_model.Lang.TypeDecl.Neg -> "-" :: desc 774 775 in 775 776 let final = if injectivity then "!" :: var_desc else var_desc in 776 776 - String.concat "" final 777 777 + String.concat ~sep:"" final 777 778 in 778 779 O.txt 779 780 (match params with 780 781 | [] -> "" 781 782 | [ x ] -> format_param x |> Syntax.Type.handle_format_params 782 783 | lst -> ( 783 783 - let params = String.concat ", " (List.map format_param lst) in 784 784 + let params = String.concat ~sep:", " (List.map format_param lst) in 784 785 (match delim with `parens -> "(" | `brackets -> "[") 785 786 ^ params 786 787 ^ match delim with `parens -> ")" | `brackets -> "]")) ··· 1077 1078 | Constraint cst -> continue @@ constraint_ cst 1078 1079 | Comment `Stop -> 1079 1080 let rest = 1080 1080 - Utils.skip_until rest ~p:(function 1081 1081 + List.skip_until rest ~p:(function 1081 1082 | Lang.ClassSignature.Comment `Stop -> true 1082 1083 | _ -> false) 1083 1084 in ··· 1268 1269 loop rest (List.rev_append items acc_items) 1269 1270 | Comment `Stop -> 1270 1271 let rest = 1271 1271 - Utils.skip_until rest ~p:(function 1272 1272 + List.skip_until rest ~p:(function 1272 1273 | Lang.Signature.Comment `Stop -> true 1273 1274 | _ -> false) 1274 1275 in ··· 1376 1377 | Some params, sg -> 1377 1378 let sg_doc, content = signature sg in 1378 1379 let params = 1379 1379 - Utils.flatmap params ~f:(fun arg -> 1380 1380 - let content = functor_parameter arg in 1381 1381 - let attr = [ "parameter" ] in 1382 1382 - let anchor = 1383 1383 - Some 1384 1384 - (Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t)) 1385 1385 - in 1386 1386 - let doc = [] in 1387 1387 - [ 1388 1388 - Item.Declaration 1389 1389 - { content; anchor; attr; doc; source_anchor = None }; 1390 1390 - ]) 1380 1380 + let decl_of_arg arg = 1381 1381 + let content = functor_parameter arg in 1382 1382 + let attr = [ "parameter" ] in 1383 1383 + let anchor = 1384 1384 + Some (Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t)) 1385 1385 + in 1386 1386 + let doc = [] in 1387 1387 + [ 1388 1388 + Item.Declaration 1389 1389 + { content; anchor; attr; doc; source_anchor = None }; 1390 1390 + ] 1391 1391 + in 1392 1392 + List.concat_map decl_of_arg params 1391 1393 in 1392 1394 let prelude = mk_heading ~label:"parameters" "Parameters" :: params 1393 1395 and content = mk_heading ~label:"signature" "Signature" :: content in

-42

src/document/utils.ml

··· 1 1 - let option_of_result = function Ok x -> Some x | Error _ -> None 2 2 - 3 3 - let rec flatmap ?sep ~f = function 4 4 - | [] -> [] 5 5 - | [ x ] -> f x 6 6 - | x :: xs -> ( 7 7 - let hd = f x in 8 8 - let tl = flatmap ?sep ~f xs in 9 9 - match sep with None -> hd @ tl | Some sep -> hd @ sep @ tl) 10 10 - 11 11 - let rec skip_until ~p = function 12 12 - | [] -> [] 13 13 - | h :: t -> if p h then t else skip_until ~p t 14 14 - 15 15 - let split_at ~f lst = 16 16 - let rec loop acc = function 17 17 - | hd :: _ as rest when f hd -> (List.rev acc, rest) 18 18 - | [] -> (List.rev acc, []) 19 19 - | hd :: tl -> loop (hd :: acc) tl 20 20 - in 21 21 - loop [] lst 22 22 - 23 23 - let rec compute_length_source (t : Types.Source.t) : int = 24 24 - let f (acc : int) = function 25 25 - | Types.Source.Elt t -> acc + compute_length_inline t 26 26 - | Types.Source.Tag (_, t) -> acc + compute_length_source t 27 27 - in 28 28 - List.fold_left f 0 t 29 29 - 30 30 - and compute_length_inline (t : Types.Inline.t) : int = 31 31 - let f (acc : int) { Types.Inline.desc; _ } = 32 32 - match desc with 33 33 - | Text s -> acc + String.length s 34 34 - | Entity _e -> acc + 1 35 35 - | Linebreak -> 0 (* TODO *) 36 36 - | Styled (_, t) | Link { content = t; _ } -> acc + compute_length_inline t 37 37 - | Source s -> acc + compute_length_source s 38 38 - | Math _ -> assert false 39 39 - | Raw_markup _ -> assert false 40 40 - (* TODO *) 41 41 - in 42 42 - List.fold_left f 0 t

-6

src/document/utils.mli

··· 1 1 - val option_of_result : ('a, 'b) result -> 'a option 2 2 - val flatmap : ?sep:'a list -> f:('b -> 'a list) -> 'b list -> 'a list 3 3 - val skip_until : p:('a -> bool) -> 'a list -> 'a list 4 4 - val split_at : f:('a -> bool) -> 'a list -> 'a list * 'a list 5 5 - val compute_length_source : Types.Source.t -> int 6 6 - val compute_length_inline : Types.Inline.t -> int

+6 -5

src/manpage/generator.ml

··· 1 1 + open Odoc_utils 1 2 module ManLink = Link 2 3 open Odoc_document 3 4 open Types ··· 299 300 | { Inline.desc = Text s; _ } -> Accum [ s ] 300 301 | _ -> Stop_and_keep) 301 302 in 302 302 - str {|%s|} (String.concat "" l) ++ inline rest 303 303 + str {|%s|} (String.concat ~sep:"" l) ++ inline rest 303 304 | Entity e -> 304 305 let x = entity e in 305 306 x ++ inline rest ··· 343 344 | Default -> "l") 344 345 align 345 346 in 346 346 - Align_line (String.concat "" alignment) 347 347 + Align_line (String.concat ~sep:"" alignment) 347 348 in 348 349 env "TS" "TE" "" 349 350 (str "allbox;" ++ alignment ··· 408 409 | 1, n :: _ -> [ n + 1 ] 409 410 | i, n :: t -> n :: succ_heading (i - 1) t 410 411 in 411 411 - let print_heading l = String.concat "." @@ List.map string_of_int l in 412 412 + let print_heading l = String.concat ~sep:"." @@ List.map string_of_int l in 412 413 let next level = 413 414 let new_heading = succ_heading level !heading_stack in 414 415 heading_stack := new_heading; ··· 547 548 let i = Shift.compute ~on_sub p.items in 548 549 macro "TH" {|%s 3 "" "Odoc" "OCaml Library"|} p.url.name 549 550 ++ macro "SH" "Name" 550 550 - ++ str "%s" (String.concat "." @@ Link.for_printing p.url) 551 551 + ++ str "%s" (String.concat ~sep:"." @@ Link.for_printing p.url) 551 552 ++ macro "SH" "Synopsis" ++ vspace ++ item ~nested:false header 552 553 ++ macro "SH" "Documentation" ++ vspace ++ macro "nf" "" 553 554 ++ item ~nested:false i ··· 558 559 559 560 and render_page (p : Page.t) = 560 561 let p = Doctree.Labels.disambiguate_page ~enter_subpages:true p 561 561 - and children = Utils.flatmap ~f:subpage @@ Subpages.compute p in 562 562 + and children = List.concat_map subpage (Subpages.compute p) in 562 563 let content ppf = Format.fprintf ppf "%a@." Roff.pp (page p) in 563 564 let filename = Link.as_filename p.url in 564 565 { Renderer.filename; content; children; path = p.url }

+12

src/utils/odoc_list.ml

··· 32 32 33 33 (* Since 5.1 *) 34 34 let is_empty = function [] -> true | _ :: _ -> false 35 35 + 36 36 + let rec skip_until ~p = function 37 37 + | [] -> [] 38 38 + | h :: t -> if p h then t else skip_until ~p t 39 39 + 40 40 + let split_at ~f lst = 41 41 + let rec loop acc = function 42 42 + | hd :: _ as rest when f hd -> (List.rev acc, rest) 43 43 + | [] -> (List.rev acc, []) 44 44 + | hd :: tl -> loop (hd :: acc) tl 45 45 + in 46 46 + loop [] lst