From f88ea4b1113a609816097e3adecbf1c2852f619f Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Sat, 29 Aug 2026 09:18:08 +0000 Subject: [PATCH 1/8] perf: speed up outline_only Markdown parsing (~2.2x) Outline mode now extracts only node refs, tags, and properties: - Fast direct scanner for #tag / [[page]] / ((block)) - Markdown-specific outline parser with peek dispatch - Skip front-matter probing and position tracking on outline path - Lighter heading title lookahead and outline inline pre-checks Also adds bench/time_parse.exe for Logseq-sized Markdown fixtures. Co-authored-by: Tienson Qin --- .gitignore | 1 + bench/bench.ml | 7 +- bench/dune | 6 +- bench/time_parse.ml | 101 ++++++++++++++++ lib/export/conf.ml | 3 + lib/mldoc.ml | 1 + lib/mldoc_parser.ml | 137 +++++++++++++++++++--- lib/syntax/heading0.ml | 67 +++++++---- lib/syntax/inline.ml | 70 ++++++++--- lib/syntax/lists0.ml | 9 +- lib/syntax/outline_inline.ml | 214 ++++++++++++++++++++++++++-------- lib/syntax/paragraph.ml | 24 ++-- test/test_outline_markdown.ml | 162 +++---------------------- 13 files changed, 534 insertions(+), 268 deletions(-) create mode 100644 bench/time_parse.ml diff --git a/.gitignore b/.gitignore index 04dbc0ae..a87f82e6 100644 --- a/.gitignore +++ b/.gitignore @@ -12,3 +12,4 @@ _tags /dune-workspace examples/syntax.html js/package/index.js +examples/logseq_large.md diff --git a/bench/bench.ml b/bench/bench.ml index dedc1c24..426daa85 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -1,3 +1,4 @@ +open Mldoc open Mldoc.Parser open Mldoc.Conf open Core @@ -26,6 +27,8 @@ let config = } let outline_config = { config with parse_outline_only = true } +let md_config = { config with format = Markdown } +let md_outline_config = { md_config with parse_outline_only = true } let main () = Command_unix.run @@ -41,9 +44,9 @@ let main () = ; Bench.Test.create ~name:"Mldoc Org mode parser (outline only)" (fun () -> ignore (parse outline_config doc_org)) ; Bench.Test.create ~name:"Mldoc Markdown parser" (fun () -> - ignore (parse config syntax_md)) + ignore (parse md_config syntax_md)) ; Bench.Test.create ~name:"Mldoc Markdown parser (outline only)" - (fun () -> ignore (parse outline_config syntax_md)) + (fun () -> ignore (parse md_outline_config syntax_md)) ]) let () = main () diff --git a/bench/dune b/bench/dune index a3c06cd2..7bf79085 100644 --- a/bench/dune +++ b/bench/dune @@ -2,6 +2,10 @@ (name bench) (libraries angstrom mldoc core core_bench core_unix.command_unix)) +(executable + (name time_parse) + (libraries unix mldoc)) + (alias (name bench) - (deps bench.exe)) + (deps bench.exe time_parse.exe)) diff --git a/bench/time_parse.ml b/bench/time_parse.ml new file mode 100644 index 00000000..8561efc2 --- /dev/null +++ b/bench/time_parse.ml @@ -0,0 +1,101 @@ +(** Wall-clock timing focused on Markdown (Logseq) workloads. *) +open Mldoc.Parser +open Mldoc.Conf + +let ensure_logseq_large path = + if not (Sys.file_exists path) then ( + let buf = Buffer.create 1_200_000 in + for i = 0 to 3999 do + Buffer.add_string buf + (Printf.sprintf + "- Block title %d with [[page %d]] and #tag%d\n" i (i mod 50) + (i mod 20)); + if i mod 3 = 0 then + Buffer.add_string buf + (Printf.sprintf " id:: %08x-xxxx-xxxx-xxxx-%012x\n" i i); + if i mod 5 = 0 then ( + Buffer.add_string buf + (Printf.sprintf + " - child of %d with ((%08x-xxxx-xxxx-xxxx-%012x))\n" i i i); + Buffer.add_string buf + (Printf.sprintf " more plain text line without markup %d\n" i)); + if i mod 7 = 0 then + Buffer.add_string buf + (Printf.sprintf + " plain paragraph under block %d word word word word word\n" i); + if i mod 11 = 0 then + Buffer.add_string buf (Printf.sprintf " + unordered item %d\n" i); + if i mod 13 = 0 then + Buffer.add_string buf (Printf.sprintf " ```\n code line %d\n ```\n" i) + done; + let content = Buffer.contents buf in + (* Grow to ~1.2MB so benches stay comparable across revisions. *) + let pieces = ref [] in + let len = ref 0 in + while !len < 1_200_000 do + pieces := content :: !pieces; + len := !len + String.length content + done; + let grown = String.concat "" (List.rev !pieces) in + let oc = open_out path in + output_string oc (String.sub grown 0 1_200_000); + close_out oc) + +let () = ensure_logseq_large "./examples/logseq_large.md" + +let doc_org = load_file "./examples/doc.org" +let syntax_md = load_file "./examples/syntax.md" +let logseq_md = load_file "./examples/logseq_large.md" + +let base = + { toc = true + ; parse_outline_only = false + ; heading_number = true + ; keep_line_break = false + ; format = Markdown + ; heading_to_list = false + ; exporting_keep_properties = false + ; inline_type_with_pos = false + ; inline_skip_macro = false + ; export_md_indent_style = Dashes + ; export_md_remove_options = [] + ; hiccup_in_block = true + ; enable_drawers = true + ; parse_marker = true + ; parse_priority = true + } + +let avg ~n f = + ignore (f ()); + let t0 = Unix.gettimeofday () in + for _ = 1 to n do + ignore (f ()) + done; + let t1 = Unix.gettimeofday () in + (t1 -. t0) /. float n + +let () = + let n = 3 in + let md_full = avg ~n (fun () -> parse base logseq_md) in + let md_outline = + avg ~n (fun () -> parse { base with parse_outline_only = true } logseq_md) + in + let syn_full = avg ~n (fun () -> parse base syntax_md) in + let syn_outline = + avg ~n (fun () -> parse { base with parse_outline_only = true } syntax_md) + in + let org = { base with format = Org; parse_outline_only = false } in + let org_full = avg ~n (fun () -> parse org doc_org) in + let org_outline = + avg ~n (fun () -> parse { org with parse_outline_only = true } doc_org) + in + Printf.printf "iterations=%d (avg seconds)\n" n; + Printf.printf "MD logseq_large full: %.4f\n" md_full; + Printf.printf "MD logseq_large outline_only: %.4f (%.1fx vs full)\n" md_outline + (md_full /. md_outline); + Printf.printf "MD syntax.md full: %.4f\n" syn_full; + Printf.printf "MD syntax.md outline_only: %.4f (%.1fx vs full)\n" syn_outline + (syn_full /. syn_outline); + Printf.printf "Org doc.org full: %.4f\n" org_full; + Printf.printf "Org doc.org outline_only: %.4f (%.1fx vs full)\n" org_outline + (org_full /. org_outline) diff --git a/lib/export/conf.ml b/lib/export/conf.ml index 78f45b09..06d33534 100644 --- a/lib/export/conf.ml +++ b/lib/export/conf.ml @@ -42,6 +42,9 @@ type t = (* hiccup: bool; *) toc : bool [@default false] ; parse_outline_only : bool [@default false] + (** Fast path (esp. Markdown): block structure + properties, and in + content only node refs ([[page]] / ((block))), tags (#tag). + Skips emphasis/code/timestamps and full Inline.parse. *) ; heading_number : bool [@default false] ; keep_line_break : bool (* FIXME: is this option deprecated? *) ; format : format diff --git a/lib/mldoc.ml b/lib/mldoc.ml index 51ebfb6f..13d6ad9e 100644 --- a/lib/mldoc.ml +++ b/lib/mldoc.ml @@ -3,6 +3,7 @@ module Document = Document module Block = Type_parser.Block module Inline = Inline +module Outline_inline = Outline_inline module Nested_link = Nested_link module Pos = Pos module Exporters = Exporter.Exporters diff --git a/lib/mldoc_parser.ml b/lib/mldoc_parser.ml index 99e40cf9..efad197b 100644 --- a/lib/mldoc_parser.ml +++ b/lib/mldoc_parser.ml @@ -1,24 +1,40 @@ open Angstrom open! Prelude +open Parsers let list_content_parsers config = let p = - choice - [ Table.parse config - ; Type_parser.Block.parse config - ; Latex_env.parse config - ; Hr.parse config - ; Type_parser.Block.results - ; Comment.parse config - ; Paragraph.parse - ; Paragraph.sep - ] + if config.Conf.parse_outline_only then + choice + [ Drawer.parse config + ; Type_parser.Block.parse config + ; Paragraph.parse + ; Paragraph.sep + ] + else if Conf.is_markdown config then + choice + [ Table.parse config + ; Type_parser.Block.parse config + ; Hr.parse config + ; Paragraph.parse + ; Paragraph.sep + ] + else + choice + [ Table.parse config + ; Type_parser.Block.parse config + ; Latex_env.parse config + ; Hr.parse config + ; Type_parser.Block.results + ; Comment.parse config + ; Paragraph.parse + ; Paragraph.sep + ] in let p = Helper.with_pos_meta p in many1 p -(* Orders care *) -let parsers config = +let org_full_parsers config = [ Paragraph.sep ; Directive.parse ; Drawer.parse config @@ -34,29 +50,109 @@ let parsers config = ; Paragraph.parse ] -(* TODO: ignore tags, page/block refs from Src, Example, etc. *) -let outline_parsers config = +let md_full_parsers config = [ Paragraph.sep ; Type_parser.Heading.parse config ; Drawer.parse config + ; Table.parse config + ; Latex_env.parse config + ; Type_parser.Block.parse config + ; Footnote.parse config + ; Type_parser.Lists.parse config (list_content_parsers config) + ; Hr.parse config + ; Paragraph.parse + ] + +let org_outline_parsers config = + [ Paragraph.sep ; Directive.parse + ; Drawer.parse config + ; Type_parser.Heading.parse config + ; Type_parser.Block.parse config + ; Footnote.parse config + ; Type_parser.Lists.parse config (list_content_parsers config) + ; Type_parser.Block.results ; Paragraph.parse ] +let line_has_colon_colon s = + let n = String.length s in + let rec loop i = + if i + 1 >= n then + false + else if s.[i] = ':' && s.[i + 1] = ':' then + true + else + loop (i + 1) + in + loop 0 + +(** Markdown outline: peek-dispatch to avoid choice backtracking on every line. *) +let md_outline_block config = + let heading = Type_parser.Heading.parse config in + let lists = Type_parser.Lists.parse config (list_content_parsers config) in + let drawer = Drawer.parse config in + let block = Type_parser.Block.parse config in + let footnote = Footnote.parse config in + peek_char >>= function + | None -> fail "eof" + | Some '\n' + | Some '\r' -> + Paragraph.sep + | Some '-' -> heading <|> lists <|> Paragraph.parse + | Some '#' -> heading <|> Paragraph.parse + | Some '+' + | Some '*' -> + lists <|> Paragraph.parse + | Some ' ' + | Some '\t' -> + drawer <|> block <|> lists <|> footnote <|> Paragraph.parse + | Some '`' + | Some '>' -> + block <|> Paragraph.parse + | Some '[' -> footnote <|> Paragraph.parse + | Some ':' -> drawer <|> Paragraph.parse + | _ -> + (* Plain or property line (key::). Skip Drawer when no `::`. *) + peek_line >>= fun line -> + if line_has_colon_colon line then + drawer <|> Paragraph.parse + else + Paragraph.parse + let md_front_matter_parse parse = Markdown_front_matter.parse >>= fun fm_result -> parse >>= fun result -> return (List.append fm_result result) -let build_parsers parsers config = +let build_choice_parsers parsers config = let parsers = parsers config in let choice = choice parsers in - let p = Helper.with_pos_meta choice in + let p = + if config.Conf.parse_outline_only then + choice >>| fun t -> (t, Pos.dummy_pos) + else + Helper.with_pos_meta choice + in let parse = many p in - md_front_matter_parse parse <|> parse + if config.Conf.parse_outline_only && Conf.is_markdown config then + parse + else + md_front_matter_parse parse <|> parse + +let build_md_outline_parsers config = + let p = md_outline_block config >>| fun t -> (t, Pos.dummy_pos) in + many p let parse config input = let outline_only = Conf.(config.parse_outline_only) in - let parsers = build_parsers parsers config in + let md = Conf.is_markdown config in + let parsers = + match (md, outline_only) with + | true, true -> build_md_outline_parsers config + | true, false -> build_choice_parsers md_full_parsers config + | false, true -> build_choice_parsers org_outline_parsers config + | false, false -> build_choice_parsers org_full_parsers config + in match parse_string ~consume:All parsers input with | Ok result -> let ast = Paragraph.concat_paragraph_lines config result in @@ -81,7 +177,10 @@ let parse config input = ast in if Conf.is_markdown config then - List.map (fun (t, pos) -> (Type_op.md_unescaped t, pos)) ast + if outline_only && not (String.contains input '\\') then + ast + else + List.map (fun (t, pos) -> (Type_op.md_unescaped t, pos)) ast else ast | Error err -> failwith err diff --git a/lib/syntax/heading0.ml b/lib/syntax/heading0.ml index 5da47955..1421702e 100644 --- a/lib/syntax/heading0.ml +++ b/lib/syntax/heading0.ml @@ -83,16 +83,34 @@ struct let title_aux_p config = let config = { config with Conf.hiccup_in_block = false } in - Angstrom.unsafe_lookahead - (choice - [ Drawer.parse config - ; Hr.parse config - ; Table.parse config - ; Latex_env.parse config - ; Block.parse config - ; Footnote.parse config - ; Paragraph.parse - ]) + if config.parse_outline_only then + (* Only run Block when the title might be a fence/quote. *) + Angstrom.unsafe_lookahead + ( peek_char >>= function + | Some '`' + | Some '>' -> + Block.parse config <|> Paragraph.parse + | _ -> Paragraph.parse ) + else if Conf.is_markdown config then + (* Markdown: most titles are plain lines; avoid Org-heavy lookahead. *) + Angstrom.unsafe_lookahead + (choice + [ Drawer.parse config + ; Block.parse config + ; Footnote.parse config + ; Paragraph.parse + ]) + else + Angstrom.unsafe_lookahead + (choice + [ Drawer.parse config + ; Hr.parse config + ; Table.parse config + ; Latex_env.parse config + ; Block.parse config + ; Footnote.parse config + ; Paragraph.parse + ]) (* not include priority, tags, marker return (title_line_string, first Type.t) *) @@ -128,6 +146,14 @@ struct in explode (String.trim s) |> List.map map_char |> String.concat "" + let outline_title config title = + if Outline_inline.may_have_outline_markup config title then + match parse_string ~consume:All (Outline_inline.parse config) title with + | Ok title -> title + | Error _ -> [] + else + [] + let parse config = let p = lift4 @@ -136,15 +162,12 @@ struct match pos_and_title with | None -> [] | Some (_pos, title) -> ( - let inline_parse = - if config.parse_outline_only then - Outline_inline.parse - else - Inline.parse - in - match parse_string ~consume:All (inline_parse config) title with - | Ok title -> title - | Error _e -> []) + if config.parse_outline_only then + outline_title config title + else + match parse_string ~consume:All (Inline.parse config) title with + | Ok title -> title + | Error _e -> []) in let title, tags = match title with @@ -192,7 +215,11 @@ struct | Markdown -> (title, [])) in let anchor = - anchor_link (Inline.asciis (Type_op.inline_list_strip_pos title)) + if config.parse_outline_only then + "" + else + anchor_link + (Inline.asciis (Type_op.inline_list_strip_pos title)) in let meta = { timestamps = []; properties = [] } in Heading diff --git a/lib/syntax/inline.ml b/lib/syntax/inline.ml index 88d68211..8c062753 100644 --- a/lib/syntax/inline.ml +++ b/lib/syntax/inline.ml @@ -197,14 +197,48 @@ let org_plain_delims = let markdown_plain_delims = [ '\\'; '_'; '^'; '['; '*'; '~'; '`'; '='; '$'; '#' ] @ whitespace_chars -(* replace list with a *) +(* Hot path: avoid List.mem per character. *) +let in_org_plain_delims = function + | '\\' + | '_' + | '^' + | '[' + | '*' + | '/' + | '+' + | '$' + | '#' + | ' ' + | '\t' + | '\n' + | '\r' + | '\012' -> + true + | _ -> false + +let in_md_plain_delims = function + | '\\' + | '_' + | '^' + | '[' + | '*' + | '~' + | '`' + | '=' + | '$' + | '#' + | ' ' + | '\t' + | '\n' + | '\r' + | '\012' -> + true + | _ -> false + let in_plain_delims config c = - let plain_delims = - match config.format with - | Org -> org_plain_delims - | Markdown -> markdown_plain_delims - in - List.mem c plain_delims + match config.format with + | Org -> in_org_plain_delims c + | Markdown -> in_md_plain_delims c let whitespaces = ws >>| fun spaces -> Plain spaces @@ -566,6 +600,7 @@ let metadata = <|> string "{}" <|> return "" let link_inline = + (* Fail fast on ordinary words: require letter+:// without consuming. *) let protocol_part = take_while1 is_letter_or_digit <* string "://" in let before_path_part = take_while1 (fun c -> @@ -580,16 +615,17 @@ let link_inline = [ ('(', ')'); ('[', ']') ] (space_chars @ eol_chars) <|> return "" in - lift3 - (fun protocol before_path remain -> - Link - { label = [ Plain (protocol ^ "://" ^ before_path ^ remain) ] - ; url = Complex { protocol; link = before_path ^ remain } - ; title = None - ; full_text = protocol ^ "://" ^ before_path ^ remain - ; metadata = "" - }) - protocol_part before_path_part remaining_part + unsafe_lookahead (take_while1 is_letter_or_digit *> string "://") + *> lift3 + (fun protocol before_path remain -> + Link + { label = [ Plain (protocol ^ "://" ^ before_path ^ remain) ] + ; url = Complex { protocol; link = before_path ^ remain } + ; title = None + ; full_text = protocol ^ "://" ^ before_path ^ remain + ; metadata = "" + }) + protocol_part before_path_part remaining_part let quick_link_aux = let protocol_part_and_slashes = diff --git a/lib/syntax/lists0.ml b/lib/syntax/lists0.ml index 26ec70c2..4c40b75f 100644 --- a/lib/syntax/lists0.ml +++ b/lib/syntax/lists0.ml @@ -140,9 +140,12 @@ struct match name with | Some name -> let name = - match parse_string ~consume:All (Inline.parse config) name with - | Ok inlines -> inlines - | Error _e -> Type_op.inline_list_with_none_pos [ Inline.Plain name ] + if config.parse_outline_only then + Type_op.inline_list_with_none_pos [ Inline.Plain name ] + else + match parse_string ~consume:All (Inline.parse config) name with + | Ok inlines -> inlines + | Error _e -> Type_op.inline_list_with_none_pos [ Inline.Plain name ] in (name, description) | None -> ([], description)) diff --git a/lib/syntax/outline_inline.ml b/lib/syntax/outline_inline.ml index dcf4fe14..a462571b 100644 --- a/lib/syntax/outline_inline.ml +++ b/lib/syntax/outline_inline.ml @@ -1,57 +1,173 @@ open! Prelude open Angstrom open Parsers -open Conf - -let empty_plain _ = return (Inline.Plain "") - -let skip_char = any_char >>= empty_plain - -let in_plain_delims config c = - match config.format with - | Markdown -> c = '[' || c = '`' || is_whitespace c - | Org -> c = '[' || c = '=' || c = '~' || is_whitespace c - -let skip_plain config = take_till (in_plain_delims config) >>= empty_plain - -let inline_code config = Inline.code config >>= empty_plain - -let inline_choices config : Inline.t_with_pos Angstrom.t = - let skip_plain = any_char *> skip_plain config in - let p = - peek_char_fail >>= function - | '#' -> Inline.hash_tag config - | '[' -> Inline.nested_link_or_link config - | '(' -> Inline.block_reference config - | 'S' - | 'C' - | 'D' - | 's' - | 'c' - | 'd' -> - Inline.timestamp - | c -> ( - if is_whitespace c then - skip_char - else - match config.format with - | Markdown -> - if c = '`' then - inline_code config - else - fail "inline choice" - | Org -> - if c = '=' || c = '~' then - inline_code config - else - fail "inline choice") + +(** Outline mode only extracts node refs and tags (properties are block-level). *) +let is_outline_special = function '#' | '[' | '(' -> true | _ -> false + +let may_have_outline_markup _config s = + let n = String.length s in + let rec loop i = + if i >= n then + false + else if is_outline_special s.[i] then + true + else + loop (i + 1) in - let p' = p <|> skip_plain <|> skip_char in - (fun t -> (t, None)) <$> p' + loop 0 -let parse config = +let skip_plain_run = + skip_while (fun c -> (not (is_outline_special c)) && not (is_whitespace c)) + +let interesting config : Inline.t Angstrom.t = + peek_char_fail >>= function + | '#' -> Inline.hash_tag config + | '[' -> Inline.nested_link_or_link config + | '(' -> Inline.block_reference config + | _ -> fail "not outline inline" + +let inline_choices config : Inline.t_with_pos option Angstrom.t = + peek_char_fail >>= function + | c when is_whitespace c -> any_char *> return None + | _ -> + (interesting config >>| fun t -> Some (t, None)) + <|> (any_char *> skip_plain_run *> return None) + +let parse_angstrom config = many1 (inline_choices config) >>| (fun l -> - let l = remove (fun (t, _) -> t = Inline.Plain "") l in + let l = List.filter_map (fun x -> x) l in Inline.concat_plains l) - "inline" + "outline inline" + +let is_ws = function ' ' | '\t' | '\n' | '\r' -> true | _ -> false + +let tag_trail = function + | ',' | ';' | '.' | '!' | '?' | '\'' | '"' | ':' | '#' -> true + | _ -> false + +let find_page_ref_end s i = + let n = String.length s in + if i + 1 >= n || s.[i] <> '[' || s.[i + 1] <> '[' then + None + else + let rec loop j depth = + if j + 1 >= n then + None + else if s.[j] = '[' && s.[j + 1] = '[' then + loop (j + 2) (depth + 1) + else if s.[j] = ']' && s.[j + 1] = ']' then + if depth = 1 then + Some (j + 2) + else + loop (j + 2) (depth - 1) + else + loop (j + 1) depth + in + loop (i + 2) 1 + +let find_block_ref_end s i = + let n = String.length s in + if i + 1 >= n || s.[i] <> '(' || s.[i + 1] <> '(' then + None + else + let rec loop j = + if j + 1 >= n then + None + else if s.[j] = ')' && s.[j + 1] = ')' then + Some (j + 2) + else + loop (j + 1) + in + loop (i + 2) + +let page_ref_link name = + Inline.Link + { url = Inline.Page_ref name + ; label = [ Inline.Plain "" ] + ; title = None + ; full_text = "[[" ^ name ^ "]]" + ; metadata = "" + } + +let block_ref_link id = + Inline.Link + { url = Inline.Block_ref id + ; label = [ Inline.Plain "" ] + ; title = None + ; full_text = "((" ^ id ^ "))" + ; metadata = "" + } + +let strip_tag_trail raw = + let rec strip t = + let len = String.length t in + if len = 0 then + t + else if tag_trail t.[len - 1] then + strip (String.sub t 0 (len - 1)) + else + t + in + strip raw + +(** Fast path for #tag / [[page]] / ((block)). Returns None when markdown + links or nested-page hashtags need the angstrom parser. *) +let try_fast_scan s = + (* Escapes / backslashes need the real parser. *) + if String.contains s '\\' then + None + else + let n = String.length s in + let acc = ref [] in + let i = ref 0 in + let complex = ref false in + while !i < n && not !complex do + match s.[!i] with + | '#' when !i + 1 < n && not (is_ws s.[!i + 1]) && s.[!i + 1] <> '#' -> + let start = !i + 1 in + let j = ref start in + let has_bracket = ref false in + while !j < n && not (is_ws s.[!j]) do + if s.[!j] = '[' then + has_bracket := true; + incr j + done; + if !has_bracket then + complex := true + else + let name = strip_tag_trail (String.sub s start (!j - start)) in + if name <> "" then + acc := Inline.Tag [ Inline.Plain name ] :: !acc; + i := !j + | '[' when !i + 1 < n && s.[!i + 1] = '[' -> ( + match find_page_ref_end s !i with + | Some e -> + let name = String.sub s (!i + 2) (e - !i - 4) in + acc := page_ref_link name :: !acc; + i := e + | None -> complex := true) + | '[' -> complex := true + | '(' when !i + 1 < n && s.[!i + 1] = '(' -> ( + match find_block_ref_end s !i with + | Some e -> + let id = String.sub s (!i + 2) (e - !i - 4) in + acc := block_ref_link id :: !acc; + i := e + | None -> incr i) + | _ -> incr i + done; + if !complex then + None + else + Some (Type_op.inline_list_with_none_pos (List.rev !acc)) + +let parse config = + take_while (fun _ -> true) >>= fun s -> + match try_fast_scan s with + | Some result -> return result + | None -> ( + match parse_string ~consume:All (parse_angstrom config) s with + | Ok result -> return result + | Error e -> fail e) diff --git a/lib/syntax/paragraph.ml b/lib/syntax/paragraph.ml index a12d8e72..59290f80 100644 --- a/lib/syntax/paragraph.ml +++ b/lib/syntax/paragraph.ml @@ -18,20 +18,26 @@ let trim_last_space s = let parse = line >>| fun l -> Paragraph_line l +let plain_paragraph content = + Paragraph (Type_op.inline_list_with_none_pos [ Inline.Plain content ]) + let parse_lines config lines pos1 pos2 = let lines = List.rev lines in let content = String.concat "" lines in let paragraph = - let inline_parse = - if config.parse_outline_only then - Outline_inline.parse + if config.parse_outline_only then + if Outline_inline.may_have_outline_markup config content then + match + parse_string ~consume:All (Outline_inline.parse config) content + with + | Ok result -> Paragraph result + | Error _ -> Paragraph [] else - Inline.parse - in - match parse_string ~consume:All (inline_parse config) content with - | Ok result -> Paragraph result - | Error _ -> - Paragraph (Type_op.inline_list_with_none_pos [ Inline.Plain content ]) + Paragraph [] + else + match parse_string ~consume:All (Inline.parse config) content with + | Ok result -> Paragraph result + | Error _ -> plain_paragraph content in (paragraph, { start_pos = pos1; end_pos = pos2 }) diff --git a/test/test_outline_markdown.ml b/test/test_outline_markdown.ml index 8b0207b2..5bb3db28 100644 --- a/test/test_outline_markdown.ml +++ b/test/test_outline_markdown.ml @@ -503,118 +503,31 @@ let inline = ] ) ; ( "Timestamps" , testcases - [ ( "scheduled" + [ (* Outline mode skips timestamps; only refs/tags/properties. *) + ( "scheduled" , `Quick - , check_aux "SCHEDULED: <2004-12-25 Sat>" - (paragraph - [ I.Timestamp - (Scheduled - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = None - ; active = true - }) - ]) ) + , check_aux "SCHEDULED: <2004-12-25 Sat>" (paragraph []) ) ; ( "scheduled with time" , `Quick - , check_aux "SCHEDULED: <2004-12-25 Sat 10:00>" - (paragraph - [ I.Timestamp - (Scheduled - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = Some { hour = 10; min = 0 } - ; repetition = None - ; active = true - }) - ]) ) + , check_aux "SCHEDULED: <2004-12-25 Sat 10:00>" (paragraph []) ) ; ( "scheduled with a repeater" , `Quick - , check_aux "SCHEDULED: <2004-12-25 Sat +1m>" - (paragraph - [ I.Timestamp - (Scheduled - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = Some (Plus, Month, 1) - ; active = true - }) - ]) ) + , check_aux "SCHEDULED: <2004-12-25 Sat +1m>" (paragraph []) ) ; ( "scheduled after some text" , `Quick - , check_aux "blabla SCHEDULED: <2004-12-25 Sat>" - (paragraph - [ I.Timestamp - (Scheduled - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = None - ; active = true - }) - ]) ) + , check_aux "blabla SCHEDULED: <2004-12-25 Sat>" (paragraph []) ) ; ( "deadline" , `Quick - , check_aux "DEADLINE: <2004-12-25 Sat>" - (paragraph - [ I.Timestamp - (Deadline - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = None - ; active = true - }) - ]) ) + , check_aux "DEADLINE: <2004-12-25 Sat>" (paragraph []) ) ; ( "deadline with time" , `Quick - , check_aux "DEADLINE: <2004-12-25 Sat 10:00>" - (paragraph - [ I.Timestamp - (Deadline - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = Some { hour = 10; min = 0 } - ; repetition = None - ; active = true - }) - ]) ) + , check_aux "DEADLINE: <2004-12-25 Sat 10:00>" (paragraph []) ) ; ( "deadline with a repeater" , `Quick - , check_aux "DEADLINE: <2004-12-25 Sat +1m>" - (paragraph - [ I.Timestamp - (Deadline - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = Some (Plus, Month, 1) - ; active = true - }) - ]) ) + , check_aux "DEADLINE: <2004-12-25 Sat +1m>" (paragraph []) ) ; ( "deadline after some text" , `Quick - , check_aux "blabla DEADLINE: <2004-12-25 Sat>" - (paragraph - [ I.Timestamp - (Deadline - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = None - ; active = true - }) - ]) ) + , check_aux "blabla DEADLINE: <2004-12-25 Sat>" (paragraph []) ) ] ) ] @@ -760,17 +673,7 @@ let block = ; unordered = true ; size = None } - ; paragraph - [ I.Timestamp - (Scheduled - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = None - ; active = true - }) - ] + ; paragraph [] ] ) ; ( "a heading with a scheduled" , `Quick @@ -787,17 +690,7 @@ let block = ; unordered = false ; size = Some 1 } - ; paragraph - [ I.Timestamp - (Scheduled - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = None - ; active = true - }) - ] + ; paragraph [] ] ) ; ( "a heading with a scheduled and some text" , `Quick @@ -815,16 +708,7 @@ let block = ; size = Some 1 } ; paragraph - [ I.Timestamp - (Scheduled - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = None - ; active = true - }) - ; I.Link + [ I.Link { url = I.Page_ref "page" ; label = [ I.Plain "" ] ; title = None @@ -853,25 +737,7 @@ let block = ; size = Some 1 } ; paragraph - [ I.Timestamp - (Scheduled - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = None - ; active = true - }) - ; I.Timestamp - (Deadline - Timestamp. - { date = { year = 2004; month = 12; day = 25 } - ; wday = "Sat" - ; time = None - ; repetition = None - ; active = true - }) - ; I.Link + [ I.Link { url = I.Page_ref "page" ; label = [ I.Plain "" ] ; title = None From 8b11f2ed26841f98c2c53268c99feac0541cc07b Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Sat, 29 Aug 2026 09:32:16 +0000 Subject: [PATCH 2/8] perf: line-oriented Markdown outline_only parser (~12x) Replace Angstrom block choice for MD outline with a dedicated line scanner (headings, properties, lists, quotes, fences, footnotes) while keeping Outline_inline for refs/tags. Fixes parse_md_outline empty-title edge cases via the new path. ~0.026s vs ~0.30s master on 1.2MB fixture. Co-authored-by: Tienson Qin --- lib/mldoc_parser.ml | 75 ++--- lib/syntax/heading0.ml | 49 +++ lib/syntax/md_outline.ml | 622 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 711 insertions(+), 35 deletions(-) create mode 100644 lib/syntax/md_outline.ml diff --git a/lib/mldoc_parser.ml b/lib/mldoc_parser.ml index efad197b..cb3bb545 100644 --- a/lib/mldoc_parser.ml +++ b/lib/mldoc_parser.ml @@ -146,44 +146,49 @@ let build_md_outline_parsers config = let parse config input = let outline_only = Conf.(config.parse_outline_only) in let md = Conf.is_markdown config in - let parsers = - match (md, outline_only) with - | true, true -> build_md_outline_parsers config - | true, false -> build_choice_parsers md_full_parsers config - | false, true -> build_choice_parsers org_outline_parsers config - | false, false -> build_choice_parsers org_full_parsers config - in - match parse_string ~consume:All parsers input with - | Ok result -> - let ast = Paragraph.concat_paragraph_lines config result in - let ast = - if outline_only then - Prelude.remove - (fun (t, _) -> - match t with - | Type.Results - | Type.Example _ - | Type.Src _ - | Type.Latex_Environment _ - | Type.Latex_Fragment _ - | Type.Displayed_Math _ - | Type.Horizontal_Rule - | Type.Raw_Html _ - | Type.Hiccup _ -> - true - | _ -> false) + (* Markdown outline: line-oriented fast path (no Angstrom block choice). *) + if md && outline_only then + let ast = Md_outline.parse config input in + if String.contains input '\\' then + List.map (fun (t, pos) -> (Type_op.md_unescaped t, pos)) ast + else + ast + else + let parsers = + match (md, outline_only) with + | true, false -> build_choice_parsers md_full_parsers config + | false, true -> build_choice_parsers org_outline_parsers config + | false, false -> build_choice_parsers org_full_parsers config + | true, true -> assert false + in + match parse_string ~consume:All parsers input with + | Ok result -> + let ast = Paragraph.concat_paragraph_lines config result in + let ast = + if outline_only then + Prelude.remove + (fun (t, _) -> + match t with + | Type.Results + | Type.Example _ + | Type.Src _ + | Type.Latex_Environment _ + | Type.Latex_Fragment _ + | Type.Displayed_Math _ + | Type.Horizontal_Rule + | Type.Raw_Html _ + | Type.Hiccup _ -> + true + | _ -> false) + ast + else ast + in + if Conf.is_markdown config then + List.map (fun (t, pos) -> (Type_op.md_unescaped t, pos)) ast else ast - in - if Conf.is_markdown config then - if outline_only && not (String.contains input '\\') then - ast - else - List.map (fun (t, pos) -> (Type_op.md_unescaped t, pos)) ast - else - ast - | Error err -> failwith err + | Error err -> failwith err let load_file f = let ic = open_in f in diff --git a/lib/syntax/heading0.ml b/lib/syntax/heading0.ml index 1421702e..025e0caf 100644 --- a/lib/syntax/heading0.ml +++ b/lib/syntax/heading0.ml @@ -154,7 +154,56 @@ struct else [] + let make_outline_heading ~level ~unordered ~size ~marker ~priority ~title = + Heading + { level + ; marker + ; priority + ; title + ; tags = [] + ; anchor = "" + ; meta = { timestamps = []; properties = [] } + ; numbering = None + ; unordered + ; size + } + + (** Fast MD outline heading: reuse [level], skip title_aux Block/Drawer. *) + let parse_md_outline config = + level config "Heading level" >>= fun (level, unordered, size) -> + (if not config.parse_marker then return None + else optional (spaces *> marker "Heading marker")) + >>= fun marker -> + (if not config.parse_priority then return None + else optional (spaces *> priority "Heading priority")) + >>= fun priority -> + optional spaces *> peek_char >>= function + | Some '`' + | Some '>' -> + (* Leave fence/quote on the line for Block.parse. *) + return + (make_outline_heading ~level ~unordered ~size ~marker ~priority + ~title:[]) + | None -> + return + (make_outline_heading ~level ~unordered ~size ~marker ~priority + ~title:[]) + | Some c when is_eol c -> + return + (make_outline_heading ~level ~unordered ~size ~marker ~priority + ~title:[]) + <* optional eol + | _ -> + optional_line >>= fun title -> + return + (make_outline_heading ~level ~unordered ~size ~marker ~priority + ~title:(outline_title config title)) + <* optional (end_of_line <|> end_of_input) + let parse config = + if config.parse_outline_only && Conf.is_markdown config then + parse_md_outline config + else let p = lift4 (fun (level, unordered, size) marker priority pos_and_title -> diff --git a/lib/syntax/md_outline.ml b/lib/syntax/md_outline.ml new file mode 100644 index 00000000..9c226a1b --- /dev/null +++ b/lib/syntax/md_outline.ml @@ -0,0 +1,622 @@ +(* Fast Markdown outline_only document parser. + Line-oriented; avoids Angstrom choice/backtracking on the Logseq hot path. + Extracts headings, properties, lists, quotes, footnotes, and outline inline + (tags / page refs / block refs / markdown links). *) + +open! Prelude +open Type +open Conf + +let dummy = Pos.dummy_pos + +let with_pos t = (t, dummy) + +let markers = + [| "IN-PROGRESS" + ; "CANCELLED" + ; "CANCELED" + ; "WAITING" + ; "STARTED" + ; "DOING" + ; "TODO" + ; "WAIT" + ; "DONE" + ; "NOW" + ; "LATER" + |] + +let is_space_char = function + | ' ' + | '\t' -> + true + | _ -> false + +let rstrip_cr s = + let n = String.length s in + if n > 0 && s.[n - 1] = '\r' then + String.sub s 0 (n - 1) + else + s + +let skip_spaces s i = + let n = String.length s in + let rec loop j = + if j < n && is_space_char s.[j] then + loop (j + 1) + else + j + in + loop i + +let indent_len s = + let n = String.length s in + let rec loop i = + if i < n && is_space_char s.[i] then + loop (i + 1) + else + i + in + loop 0 + +let starts_with_at s i prefix = + let plen = String.length prefix in + let n = String.length s in + i + plen <= n + && + let rec loop k = + if k = plen then + true + else if s.[i + k] = prefix.[k] then + loop (k + 1) + else + false + in + loop 0 + +let is_blank_line s = + let n = String.length s in + let rec loop i = + if i >= n then + true + else if is_space_char s.[i] then + loop (i + 1) + else + false + in + loop 0 + +let is_fence_line line = + let ind = indent_len line in + let n = String.length line in + ind + 3 <= n + && line.[ind] = '`' + && line.[ind + 1] = '`' + && line.[ind + 2] = '`' + +let is_quote_line line = + let ind = indent_len line in + ind < String.length line && line.[ind] = '>' + +let is_properties_start line = + String.lowercase_ascii (String.trim line) = ":properties:" + +let is_end_mark line = String.lowercase_ascii (String.trim line) = ":end:" + +let is_list_item_prefix line = + let ind = indent_len line in + let n = String.length line in + if ind + 2 <= n then + let c = line.[ind] in + if (c = '+' || c = '*') && is_space_char line.[ind + 1] then + true + else if c >= '0' && c <= '9' then + let j = ref (ind + 1) in + while !j < n && line.[!j] >= '0' && line.[!j] <= '9' do + incr j + done; + !j < n && line.[!j] = '.' && !j + 1 < n && is_space_char line.[!j + 1] + else + false + else + false + +let outline_inlines config s = + if s = "" then + [] + else if Outline_inline.may_have_outline_markup config s then + match Outline_inline.try_fast_scan s with + | Some r -> r + | None -> ( + match + Angstrom.parse_string ~consume:All (Outline_inline.parse config) s + with + | Ok r -> r + | Error _ -> []) + else + [] + +let outline_paragraph config s = Paragraph (outline_inlines config s) + +let filter_prop_refs inlines = + List.map fst inlines + |> List.filter (function + | Inline.Tag _ + | Inline.Link _ + | Inline.Nested_link _ -> + true + | _ -> false) + +let heading ~level ~unordered ~size ~marker ~priority ~title = + Heading + { level + ; marker + ; priority + ; title + ; tags = [] + ; anchor = "" + ; meta = { timestamps = []; properties = [] } + ; numbering = None + ; unordered + ; size + } + +let try_marker s i = + if i >= String.length s then + None + else + let rec loop k = + if k >= Array.length markers then + None + else + let m = markers.(k) in + if starts_with_at s i m then + let j = i + String.length m in + if j >= String.length s || is_space_char s.[j] then + Some (m, j) + else + loop (k + 1) + else + loop (k + 1) + in + loop 0 + +let try_priority s i = + let n = String.length s in + if i + 3 < n && s.[i] = '[' && s.[i + 1] = '#' && s.[i + 3] = ']' then + Some (s.[i + 2], i + 4) + else + None + +let parse_marker_priority_title config s i = + let i = skip_spaces s i in + let marker, i = + match try_marker s i with + | Some (m, j) -> (Some m, skip_spaces s j) + | None -> (None, i) + in + let priority, i = + match try_priority s i with + | Some (p, j) -> (Some p, skip_spaces s j) + | None -> (None, i) + in + let title = + if i >= String.length s then + "" + else + String.sub s i (String.length s - i) + in + let title_inlines, keep_title = + if title = "" then + ([], true) + else + match title.[0] with + | '`' + | '>' -> + ([], false) + | _ -> + (outline_inlines config title, true) + in + (marker, priority, title_inlines, keep_title, title) + +let parse_size_hashes s i = + let n = String.length s in + if i >= n || s.[i] <> '#' then + (None, i) + else + let j = ref i in + while !j < n && s.[!j] = '#' do + incr j + done; + let count = !j - i in + if !j >= n || is_space_char s.[!j] then + (Some count, !j) + else + (None, i) + +(** [Some (heading, opens_fence)] *) +let try_dash_heading config line = + let ind = indent_len line in + let n = String.length line in + if ind >= n || line.[ind] <> '-' then + None + else if ind + 1 < n && not (is_space_char line.[ind + 1]) then + if ind + 1 = n then + Some + ( heading ~level:(ind + 1) ~unordered:true ~size:None ~marker:None + ~priority:None ~title:[] + , false ) + else + None + else + let i = skip_spaces line (ind + 1) in + let size, i = parse_size_hashes line i in + let marker, priority, title, keep_title, raw_title = + parse_marker_priority_title config line i + in + let opens_fence = + (not keep_title) && String.length raw_title > 0 && raw_title.[0] = '`' + in + Some + ( heading ~level:(ind + 1) ~unordered:true ~size ~marker ~priority ~title + , opens_fence ) + +let try_atx_heading config line = + let ind = indent_len line in + let n = String.length line in + if ind >= n || line.[ind] <> '#' then + None + else + let j = ref ind in + while !j < n && line.[!j] = '#' do + incr j + done; + let size = !j - ind in + if size = 0 then + None + else if !j < n && not (is_space_char line.[!j]) then + None + else + let marker, priority, title, _, _ = + parse_marker_priority_title config line !j + in + Some + (heading ~level:(ind + 1) ~unordered:false ~size:(Some size) ~marker + ~priority ~title) + +let try_md_property config line = + let ind = indent_len line in + let n = String.length line in + let i = ind in + if i >= n then + None + else + let key_start = i in + let j = ref i in + while + !j < n + && line.[!j] <> ':' + && (not (is_space_char line.[!j])) + && line.[!j] <> '\n' + do + incr j + done; + if !j = key_start then + None + else if !j + 1 < n && line.[!j] = ':' && line.[!j + 1] = ':' then + let key = String.sub line key_start (!j - key_start) in + let rest_i = skip_spaces line (!j + 2) in + let value = + if rest_i >= n then + "" + else + String.trim (String.sub line rest_i (n - rest_i)) + in + Some (key, value, filter_prop_refs (outline_inlines config value)) + else + None + +let try_org_style_prop line = + let ind = indent_len line in + let n = String.length line in + if ind + 2 >= n || line.[ind] <> '#' || line.[ind + 1] <> '+' then + None + else + let i = ind + 2 in + let j = ref i in + while !j < n && line.[!j] <> ':' && not (is_space_char line.[!j]) do + incr j + done; + if !j > i && !j < n && line.[!j] = ':' then + let name = String.sub line i (!j - i) in + let rest_i = skip_spaces line (!j + 1) in + let value = + if rest_i >= n then + "" + else + String.sub line rest_i (n - rest_i) + in + Some (name, value, []) + else + None + +let try_org_drawer_prop_line config line = + let ind = indent_len line in + let n = String.length line in + if ind >= n || line.[ind] <> ':' then + None + else + let i = ind + 1 in + let j = ref i in + while !j < n && line.[!j] <> ':' && not (is_space_char line.[!j]) do + incr j + done; + if !j > i && !j < n && line.[!j] = ':' then + let key = String.sub line i (!j - i) in + if String.lowercase_ascii key = "end" then + None + else + let rest_i = skip_spaces line (!j + 1) in + let value = + if rest_i >= n then + "" + else + String.trim (String.sub line rest_i (n - rest_i)) + in + Some (key, value, filter_prop_refs (outline_inlines config value)) + else + None + +let try_footnote_line config line = + let ind = indent_len line in + let n = String.length line in + if ind + 3 <= n && line.[ind] = '[' && line.[ind + 1] = '^' then + try + let close = String.index_from line (ind + 2) ']' in + if close + 1 < n && line.[close + 1] = ':' then + let name = String.sub line (ind + 2) (close - ind - 2) in + let rest_i = skip_spaces line (close + 2) in + let body = + if rest_i >= n then + "" + else + String.sub line rest_i (n - rest_i) + in + let inlines = + if body = "" then + [] + else if Outline_inline.may_have_outline_markup config body then + outline_inlines config body + else + Type_op.inline_list_with_none_pos [ Inline.Plain body ] + in + Some (Footnote_Definition (name, inlines)) + else + None + with Not_found -> None + else + None + +let collect_properties_drawer config lines i = + if not (is_properties_start lines.(i)) then + None + else + let rec loop j acc = + if j >= Array.length lines then + Some (List.rev acc, j) + else if is_end_mark lines.(j) then + Some (List.rev acc, j + 1) + else + match try_org_drawer_prop_line config lines.(j) with + | Some kv -> loop (j + 1) (kv :: acc) + | None -> + if is_blank_line lines.(j) then + loop (j + 1) acc + else + loop (j + 1) acc + in + loop (i + 1) [] + +let collect_properties config lines i = + let rec loop j acc = + if j >= Array.length lines then + (List.rev acc, j) + else + match try_md_property config lines.(j) with + | Some kv -> loop (j + 1) (kv :: acc) + | None -> ( + match try_org_style_prop lines.(j) with + | Some kv -> loop (j + 1) (kv :: acc) + | None -> (List.rev acc, j)) + in + loop i [] + +let is_block_boundary config line = + is_blank_line line + || try_dash_heading config line <> None + || try_atx_heading config line <> None + || is_fence_line line + || is_quote_line line + || is_list_item_prefix line + || is_properties_start line + || try_md_property config line <> None + || try_org_style_prop line <> None + || try_footnote_line config line <> None + +let collect_paragraph_lines config lines i = + let n = Array.length lines in + let rec loop j acc = + if j >= n then + (List.rev acc, j) + else if is_block_boundary config lines.(j) then + (List.rev acc, j) + else + loop (j + 1) (lines.(j) :: acc) + in + let ls, j = loop i [] in + let content = String.concat "\n" ls in + (outline_paragraph config content, j) + +let skip_fence_body lines i = + let rec loop j = + if j >= Array.length lines then + j + else if is_fence_line lines.(j) then + j + 1 + else + loop (j + 1) + in + loop i + +let skip_fence lines i = skip_fence_body lines (i + 1) + +let collect_quote config lines i = + let rec loop j acc = + if j >= Array.length lines then + (List.rev acc, j) + else if is_quote_line lines.(j) then + let line = lines.(j) in + let ind = indent_len line in + let body_i = + if ind < String.length line && line.[ind] = '>' then + skip_spaces line (ind + 1) + else + ind + in + let body = + if body_i >= String.length line then + "" + else + String.sub line body_i (String.length line - body_i) + in + loop (j + 1) (body :: acc) + else + (List.rev acc, j) + in + let bodies, j = loop i [] in + (* Match Angstrom quote + concat_paragraph_lines: one merged paragraph. *) + let content = String.concat "\n" bodies in + (Quote [ outline_paragraph config content ], j) + +let parse_list_item_line line = + let ind = indent_len line in + let n = String.length line in + let c = line.[ind] in + if c = '+' || c = '*' then + let content = String.trim (String.sub line (ind + 2) (n - ind - 2)) in + (ind, false, None, content) + else + let j = ref ind in + while !j < n && line.[!j] >= '0' && line.[!j] <= '9' do + incr j + done; + let num_str = String.sub line ind (!j - ind) in + let content = String.trim (String.sub line (!j + 2) (n - !j - 2)) in + (ind, true, Some (int_of_string num_str), content) + +let make_list_item config ~indent ~ordered ~number content children = + { content = + (if content = "" then + [] + else + [ outline_paragraph config content ]) + ; items = children + ; number + ; name = [] + ; checkbox = None + ; indent + ; ordered + } + +let rec parse_list_items config lines i min_indent = + let items = ref [] in + let j = ref i in + let continue = ref true in + while !continue && !j < Array.length lines do + let line = lines.(!j) in + if is_blank_line line then + incr j + else if + try_dash_heading config line <> None || try_atx_heading config line <> None + then + continue := false + else if is_list_item_prefix line then + let indent, ordered, number, content = parse_list_item_line line in + if indent < min_indent then + continue := false + else ( + incr j; + let children, j' = + if !j < Array.length lines && is_list_item_prefix lines.(!j) then + let child_indent = indent_len lines.(!j) in + if child_indent > indent then + parse_list_items config lines !j child_indent + else + ([], !j) + else + ([], !j) + in + j := j'; + items := + make_list_item config ~indent ~ordered ~number content children + :: !items) + else + continue := false + done; + (List.rev !items, !j) + +let parse config input = + let raw_lines = String.split_on_char '\n' input in + let lines = Array.of_list (List.map rstrip_cr raw_lines) in + let n = Array.length lines in + let acc = ref [] in + let i = ref 0 in + while !i < n do + let line = lines.(!i) in + if is_blank_line line then + incr i + else + match try_dash_heading config line with + | Some (h, opens_fence) -> + acc := with_pos h :: !acc; + incr i; + if opens_fence then + i := skip_fence_body lines !i + | None -> ( + match try_atx_heading config line with + | Some h -> + acc := with_pos h :: !acc; + incr i + | None -> ( + match try_footnote_line config line with + | Some fn -> + acc := with_pos fn :: !acc; + incr i + | None -> ( + match collect_properties_drawer config lines !i with + | Some (kvs, j) -> + acc := with_pos (Property_Drawer kvs) :: !acc; + i := j + | None -> ( + match collect_properties config lines !i with + | _ :: _ as kvs, j -> + acc := with_pos (Property_Drawer kvs) :: !acc; + i := j + | [], _ -> + if is_fence_line line then + i := skip_fence lines !i + else if is_quote_line line then + let q, j = collect_quote config lines !i in + acc := with_pos q :: !acc; + i := j + else if is_list_item_prefix line then + let items, j = + parse_list_items config lines !i (indent_len line) + in + acc := with_pos (List items) :: !acc; + i := j + else + let p, j = collect_paragraph_lines config lines !i in + acc := with_pos p :: !acc; + i := j)))) + done; + List.rev !acc From f356865a6bc2fa7ae808b3cc1cfc0e547c1d6b1a Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Sat, 29 Aug 2026 09:33:30 +0000 Subject: [PATCH 3/8] style: ocamlformat after outline parser changes Co-authored-by: Tienson Qin --- bench/time_parse.ml | 32 +++--- lib/export/conf.ml | 7 +- lib/syntax/heading0.ml | 204 ++++++++++++++++++----------------- lib/syntax/inline.ml | 88 ++++++++------- lib/syntax/lists0.ml | 7 +- lib/syntax/md_outline.ml | 32 +++--- lib/syntax/outline_inline.ml | 39 +++++-- 7 files changed, 221 insertions(+), 188 deletions(-) diff --git a/bench/time_parse.ml b/bench/time_parse.ml index 8561efc2..a7d38ada 100644 --- a/bench/time_parse.ml +++ b/bench/time_parse.ml @@ -1,5 +1,6 @@ (** Wall-clock timing focused on Markdown (Logseq) workloads. *) open Mldoc.Parser + open Mldoc.Conf let ensure_logseq_large path = @@ -7,18 +8,18 @@ let ensure_logseq_large path = let buf = Buffer.create 1_200_000 in for i = 0 to 3999 do Buffer.add_string buf - (Printf.sprintf - "- Block title %d with [[page %d]] and #tag%d\n" i (i mod 50) - (i mod 20)); + (Printf.sprintf "- Block title %d with [[page %d]] and #tag%d\n" i + (i mod 50) (i mod 20)); if i mod 3 = 0 then Buffer.add_string buf (Printf.sprintf " id:: %08x-xxxx-xxxx-xxxx-%012x\n" i i); if i mod 5 = 0 then ( Buffer.add_string buf - (Printf.sprintf - " - child of %d with ((%08x-xxxx-xxxx-xxxx-%012x))\n" i i i); + (Printf.sprintf " - child of %d with ((%08x-xxxx-xxxx-xxxx-%012x))\n" + i i i); Buffer.add_string buf - (Printf.sprintf " more plain text line without markup %d\n" i)); + (Printf.sprintf " more plain text line without markup %d\n" i) + ); if i mod 7 = 0 then Buffer.add_string buf (Printf.sprintf @@ -26,7 +27,8 @@ let ensure_logseq_large path = if i mod 11 = 0 then Buffer.add_string buf (Printf.sprintf " + unordered item %d\n" i); if i mod 13 = 0 then - Buffer.add_string buf (Printf.sprintf " ```\n code line %d\n ```\n" i) + Buffer.add_string buf + (Printf.sprintf " ```\n code line %d\n ```\n" i) done; let content = Buffer.contents buf in (* Grow to ~1.2MB so benches stay comparable across revisions. *) @@ -39,10 +41,10 @@ let ensure_logseq_large path = let grown = String.concat "" (List.rev !pieces) in let oc = open_out path in output_string oc (String.sub grown 0 1_200_000); - close_out oc) + close_out oc + ) let () = ensure_logseq_large "./examples/logseq_large.md" - let doc_org = load_file "./examples/doc.org" let syntax_md = load_file "./examples/syntax.md" let logseq_md = load_file "./examples/logseq_large.md" @@ -91,11 +93,11 @@ let () = in Printf.printf "iterations=%d (avg seconds)\n" n; Printf.printf "MD logseq_large full: %.4f\n" md_full; - Printf.printf "MD logseq_large outline_only: %.4f (%.1fx vs full)\n" md_outline - (md_full /. md_outline); + Printf.printf "MD logseq_large outline_only: %.4f (%.1fx vs full)\n" + md_outline (md_full /. md_outline); Printf.printf "MD syntax.md full: %.4f\n" syn_full; - Printf.printf "MD syntax.md outline_only: %.4f (%.1fx vs full)\n" syn_outline - (syn_full /. syn_outline); + Printf.printf "MD syntax.md outline_only: %.4f (%.1fx vs full)\n" + syn_outline (syn_full /. syn_outline); Printf.printf "Org doc.org full: %.4f\n" org_full; - Printf.printf "Org doc.org outline_only: %.4f (%.1fx vs full)\n" org_outline - (org_full /. org_outline) + Printf.printf "Org doc.org outline_only: %.4f (%.1fx vs full)\n" + org_outline (org_full /. org_outline) diff --git a/lib/export/conf.ml b/lib/export/conf.ml index 06d33534..9905bad0 100644 --- a/lib/export/conf.ml +++ b/lib/export/conf.ml @@ -52,16 +52,15 @@ type t = ; exporting_keep_properties : bool [@default false] (* keep properties when exporting *) ; inline_type_with_pos : bool [@default false] - ; inline_skip_macro: bool [@default false] + ; inline_skip_macro : bool [@default false] ; export_md_indent_style : indent_style [@default Dashes] ; export_md_remove_options : meta_chars list [@default []] ; hiccup_in_block : bool [@default true] ; enable_drawers : bool [@default true] - ; parse_marker: bool [@default true] - ; parse_priority: bool [@default true] + ; parse_marker : bool [@default true] + ; parse_priority : bool [@default true] } [@@deriving yojson] let is_markdown t = t.format = Markdown - let is_org t = t.format = Org diff --git a/lib/syntax/heading0.ml b/lib/syntax/heading0.ml index 025e0caf..e1aaa03b 100644 --- a/lib/syntax/heading0.ml +++ b/lib/syntax/heading0.ml @@ -86,11 +86,11 @@ struct if config.parse_outline_only then (* Only run Block when the title might be a fence/quote. *) Angstrom.unsafe_lookahead - ( peek_char >>= function - | Some '`' - | Some '>' -> - Block.parse config <|> Paragraph.parse - | _ -> Paragraph.parse ) + (peek_char >>= function + | Some '`' + | Some '>' -> + Block.parse config <|> Paragraph.parse + | _ -> Paragraph.parse) else if Conf.is_markdown config then (* Markdown: most titles are plain lines; avoid Org-heavy lookahead. *) Angstrom.unsafe_lookahead @@ -171,11 +171,15 @@ struct (** Fast MD outline heading: reuse [level], skip title_aux Block/Drawer. *) let parse_md_outline config = level config "Heading level" >>= fun (level, unordered, size) -> - (if not config.parse_marker then return None - else optional (spaces *> marker "Heading marker")) + (if not config.parse_marker then + return None + else + optional (spaces *> marker "Heading marker")) >>= fun marker -> - (if not config.parse_priority then return None - else optional (spaces *> priority "Heading priority")) + (if not config.parse_priority then + return None + else + optional (spaces *> priority "Heading priority")) >>= fun priority -> optional spaces *> peek_char >>= function | Some '`' @@ -204,95 +208,99 @@ struct if config.parse_outline_only && Conf.is_markdown config then parse_md_outline config else - let p = - lift4 - (fun (level, unordered, size) marker priority pos_and_title -> - let title = - match pos_and_title with - | None -> [] - | Some (_pos, title) -> ( + let p = + lift4 + (fun (level, unordered, size) marker priority pos_and_title -> + let title = + match pos_and_title with + | None -> [] + | Some (_pos, title) -> ( + if config.parse_outline_only then + outline_title config title + else + match + parse_string ~consume:All (Inline.parse config) title + with + | Ok title -> title + | Error _e -> []) + in + let title, tags = + match title with + | [] -> (title, []) + | _ -> ( + match config.format with + | Org -> ( + let last_inline = List.nth title (List.length title - 1) in + match last_inline with + | Inline.Plain s, _ -> + let s = String.trim s in + if String.length s > 1 && s.[String.length s - 1] = ':' then + let prefix, maybe_tags = splitr (fun c -> c <> ' ') s in + match parse_string ~consume:All tags maybe_tags with + | Ok tags -> + let title = + if prefix = "" then + drop_last 1 title + else + drop_last 1 title + @ Type_op.inline_list_with_none_pos + [ Inline.Plain prefix ] + in + let open Option in + let last_plain = + List.nth_opt title (List.length title - 1) + >>| fun (inline_t, pos) -> + ( (match inline_t with + | Inline.Plain s -> + Inline.Plain (String.rtrim s ^ " ") + | _ -> inline_t) + , pos ) + in + let title' = + if Option.is_some last_plain then + let _, butlast_title = butlast title in + List.append butlast_title [ Option.get last_plain ] + else + title + in + (title', remove is_blank tags) + | _ -> (title, []) + else + (title, []) + | _ -> (title, [])) + | Markdown -> (title, [])) + in + let anchor = if config.parse_outline_only then - outline_title config title + "" else - match parse_string ~consume:All (Inline.parse config) title with - | Ok title -> title - | Error _e -> []) - in - let title, tags = - match title with - | [] -> (title, []) - | _ -> ( - match config.format with - | Org -> ( - let last_inline = List.nth title (List.length title - 1) in - match last_inline with - | Inline.Plain s, _ -> - let s = String.trim s in - if String.length s > 1 && s.[String.length s - 1] = ':' then - let prefix, maybe_tags = splitr (fun c -> c <> ' ') s in - match parse_string ~consume:All tags maybe_tags with - | Ok tags -> - let title = - if prefix = "" then - drop_last 1 title - else - drop_last 1 title - @ Type_op.inline_list_with_none_pos - [ Inline.Plain prefix ] - in - let open Option in - let last_plain = - List.nth_opt title (List.length title - 1) - >>| fun (inline_t, pos) -> - ( (match inline_t with - | Inline.Plain s -> Inline.Plain (String.rtrim s ^ " ") - | _ -> inline_t) - , pos ) - in - let title' = - if Option.is_some last_plain then - let _, butlast_title = butlast title in - List.append butlast_title [ Option.get last_plain ] - else - title - in - (title', remove is_blank tags) - | _ -> (title, []) - else - (title, []) - | _ -> (title, [])) - | Markdown -> (title, [])) - in - let anchor = - if config.parse_outline_only then - "" - else - anchor_link - (Inline.asciis (Type_op.inline_list_strip_pos title)) - in - let meta = { timestamps = []; properties = [] } in - Heading - { level - ; marker - ; priority - ; title - ; tags - ; anchor - ; meta - ; numbering = None - ; unordered - ; size - }) - (level config "Heading level") - (if not config.parse_marker then - return None - else - optional (ws *> marker "Heading marker")) - (if not config.parse_priority then - return None - else - optional (ws *> priority "Heading priority")) - (optional (ws *> Angstrom.both pos (title config) "Heading title")) - in - p <* optional (end_of_line <|> end_of_input) + anchor_link + (Inline.asciis (Type_op.inline_list_strip_pos title)) + in + let meta = { timestamps = []; properties = [] } in + Heading + { level + ; marker + ; priority + ; title + ; tags + ; anchor + ; meta + ; numbering = None + ; unordered + ; size + }) + (level config "Heading level") + (if not config.parse_marker then + return None + else + optional (ws *> marker "Heading marker")) + (if not config.parse_priority then + return None + else + optional (ws *> priority "Heading priority")) + (optional + (ws *> Angstrom.both pos (title config) "Heading title")) + in + p <* optional (end_of_line <|> end_of_input) end diff --git a/lib/syntax/inline.ml b/lib/syntax/inline.ml index 8c062753..f83e252b 100644 --- a/lib/syntax/inline.ml +++ b/lib/syntax/inline.ml @@ -146,9 +146,7 @@ let t_with_pos_of_yojson (json : Yojson.Safe.t) = type inner_state = { mutable last_plain_char : char option } let quicklink_delims = [ '>' ] @ eol_chars - let inline_link_delims = [ '['; ']'; '<'; '>'; '{'; '}'; '('; ')' ] @ eol_chars - let email = Email_address.email >>| fun email -> Email email let between ?(e = None) s = @@ -182,7 +180,6 @@ let code_aux_p c = "Inline code" let org_code = code_aux_p "~" - let md_code = code_aux_p "`" <|> markdown_escape_backticks let code config = @@ -355,11 +352,11 @@ let md_em_parser ?(nested = false) ?(include_md_code = true) pattern typ = set_char_before_pattern (Plain s); Plain s ) ; (if include_md_code then ( - md_code >>| fun t -> - set_char_before_pattern t; - t - ) else - fail "continue") + md_code >>| fun t -> + set_char_before_pattern t; + t + ) else + fail "continue") ; ( take_while1_include_backslash stop_chars (fun c -> not @@ List.mem c stop_chars) >>| fun s -> @@ -521,7 +518,8 @@ let entity = try let entity = Entity.find s in Entity entity - with Not_found -> Plain s + with + | Not_found -> Plain s (* FIXME: nested emphasis not working *) (* foo_bar, foo_{bar}, foo^bar, foo^{bar} *) @@ -544,7 +542,6 @@ let gen_script config s f = | Error _e -> f [ Plain s ] let subscript config = gen_script config "_" (fun x -> Subscript x) - let superscript config = gen_script config "^" (fun x -> Superscript x) (* @@ -580,7 +577,11 @@ let latex_fragment _config = take_while (fun x -> x <> '$' && x <> '\r' && x <> '\n') <* char '$' >>= fun s -> match last_char s with - | Some ' ' | Some '(' | Some '[' | Some '{' -> fail "inline math shouldn't end with a space, (, [, {" + | Some ' ' + | Some '(' + | Some '[' + | Some '{' -> + fail "inline math shouldn't end with a space, (, [, {" | _ -> return @@ Latex_Fragment (Inline (String.make 1 c ^ s))) | '\\' -> ( any_char >>= function @@ -612,7 +613,8 @@ let link_inline = <$> choice [ char '/'; char '?'; char '#' ] <*> string_contains_balanced_brackets ~excluded_ending_chars:[ ','; ';'; '.'; '!'; '?' ] - [ ('(', ')'); ('[', ']') ] (space_chars @ eol_chars) + [ ('(', ')'); ('[', ']') ] + (space_chars @ eol_chars) <|> return "" in unsafe_lookahead (take_while1 is_letter_or_digit *> string "://") @@ -663,7 +665,8 @@ let org_link_1 config = | None -> fail "not link" | Some '[' -> string_contains_balanced_brackets ~escape_chars:[ '['; ']' ] - [ ('[', ']') ] [] + [ ('[', ']') ] + [] | Some ']' -> peek_string 2 >>= fun s -> if s = "]]" then @@ -697,7 +700,8 @@ let org_link_1 config = link in Complex { protocol; link = link' }) - with _ -> Search url_text + with + | _ -> Search url_text in let parser = many1 @@ -743,7 +747,8 @@ let org_link_2 = try Scanf.sscanf s "%[^:]://%[^\n]" (fun protocol link -> Complex { protocol; link }) - with _ -> Page_ref s + with + | _ -> Page_ref s in let full_text = Printf.sprintf "[[%s]]" s in let label = @@ -757,7 +762,8 @@ let org_link config = org_link_1 config <|> org_link_2 (* helper for markdown_link and markdown_image *) let link_url_part = - string_contains_balanced_brackets ~escape_chars:[ '('; ')' ] [ ('(', ')') ] + string_contains_balanced_brackets ~escape_chars:[ '('; ')' ] + [ ('(', ')') ] eol_chars >>= fun s -> let len = String.length s in @@ -783,7 +789,8 @@ let label_part_choices = | Some '[' -> page_ref <|> string_contains_balanced_brackets ~escape_chars:[ '['; ']' ] - [ ('[', ']') ] [] + [ ('[', ']') ] + [] >>| fun s -> Plain s | Some ']' -> fail "not link" | Some c when is_eol c -> fail "finish" @@ -809,14 +816,12 @@ let label_part = let link_url_part_inner = let url_part = both (return `Block_ref_link) block_ref - <|> both - (return `Other_link1) + <|> both (return `Other_link1) (char '<' *> take_while1_include_backslash [ '<'; '>' ] (fun c -> not (List.mem c [ '<'; '>' ])) <* char '>') - <|> both - (return `Other_link2) + <|> both (return `Other_link2) (take_while1 (fun c -> non_space_eol c && c <> '[')) <|> both (return `Page_ref_link) page_ref <|> ( peek_char >>= fun c -> @@ -884,7 +889,8 @@ let markdown_link config = link in Complex { protocol; link = link' }) - with _ -> + with + | _ -> if String.length url > 3 && (ends_with lowercased_url ".md" @@ -903,9 +909,8 @@ let markdown_link config = ; entity ; code config ; subscript config - ; superscript config - (* ; plain config - * ; whitespaces *) + ; superscript config (* ; plain config + * ; whitespaces *) ]) in let label = @@ -1000,11 +1005,13 @@ let statistics_cookie = try let cookie = Scanf.sscanf s "%d/%d" (fun n n' -> Absolute (n, n')) in return (Cookie cookie) - with _ -> ( + with + | _ -> ( try let cookie = Scanf.sscanf s "%d%%" (fun n -> Percent n) in return (Cookie cookie) - with _ -> fail "statistics_cookie") + with + | _ -> fail "statistics_cookie") (* Define: #+MACRO: demo =$1= ($1) @@ -1035,22 +1042,22 @@ let macro config = else let p = take_while1 (function - | '}' - | '\r' - | '\n' -> - false - | _ -> true) + | '}' + | '\r' + | '\n' -> + false + | _ -> true) >>= fun s -> match parse_string ~consume:Prefix macro_name s with | Ok name -> ( - let l = String.length s in - let args = String.sub s (String.length name) (l - String.length name) in - if String.length args == 0 then - return (Macro { name; arguments = [] }) - else - match parse_string (macro_args config) ~consume:All args with - | Ok arguments -> return (Macro { name; arguments }) - | Error e -> fail e) + let l = String.length s in + let args = String.sub s (String.length name) (l - String.length name) in + if String.length args == 0 then + return (Macro { name; arguments = [] }) + else + match parse_string (macro_args config) ~consume:All args with + | Ok arguments -> return (Macro { name; arguments }) + | Error e -> fail e) | Error _e -> fail "macro name" in between_string "{{{" "}}}" p <|> between_string "{{" "}}" p @@ -1368,7 +1375,6 @@ let hash_tag_value_string tag = | _ -> failwith "unreachable" let inline_hiccup = Hiccup.parse >>| fun s -> Inline_Hiccup s - let inline_html = Raw_html.parse >>| fun s -> Inline_Html s (* TODO: configurable, re-order *) diff --git a/lib/syntax/lists0.ml b/lib/syntax/lists0.ml index 4c40b75f..20062021 100644 --- a/lib/syntax/lists0.ml +++ b/lib/syntax/lists0.ml @@ -17,8 +17,8 @@ struct let check_listitem config line = let indent = get_indent line in let number = - try Scanf.sscanf (String.trim line) "%d" (fun x -> Some x) - with _ -> None + try Scanf.sscanf (String.trim line) "%d" (fun x -> Some x) with + | _ -> None in match number with | Some number -> (indent, true, false, Some number) @@ -145,7 +145,8 @@ struct else match parse_string ~consume:All (Inline.parse config) name with | Ok inlines -> inlines - | Error _e -> Type_op.inline_list_with_none_pos [ Inline.Plain name ] + | Error _e -> + Type_op.inline_list_with_none_pos [ Inline.Plain name ] in (name, description) | None -> ([], description)) diff --git a/lib/syntax/md_outline.ml b/lib/syntax/md_outline.ml index 9c226a1b..1169e221 100644 --- a/lib/syntax/md_outline.ml +++ b/lib/syntax/md_outline.ml @@ -8,7 +8,6 @@ open Type open Conf let dummy = Pos.dummy_pos - let with_pos t = (t, dummy) let markers = @@ -109,13 +108,13 @@ let is_list_item_prefix line = let c = line.[ind] in if (c = '+' || c = '*') && is_space_char line.[ind + 1] then true - else if c >= '0' && c <= '9' then + else if c >= '0' && c <= '9' then ( let j = ref (ind + 1) in while !j < n && line.[!j] >= '0' && line.[!j] <= '9' do incr j done; !j < n && line.[!j] = '.' && !j + 1 < n && is_space_char line.[!j + 1] - else + ) else false else false @@ -213,8 +212,7 @@ let parse_marker_priority_title config s i = | '`' | '>' -> ([], false) - | _ -> - (outline_inlines config title, true) + | _ -> (outline_inlines config title, true) in (marker, priority, title_inlines, keep_title, title) @@ -392,7 +390,8 @@ let try_footnote_line config line = Some (Footnote_Definition (name, inlines)) else None - with Not_found -> None + with + | Not_found -> None else None @@ -434,9 +433,7 @@ let is_block_boundary config line = is_blank_line line || try_dash_heading config line <> None || try_atx_heading config line <> None - || is_fence_line line - || is_quote_line line - || is_list_item_prefix line + || is_fence_line line || is_quote_line line || is_list_item_prefix line || is_properties_start line || try_md_property config line <> None || try_org_style_prop line <> None @@ -536,7 +533,8 @@ let rec parse_list_items config lines i min_indent = if is_blank_line line then incr j else if - try_dash_heading config line <> None || try_atx_heading config line <> None + try_dash_heading config line <> None + || try_atx_heading config line <> None then continue := false else if is_list_item_prefix line then @@ -558,7 +556,8 @@ let rec parse_list_items config lines i min_indent = j := j'; items := make_list_item config ~indent ~ordered ~number content children - :: !items) + :: !items + ) else continue := false done; @@ -579,8 +578,7 @@ let parse config input = | Some (h, opens_fence) -> acc := with_pos h :: !acc; incr i; - if opens_fence then - i := skip_fence_body lines !i + if opens_fence then i := skip_fence_body lines !i | None -> ( match try_atx_heading config line with | Some h -> @@ -598,23 +596,23 @@ let parse config input = i := j | None -> ( match collect_properties config lines !i with - | _ :: _ as kvs, j -> + | (_ :: _ as kvs), j -> acc := with_pos (Property_Drawer kvs) :: !acc; i := j | [], _ -> if is_fence_line line then i := skip_fence lines !i - else if is_quote_line line then + else if is_quote_line line then ( let q, j = collect_quote config lines !i in acc := with_pos q :: !acc; i := j - else if is_list_item_prefix line then + ) else if is_list_item_prefix line then ( let items, j = parse_list_items config lines !i (indent_len line) in acc := with_pos (List items) :: !acc; i := j - else + ) else let p, j = collect_paragraph_lines config lines !i in acc := with_pos p :: !acc; i := j)))) diff --git a/lib/syntax/outline_inline.ml b/lib/syntax/outline_inline.ml index a462571b..6a867928 100644 --- a/lib/syntax/outline_inline.ml +++ b/lib/syntax/outline_inline.ml @@ -3,7 +3,12 @@ open Angstrom open Parsers (** Outline mode only extracts node refs and tags (properties are block-level). *) -let is_outline_special = function '#' | '[' | '(' -> true | _ -> false +let is_outline_special = function + | '#' + | '[' + | '(' -> + true + | _ -> false let may_have_outline_markup _config s = let n = String.length s in @@ -31,8 +36,9 @@ let inline_choices config : Inline.t_with_pos option Angstrom.t = peek_char_fail >>= function | c when is_whitespace c -> any_char *> return None | _ -> - (interesting config >>| fun t -> Some (t, None)) - <|> (any_char *> skip_plain_run *> return None) + interesting config + >>| (fun t -> Some (t, None)) + <|> any_char *> skip_plain_run *> return None let parse_angstrom config = many1 (inline_choices config) @@ -41,10 +47,25 @@ let parse_angstrom config = Inline.concat_plains l) "outline inline" -let is_ws = function ' ' | '\t' | '\n' | '\r' -> true | _ -> false +let is_ws = function + | ' ' + | '\t' + | '\n' + | '\r' -> + true + | _ -> false let tag_trail = function - | ',' | ';' | '.' | '!' | '?' | '\'' | '"' | ':' | '#' -> true + | ',' + | ';' + | '.' + | '!' + | '?' + | '\'' + | '"' + | ':' + | '#' -> + true | _ -> false let find_page_ref_end s i = @@ -125,21 +146,19 @@ let try_fast_scan s = let complex = ref false in while !i < n && not !complex do match s.[!i] with - | '#' when !i + 1 < n && not (is_ws s.[!i + 1]) && s.[!i + 1] <> '#' -> + | '#' when !i + 1 < n && (not (is_ws s.[!i + 1])) && s.[!i + 1] <> '#' -> let start = !i + 1 in let j = ref start in let has_bracket = ref false in while !j < n && not (is_ws s.[!j]) do - if s.[!j] = '[' then - has_bracket := true; + if s.[!j] = '[' then has_bracket := true; incr j done; if !has_bracket then complex := true else let name = strip_tag_trail (String.sub s start (!j - start)) in - if name <> "" then - acc := Inline.Tag [ Inline.Plain name ] :: !acc; + if name <> "" then acc := Inline.Tag [ Inline.Plain name ] :: !acc; i := !j | '[' when !i + 1 < n && s.[!i + 1] = '[' -> ( match find_page_ref_end s !i with From 82b5962d79c75c5328c1fe17529cca025d16e7a9 Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Sat, 29 Aug 2026 09:55:22 +0000 Subject: [PATCH 4/8] perf: MD inline fast path for full parse; note on Parseff Tried Parseff (OCaml 5.3 effects) for MD Inline: ~4x slower than Angstrom on short Logseq titles (effects/look_ahead overhead), so not adopted. Instead add a pure-OCaml MD Inline fast path (plain/#tag/[[page]]/ ((block))) with Angstrom fallback. Full parse ~0.19s vs ~0.43s master (~2.3x) on the 1.2MB fixture; outline stays ~15x. Co-authored-by: Tienson Qin --- lib/dune | 4 +- lib/syntax/inline.ml | 201 ++++++++++++++++++++++++++++++++++- lib/syntax/md_outline.ml | 1 - lib/syntax/outline_inline.ml | 39 ++++--- test/gen_md_files.ml | 13 +-- 5 files changed, 233 insertions(+), 25 deletions(-) diff --git a/lib/dune b/lib/dune index e1b962fb..e0f76659 100644 --- a/lib/dune +++ b/lib/dune @@ -1,9 +1,9 @@ (include_subdirs unqualified) -(env + (env (dev (flags - (:standard -warn-error -A)))) + (:standard -warn-error -A -alert -deprecated)))) (library (name mldoc) diff --git a/lib/syntax/inline.ml b/lib/syntax/inline.ml index f83e252b..2dc9cba7 100644 --- a/lib/syntax/inline.ml +++ b/lib/syntax/inline.ml @@ -1459,12 +1459,211 @@ let inline_choices state config : t_with_pos Angstrom.t = else (fun t -> (t, None)) <$> p' -let parse config = +let parse_angstrom config = let state = { last_plain_char = None } in many1 (inline_choices state config) >>| (fun l -> concat_plains l) "inline" +(** Pure-OCaml MD fast path: plain + #tag + [[page]] + ((block)) + Break_Line. + No Parseff/effects — faster than Angstrom on Logseq-style titles. + Returns None when emphasis, markdown links, urls, nested refs, etc. appear. *) +let try_fast_md_inline s = + let n = String.length s in + if n = 0 then + None + else + let rec gate i = + if i >= n then + true + else + match s.[i] with + | '*' + | '_' + | '`' + | '~' + | '=' + | '$' + | '\\' + | '!' + | '<' + | '{' + | '@' + | '^' -> + false + | ':' when i + 1 < n && s.[i + 1] = '/' -> false + | _ -> gate (i + 1) + in + if not (gate 0) then + None + else + let is_ws = function + | ' ' + | '\t' -> + true + | _ -> false + in + let tag_trail = function + | ',' + | ';' + | '.' + | '!' + | '?' + | '\'' + | '"' + | ':' + | '#' -> + true + | _ -> false + in + let acc = ref [] in + let i = ref 0 in + let plain_start = ref 0 in + let complex = ref false in + let flush_plain stop = + if stop > !plain_start then + acc := Plain (String.sub s !plain_start (stop - !plain_start)) :: !acc + in + let page_ref_end i0 = + if i0 + 1 >= n || s.[i0] <> '[' || s.[i0 + 1] <> '[' then + None + else + let rec loop j depth = + if j + 1 >= n then + None + else if s.[j] = '[' && s.[j + 1] = '[' then + loop (j + 2) (depth + 1) + else if s.[j] = ']' && s.[j + 1] = ']' then + if depth = 1 then + Some (j + 2) + else + loop (j + 2) (depth - 1) + else + loop (j + 1) depth + in + loop (i0 + 2) 1 + in + let block_ref_end i0 = + if i0 + 1 >= n || s.[i0] <> '(' || s.[i0 + 1] <> '(' then + None + else + let rec loop j = + if j + 1 >= n then + None + else if s.[j] = ')' && s.[j + 1] = ')' then + Some (j + 2) + else + loop (j + 1) + in + loop (i0 + 2) + in + while !i < n && not !complex do + match s.[!i] with + | '\n' -> + flush_plain !i; + acc := Break_Line :: !acc; + incr i; + plain_start := !i + | '\r' -> + flush_plain !i; + incr i; + if !i < n && s.[!i] = '\n' then incr i; + acc := Break_Line :: !acc; + plain_start := !i + | '#' when !i + 1 < n && (not (is_ws s.[!i + 1])) && s.[!i + 1] <> '#' + -> + flush_plain !i; + let start = !i + 1 in + let j = ref start in + let has_bracket = ref false in + while !j < n && (not (is_ws s.[!j])) && s.[!j] <> '\n' do + if s.[!j] = '[' then has_bracket := true; + incr j + done; + if !has_bracket then + complex := true + else + let raw = String.sub s start (!j - start) in + let rec name_len k = + if k > 0 && tag_trail raw.[k - 1] then + name_len (k - 1) + else + k + in + let nl = name_len (String.length raw) in + if nl = 0 then + complex := true + else ( + acc := Tag [ Plain (String.sub raw 0 nl) ] :: !acc; + if nl < String.length raw then + acc := + Plain (String.sub raw nl (String.length raw - nl)) :: !acc; + i := !j; + plain_start := !j + ) + | '[' when !i + 1 < n && s.[!i + 1] = '[' -> ( + match page_ref_end !i with + | Some e -> + let name = String.sub s (!i + 2) (e - !i - 4) in + if String.contains name '[' then + complex := true + else ( + flush_plain !i; + acc := + Link + { url = Page_ref name + ; label = [ Plain "" ] + ; title = None + ; full_text = "[[" ^ name ^ "]]" + ; metadata = "" + } + :: !acc; + i := e; + plain_start := e + ) + | None -> complex := true) + | '[' -> complex := true + | '(' when !i + 1 < n && s.[!i + 1] = '(' -> ( + match block_ref_end !i with + | Some e -> + flush_plain !i; + let id = String.sub s (!i + 2) (e - !i - 4) in + acc := + Link + { url = Block_ref id + ; label = [ Plain "" ] + ; title = None + ; full_text = "((" ^ id ^ "))" + ; metadata = "" + } + :: !acc; + i := e; + plain_start := e + | None -> incr i) + | _ -> incr i + done; + if !complex then + None + else ( + flush_plain n; + match !acc with + | [] -> None + | _ -> + Some (concat_plains (List.map (fun t -> (t, None)) (List.rev !acc))) + ) + +let parse config = + if Conf.is_markdown config then + take_while (fun _ -> true) >>= fun s -> + match try_fast_md_inline s with + | Some result -> return result + | None -> ( + match parse_string ~consume:All (parse_angstrom config) s with + | Result.Ok result -> return result + | Result.Error e -> fail e) + else + parse_angstrom config + let is_embed_data = function | Embed_data _ -> true | _ -> false diff --git a/lib/syntax/md_outline.ml b/lib/syntax/md_outline.ml index 1169e221..65e1473b 100644 --- a/lib/syntax/md_outline.ml +++ b/lib/syntax/md_outline.ml @@ -5,7 +5,6 @@ open! Prelude open Type -open Conf let dummy = Pos.dummy_pos let with_pos t = (t, dummy) diff --git a/lib/syntax/outline_inline.ml b/lib/syntax/outline_inline.ml index 6a867928..cd130d27 100644 --- a/lib/syntax/outline_inline.ml +++ b/lib/syntax/outline_inline.ml @@ -134,23 +134,29 @@ let strip_tag_trail raw = strip raw (** Fast path for #tag / [[page]] / ((block)). Returns None when markdown - links or nested-page hashtags need the angstrom parser. *) -let try_fast_scan s = - (* Escapes / backslashes need the real parser. *) - if String.contains s '\\' then + links or nested-page hashtags need the angstrom parser. + Scans [s] from [off] with length [len] (no need to sub the whole title). *) +let try_fast_scan_range s off len = + if len < 0 || off < 0 || off + len > String.length s then + None + else if + let rec has_bs i = i < off + len && (s.[i] = '\\' || has_bs (i + 1)) in + has_bs off + then None else - let n = String.length s in + let end_ = off + len in let acc = ref [] in - let i = ref 0 in + let i = ref off in let complex = ref false in - while !i < n && not !complex do + while !i < end_ && not !complex do match s.[!i] with - | '#' when !i + 1 < n && (not (is_ws s.[!i + 1])) && s.[!i + 1] <> '#' -> + | '#' when !i + 1 < end_ && (not (is_ws s.[!i + 1])) && s.[!i + 1] <> '#' + -> let start = !i + 1 in let j = ref start in let has_bracket = ref false in - while !j < n && not (is_ws s.[!j]) do + while !j < end_ && not (is_ws s.[!j]) do if s.[!j] = '[' then has_bracket := true; incr j done; @@ -160,21 +166,22 @@ let try_fast_scan s = let name = strip_tag_trail (String.sub s start (!j - start)) in if name <> "" then acc := Inline.Tag [ Inline.Plain name ] :: !acc; i := !j - | '[' when !i + 1 < n && s.[!i + 1] = '[' -> ( + | '[' when !i + 1 < end_ && s.[!i + 1] = '[' -> ( + (* find_page_ref_end walks to string end; clamp by checking within range *) match find_page_ref_end s !i with - | Some e -> + | Some e when e <= end_ -> let name = String.sub s (!i + 2) (e - !i - 4) in acc := page_ref_link name :: !acc; i := e - | None -> complex := true) + | _ -> complex := true) | '[' -> complex := true - | '(' when !i + 1 < n && s.[!i + 1] = '(' -> ( + | '(' when !i + 1 < end_ && s.[!i + 1] = '(' -> ( match find_block_ref_end s !i with - | Some e -> + | Some e when e <= end_ -> let id = String.sub s (!i + 2) (e - !i - 4) in acc := block_ref_link id :: !acc; i := e - | None -> incr i) + | _ -> incr i) | _ -> incr i done; if !complex then @@ -182,6 +189,8 @@ let try_fast_scan s = else Some (Type_op.inline_list_with_none_pos (List.rev !acc)) +let try_fast_scan s = try_fast_scan_range s 0 (String.length s) + let parse config = take_while (fun _ -> true) >>= fun s -> match try_fast_scan s with diff --git a/test/gen_md_files.ml b/test/gen_md_files.ml index 9c5fdf8d..2debc98e 100644 --- a/test/gen_md_files.ml +++ b/test/gen_md_files.ml @@ -4,7 +4,7 @@ open Mldoc type state = { mutable last_level : int } let page_ref_g (pagenames : string list) = - oneofl pagenames >|= fun pagename -> + oneof_list pagenames >|= fun pagename -> Inline.Link { url = Inline.Search pagename ; label = [ Inline.Plain "" ] @@ -30,8 +30,8 @@ let page_names n = let+ pagename_l = list_size (1 -- 10) @@ oneof_weighted - [ (1, string_size ~gen:(oneofl char_table) (0 -- 5)) - ; (1, oneofl unicode_table) + [ (1, string_size ~gen:(oneof_list char_table) (0 -- 5)) + ; (1, oneof_list unicode_table) ] in String.(concat "" pagename_l ^ string_of_int i) @@ -62,7 +62,7 @@ let heading ?(init = false) pagenames state = ] in let level_g = - oneofl + oneof_list (if init then [ 1 ] else @@ -74,7 +74,7 @@ let heading ?(init = false) pagenames state = state.last_level <- level; return @@ Type.Heading - { title = inlines + { title = Type_op.inline_list_with_none_pos inlines ; tags = [] ; marker ; level @@ -86,7 +86,8 @@ let heading ?(init = false) pagenames state = } let paragragh pagenames = - inlines_g pagenames >|= fun inlines -> Type.Paragraph inlines + inlines_g pagenames >|= fun inlines -> + Type.Paragraph (Type_op.inline_list_with_none_pos inlines) let blocks_g pagenames : Type.blocks t = let state = { last_level = 1 } in From 647ed822bb7b29fa1189612f051a4ec586f8d13f Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Sat, 29 Aug 2026 10:08:39 +0000 Subject: [PATCH 5/8] perf: line-oriented Markdown full parse via Md_outline MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Route all Markdown (outline and full) through the line scanner. Full mode uses Inline.parse, Src fences with options/pos_meta, latex env, quote continuation, and heading anchors — ~7–9× vs master on logseq_large while keeping outline_only ~15×. Co-authored-by: Tienson Qin --- lib/mldoc_parser.ml | 19 +-- lib/syntax/md_outline.ml | 361 +++++++++++++++++++++++++++++++++++---- 2 files changed, 333 insertions(+), 47 deletions(-) diff --git a/lib/mldoc_parser.ml b/lib/mldoc_parser.ml index cb3bb545..269089a0 100644 --- a/lib/mldoc_parser.ml +++ b/lib/mldoc_parser.ml @@ -146,20 +146,18 @@ let build_md_outline_parsers config = let parse config input = let outline_only = Conf.(config.parse_outline_only) in let md = Conf.is_markdown config in - (* Markdown outline: line-oriented fast path (no Angstrom block choice). *) - if md && outline_only then + (* Markdown: line-oriented path for outline and full. *) + if md then let ast = Md_outline.parse config input in - if String.contains input '\\' then + if (not outline_only) || String.contains input '\\' then List.map (fun (t, pos) -> (Type_op.md_unescaped t, pos)) ast else ast else let parsers = - match (md, outline_only) with - | true, false -> build_choice_parsers md_full_parsers config - | false, true -> build_choice_parsers org_outline_parsers config - | false, false -> build_choice_parsers org_full_parsers config - | true, true -> assert false + match outline_only with + | true -> build_choice_parsers org_outline_parsers config + | false -> build_choice_parsers org_full_parsers config in match parse_string ~consume:All parsers input with | Ok result -> @@ -184,10 +182,7 @@ let parse config input = else ast in - if Conf.is_markdown config then - List.map (fun (t, pos) -> (Type_op.md_unescaped t, pos)) ast - else - ast + ast | Error err -> failwith err let load_file f = diff --git a/lib/syntax/md_outline.ml b/lib/syntax/md_outline.ml index 65e1473b..96ebab36 100644 --- a/lib/syntax/md_outline.ml +++ b/lib/syntax/md_outline.ml @@ -1,14 +1,36 @@ -(* Fast Markdown outline_only document parser. +(* Fast Markdown document parser (outline_only + full). Line-oriented; avoids Angstrom choice/backtracking on the Logseq hot path. - Extracts headings, properties, lists, quotes, footnotes, and outline inline - (tags / page refs / block refs / markdown links). *) + Outline: headings, properties, lists, quotes, footnotes, outline inline. + Full: same structure with Inline.parse, Src fences, latex env, anchors. *) open! Prelude open Type +open Conf let dummy = Pos.dummy_pos let with_pos t = (t, dummy) +let ensure_trailing_nl s = + let n = String.length s in + if n = 0 || s.[n - 1] = '\n' then + s + else + s ^ "\n" + +let separate_name_options = function + | None + | Some "" -> + (None, None) + | Some s -> ( + match String.split_on_char ' ' (String.trim s) with + | [] -> (None, None) + | [ name ] -> (Some name, None) + | name :: options -> (Some name, Some options)) + +let anchor_of_title title = + Type_parser.Heading.anchor_link + (Inline.asciis (Type_op.inline_list_strip_pos title)) + let markers = [| "IN-PROGRESS" ; "CANCELLED" @@ -133,7 +155,31 @@ let outline_inlines config s = else [] -let outline_paragraph config s = Paragraph (outline_inlines config s) +let full_inlines config s = + if s = "" then + [] + else + match Angstrom.parse_string ~consume:All (Inline.parse config) s with + | Ok r -> r + | Error _ -> [] + +let content_inlines config s = + if config.parse_outline_only then + outline_inlines config s + else + full_inlines config s + +let content_paragraph config s = Paragraph (content_inlines config s) + +(** Quotes: Angstrom records eol after each line → trailing Break_Line. *) +let quote_paragraph config s = + let s = + if config.parse_outline_only then + s + else + ensure_trailing_nl s + in + Paragraph (content_inlines config s) let filter_prop_refs inlines = List.map fst inlines @@ -144,14 +190,18 @@ let filter_prop_refs inlines = true | _ -> false) -let heading ~level ~unordered ~size ~marker ~priority ~title = +let heading ~outline_only ~level ~unordered ~size ~marker ~priority ~title = Heading { level ; marker ; priority ; title ; tags = [] - ; anchor = "" + ; anchor = + (if outline_only then + "" + else + anchor_of_title title) ; meta = { timestamps = []; properties = [] } ; numbering = None ; unordered @@ -208,10 +258,17 @@ let parse_marker_priority_title config s i = ([], true) else match title.[0] with - | '`' | '>' -> + (* Leave markdown quote for the following block (Angstrom parity). *) ([], false) - | _ -> (outline_inlines config title, true) + | '`' + | '~' + when String.length title >= 3 + && title.[1] = title.[0] + && title.[2] = title.[0] -> + (* Fenced code opener on the heading line. *) + ([], false) + | _ -> (content_inlines config title, true) in (marker, priority, title_inlines, keep_title, title) @@ -230,7 +287,13 @@ let parse_size_hashes s i = else (None, i) -(** [Some (heading, opens_fence)] *) +(** [Some (heading, rest)] where [rest] is a fence header or quote line left + on the same source line after the heading marker. *) +type heading_rest = + | Nothing + | Fence of string + | Quote_line of string + let try_dash_heading config line = let ind = indent_len line in let n = String.length line in @@ -239,9 +302,9 @@ let try_dash_heading config line = else if ind + 1 < n && not (is_space_char line.[ind + 1]) then if ind + 1 = n then Some - ( heading ~level:(ind + 1) ~unordered:true ~size:None ~marker:None - ~priority:None ~title:[] - , false ) + ( heading ~outline_only:config.parse_outline_only ~level:(ind + 1) + ~unordered:true ~size:None ~marker:None ~priority:None ~title:[] + , Nothing ) else None else @@ -250,12 +313,25 @@ let try_dash_heading config line = let marker, priority, title, keep_title, raw_title = parse_marker_priority_title config line i in - let opens_fence = - (not keep_title) && String.length raw_title > 0 && raw_title.[0] = '`' + let rest = + if keep_title || raw_title = "" then + Nothing + else if raw_title.[0] = '>' then + Quote_line raw_title + else if + (raw_title.[0] = '`' || raw_title.[0] = '~') + && String.length raw_title >= 3 + && raw_title.[1] = raw_title.[0] + && raw_title.[2] = raw_title.[0] + then + Fence raw_title + else + Nothing in Some - ( heading ~level:(ind + 1) ~unordered:true ~size ~marker ~priority ~title - , opens_fence ) + ( heading ~outline_only:config.parse_outline_only ~level:(ind + 1) + ~unordered:true ~size ~marker ~priority ~title + , rest ) let try_atx_heading config line = let ind = indent_len line in @@ -277,8 +353,8 @@ let try_atx_heading config line = parse_marker_priority_title config line !j in Some - (heading ~level:(ind + 1) ~unordered:false ~size:(Some size) ~marker - ~priority ~title) + (heading ~outline_only:config.parse_outline_only ~level:(ind + 1) + ~unordered:false ~size:(Some size) ~marker ~priority ~title) let try_md_property config line = let ind = indent_len line in @@ -308,7 +384,13 @@ let try_md_property config line = else String.trim (String.sub line rest_i (n - rest_i)) in - Some (key, value, filter_prop_refs (outline_inlines config value)) + Some + ( key + , value + , (if config.parse_outline_only then + filter_prop_refs (outline_inlines config value) + else + Property.property_references config value) ) else None @@ -359,7 +441,13 @@ let try_org_drawer_prop_line config line = else String.trim (String.sub line rest_i (n - rest_i)) in - Some (key, value, filter_prop_refs (outline_inlines config value)) + Some + ( key + , value + , (if config.parse_outline_only then + filter_prop_refs (outline_inlines config value) + else + Property.property_references config value) ) else None @@ -381,10 +469,13 @@ let try_footnote_line config line = let inlines = if body = "" then [] - else if Outline_inline.may_have_outline_markup config body then - outline_inlines config body + else if config.parse_outline_only then + if Outline_inline.may_have_outline_markup config body then + outline_inlines config body + else + Type_op.inline_list_with_none_pos [ Inline.Plain body ] else - Type_op.inline_list_with_none_pos [ Inline.Plain body ] + content_inlines config body in Some (Footnote_Definition (name, inlines)) else @@ -450,7 +541,15 @@ let collect_paragraph_lines config lines i = in let ls, j = loop i [] in let content = String.concat "\n" ls in - (outline_paragraph config content, j) + (* When another block follows, each line was newline-terminated in the + source — Angstrom records a final Break_Line. *) + let content = + if (not config.parse_outline_only) && j < n && content <> "" then + ensure_trailing_nl content + else + content + in + (content_paragraph config content, j) let skip_fence_body lines i = let rec loop j = @@ -465,7 +564,76 @@ let skip_fence_body lines i = let skip_fence lines i = skip_fence_body lines (i + 1) -let collect_quote config lines i = +(** Collect fenced Src given an opening fence header (e.g. "```ocaml") and + body lines starting at index [i]. [body_start_pos] / [body_end_pos] are + byte offsets in the original input (Angstrom pos_meta parity). *) +let collect_src_from_header ~body_start_pos ~body_end_pos lines i fence_header = + let rest = + if String.length fence_header >= 3 then + String.trim (String.sub fence_header 3 (String.length fence_header - 3)) + else + "" + in + let language, options = separate_name_options (Some rest) in + let rec loop j acc = + if j >= Array.length lines then + (List.rev acc, j) + else if is_fence_line lines.(j) then + (List.rev acc, j + 1) + else + loop (j + 1) ("\n" :: lines.(j) :: acc) + in + let body_lines, j = loop i [] in + ( Src + { lines = body_lines + ; language + ; options + ; pos_meta = { Pos.start_pos = body_start_pos; end_pos = body_end_pos } + } + , j ) + +let collect_src ~line_starts lines i = + let open_line = lines.(i) in + let ind = indent_len open_line in + let fence_header = + String.sub open_line ind (String.length open_line - ind) + in + let body_i = i + 1 in + let body_start_pos = + if body_i < Array.length lines then + line_starts.(body_i) + else + line_starts.(i) + String.length open_line + 1 + in + (* Find closing fence to compute end_pos = start of closing fence line. *) + let rec find_end j = + if j >= Array.length lines then + if Array.length lines = 0 then + body_start_pos + else + line_starts.(Array.length lines - 1) + + String.length lines.(Array.length lines - 1) + else if is_fence_line lines.(j) then + line_starts.(j) + else + find_end (j + 1) + in + let body_end_pos = find_end body_i in + collect_src_from_header ~body_start_pos ~body_end_pos lines body_i + fence_header + +let quote_continuation_stop config line = + (* Match Block.md_blockquote: stop only on new block markers. *) + let trimmed = String.trim line in + try_dash_heading config line <> None + || try_atx_heading config line <> None + || is_list_item_prefix line || is_fence_line line || is_properties_start line + || starts_with_at line 0 "- " + || starts_with_at line 0 "# " + || starts_with_at line 0 "id:: " + || trimmed = "-" || trimmed = "#" + +let collect_quote config ?first_line lines i = let rec loop j acc = if j >= Array.length lines then (List.rev acc, j) @@ -485,13 +653,71 @@ let collect_quote config lines i = String.sub line body_i (String.length line - body_i) in loop (j + 1) (body :: acc) + else if + (not config.parse_outline_only) + && not (quote_continuation_stop config lines.(j)) + then + (* Full MD: lines without '>' still belong to the quote. *) + loop (j + 1) (lines.(j) :: acc) else (List.rev acc, j) in - let bodies, j = loop i [] in + let start_acc, start_j = + match first_line with + | None -> ([], i) + | Some line -> + let ind = indent_len line in + let body_i = + if ind < String.length line && line.[ind] = '>' then + skip_spaces line (ind + 1) + else + ind + in + let body = + if body_i >= String.length line then + "" + else + String.sub line body_i (String.length line - body_i) + in + ([ body ], i) + in + let bodies, j = loop start_j start_acc in (* Match Angstrom quote + concat_paragraph_lines: one merged paragraph. *) let content = String.concat "\n" bodies in - (Quote [ outline_paragraph config content ], j) + (Quote [ quote_paragraph config content ], j) + +let try_latex_environment line = + let s = String.trim line in + let n = String.length s in + if n < 8 || not (starts_with_at s 0 "\\begin{") then + None + else + let name_start = 7 in + match String.index_from_opt s name_start '}' with + | None -> None + | Some name_end -> + let name = String.sub s name_start (name_end - name_start) in + let ending = "\\end{" ^ name ^ "}" in + let ending_l = String.lowercase_ascii ending in + let rec find_end i = + if i + String.length ending > n then + None + else if + String.lowercase_ascii (String.sub s i (String.length ending)) + = ending_l + then + Some i + else + find_end (i + 1) + in + (match find_end (name_end + 1) with + | None -> None + | Some end_i -> + let content = + String.sub s (name_end + 1) (end_i - name_end - 1) + in + Some + (Latex_Environment (String.lowercase_ascii name, None, content))) let parse_list_item_line line = let ind = indent_len line in @@ -514,7 +740,7 @@ let make_list_item config ~indent ~ordered ~number content children = (if content = "" then [] else - [ outline_paragraph config content ]) + [ content_paragraph config content ]) ; items = children ; number ; name = [] @@ -566,6 +792,30 @@ let parse config input = let raw_lines = String.split_on_char '\n' input in let lines = Array.of_list (List.map rstrip_cr raw_lines) in let n = Array.length lines in + let line_starts = + let arr = Array.make (max n 1) 0 in + let pos = ref 0 in + for idx = 0 to n - 1 do + arr.(idx) <- !pos; + let nl = if idx + 1 < n then 1 else 0 in + pos := !pos + String.length lines.(idx) + nl + done; + arr + in + let src_end_pos body_i = + let rec find j = + if j >= n then + if n = 0 then + 0 + else + line_starts.(n - 1) + String.length lines.(n - 1) + else if is_fence_line lines.(j) then + line_starts.(j) + else + find (j + 1) + in + find body_i + in let acc = ref [] in let i = ref 0 in while !i < n do @@ -574,10 +824,36 @@ let parse config input = incr i else match try_dash_heading config line with - | Some (h, opens_fence) -> + | Some (h, rest) -> acc := with_pos h :: !acc; incr i; - if opens_fence then i := skip_fence_body lines !i + (match rest with + | Nothing -> () + | Fence hdr -> + if config.parse_outline_only then + i := skip_fence_body lines !i + else + let body_i = !i in + let body_start_pos = + if body_i < n then + line_starts.(body_i) + else + line_starts.(!i - 1) + String.length lines.(!i - 1) + 1 + in + let body_end_pos = src_end_pos body_i in + let src, j = + collect_src_from_header ~body_start_pos ~body_end_pos lines body_i + hdr + in + acc := with_pos src :: !acc; + i := j + | Quote_line qline -> + if config.parse_outline_only then + () + else + let q, j = collect_quote config ~first_line:qline lines !i in + acc := with_pos q :: !acc; + i := j) | None -> ( match try_atx_heading config line with | Some h -> @@ -600,7 +876,12 @@ let parse config input = i := j | [], _ -> if is_fence_line line then - i := skip_fence lines !i + if config.parse_outline_only then + i := skip_fence lines !i + else + let src, j = collect_src ~line_starts lines !i in + acc := with_pos src :: !acc; + i := j else if is_quote_line line then ( let q, j = collect_quote config lines !i in acc := with_pos q :: !acc; @@ -611,9 +892,19 @@ let parse config input = in acc := with_pos (List items) :: !acc; i := j - ) else - let p, j = collect_paragraph_lines config lines !i in - acc := with_pos p :: !acc; - i := j)))) + ) else ( + match + if config.parse_outline_only then + None + else + try_latex_environment line + with + | Some latex -> + acc := with_pos latex :: !acc; + incr i + | None -> + let p, j = collect_paragraph_lines config lines !i in + acc := with_pos p :: !acc; + i := j))))) done; List.rev !acc From 57bf08519fa2bfcc6f2164a4460508d865d4dfda Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Sat, 29 Aug 2026 10:10:31 +0000 Subject: [PATCH 6/8] fix: add missing Heading.size in gen_md_files The generative MD fixture builder omitted the size field after it was added to Type.Heading, which broke dune builds of that test helper. Co-authored-by: Tienson Qin --- test/gen_md_files.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/test/gen_md_files.ml b/test/gen_md_files.ml index 2debc98e..11761f13 100644 --- a/test/gen_md_files.ml +++ b/test/gen_md_files.ml @@ -83,6 +83,7 @@ let heading ?(init = false) pagenames state = ; anchor = "" ; meta = { timestamps = []; properties = [] } ; unordered = true + ; size = None } let paragragh pagenames = From 76d15860881314a73a3a1ba7c53ea220fe3a646a Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Sat, 29 Aug 2026 10:32:15 +0000 Subject: [PATCH 7/8] style: ocamlformat md_outline for Format CI Co-authored-by: Tienson Qin --- lib/syntax/md_outline.ml | 57 ++++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 29 deletions(-) diff --git a/lib/syntax/md_outline.ml b/lib/syntax/md_outline.ml index 96ebab36..738cd942 100644 --- a/lib/syntax/md_outline.ml +++ b/lib/syntax/md_outline.ml @@ -387,10 +387,10 @@ let try_md_property config line = Some ( key , value - , (if config.parse_outline_only then - filter_prop_refs (outline_inlines config value) - else - Property.property_references config value) ) + , if config.parse_outline_only then + filter_prop_refs (outline_inlines config value) + else + Property.property_references config value ) else None @@ -442,12 +442,12 @@ let try_org_drawer_prop_line config line = String.trim (String.sub line rest_i (n - rest_i)) in Some - ( key - , value - , (if config.parse_outline_only then - filter_prop_refs (outline_inlines config value) - else - Property.property_references config value) ) + ( key + , value + , if config.parse_outline_only then + filter_prop_refs (outline_inlines config value) + else + Property.property_references config value ) else None @@ -595,9 +595,7 @@ let collect_src_from_header ~body_start_pos ~body_end_pos lines i fence_header = let collect_src ~line_starts lines i = let open_line = lines.(i) in let ind = indent_len open_line in - let fence_header = - String.sub open_line ind (String.length open_line - ind) - in + let fence_header = String.sub open_line ind (String.length open_line - ind) in let body_i = i + 1 in let body_start_pos = if body_i < Array.length lines then @@ -628,8 +626,7 @@ let quote_continuation_stop config line = try_dash_heading config line <> None || try_atx_heading config line <> None || is_list_item_prefix line || is_fence_line line || is_properties_start line - || starts_with_at line 0 "- " - || starts_with_at line 0 "# " + || starts_with_at line 0 "- " || starts_with_at line 0 "# " || starts_with_at line 0 "id:: " || trimmed = "-" || trimmed = "#" @@ -695,7 +692,7 @@ let try_latex_environment line = let name_start = 7 in match String.index_from_opt s name_start '}' with | None -> None - | Some name_end -> + | Some name_end -> ( let name = String.sub s name_start (name_end - name_start) in let ending = "\\end{" ^ name ^ "}" in let ending_l = String.lowercase_ascii ending in @@ -710,14 +707,11 @@ let try_latex_environment line = else find_end (i + 1) in - (match find_end (name_end + 1) with + match find_end (name_end + 1) with | None -> None | Some end_i -> - let content = - String.sub s (name_end + 1) (end_i - name_end - 1) - in - Some - (Latex_Environment (String.lowercase_ascii name, None, content))) + let content = String.sub s (name_end + 1) (end_i - name_end - 1) in + Some (Latex_Environment (String.lowercase_ascii name, None, content))) let parse_list_item_line line = let ind = indent_len line in @@ -797,7 +791,12 @@ let parse config input = let pos = ref 0 in for idx = 0 to n - 1 do arr.(idx) <- !pos; - let nl = if idx + 1 < n then 1 else 0 in + let nl = + if idx + 1 < n then + 1 + else + 0 + in pos := !pos + String.length lines.(idx) + nl done; arr @@ -824,10 +823,10 @@ let parse config input = incr i else match try_dash_heading config line with - | Some (h, rest) -> + | Some (h, rest) -> ( acc := with_pos h :: !acc; incr i; - (match rest with + match rest with | Nothing -> () | Fence hdr -> if config.parse_outline_only then @@ -874,15 +873,15 @@ let parse config input = | (_ :: _ as kvs), j -> acc := with_pos (Property_Drawer kvs) :: !acc; i := j - | [], _ -> - if is_fence_line line then + | [], _ -> ( + if is_fence_line line then ( if config.parse_outline_only then i := skip_fence lines !i else let src, j = collect_src ~line_starts lines !i in acc := with_pos src :: !acc; i := j - else if is_quote_line line then ( + ) else if is_quote_line line then ( let q, j = collect_quote config lines !i in acc := with_pos q :: !acc; i := j @@ -892,7 +891,7 @@ let parse config input = in acc := with_pos (List items) :: !acc; i := j - ) else ( + ) else match if config.parse_outline_only then None From a7d677c84ae279d374e6eb9b912e551847da76e0 Mon Sep 17 00:00:00 2001 From: Cursor Agent Date: Sun, 30 Aug 2026 00:34:40 +0000 Subject: [PATCH 8/8] fix: handle nested page refs in outline parse Outline fast scan falls back to Angstrom Nested_link for [[a [[b]]]]. Property values use Property.property_references in both modes so nested refs (and quoted values) match full parse. Add outline drawer tests. Co-authored-by: Tienson Qin --- lib/syntax/md_outline.ml | 25 ++------------------ lib/syntax/outline_inline.ml | 9 ++++++-- test/test_outline_markdown.ml | 43 +++++++++++++++++++++++++++++++++++ 3 files changed, 52 insertions(+), 25 deletions(-) diff --git a/lib/syntax/md_outline.ml b/lib/syntax/md_outline.ml index 738cd942..abbdba08 100644 --- a/lib/syntax/md_outline.ml +++ b/lib/syntax/md_outline.ml @@ -181,15 +181,6 @@ let quote_paragraph config s = in Paragraph (content_inlines config s) -let filter_prop_refs inlines = - List.map fst inlines - |> List.filter (function - | Inline.Tag _ - | Inline.Link _ - | Inline.Nested_link _ -> - true - | _ -> false) - let heading ~outline_only ~level ~unordered ~size ~marker ~priority ~title = Heading { level @@ -384,13 +375,7 @@ let try_md_property config line = else String.trim (String.sub line rest_i (n - rest_i)) in - Some - ( key - , value - , if config.parse_outline_only then - filter_prop_refs (outline_inlines config value) - else - Property.property_references config value ) + Some (key, value, Property.property_references config value) else None @@ -441,13 +426,7 @@ let try_org_drawer_prop_line config line = else String.trim (String.sub line rest_i (n - rest_i)) in - Some - ( key - , value - , if config.parse_outline_only then - filter_prop_refs (outline_inlines config value) - else - Property.property_references config value ) + Some (key, value, Property.property_references config value) else None diff --git a/lib/syntax/outline_inline.ml b/lib/syntax/outline_inline.ml index cd130d27..9619837a 100644 --- a/lib/syntax/outline_inline.ml +++ b/lib/syntax/outline_inline.ml @@ -171,8 +171,13 @@ let try_fast_scan_range s off len = match find_page_ref_end s !i with | Some e when e <= end_ -> let name = String.sub s (!i + 2) (e - !i - 4) in - acc := page_ref_link name :: !acc; - i := e + (* Nested [[…]] needs Nested_link — fall back to Angstrom. *) + if String.contains name '[' then + complex := true + else ( + acc := page_ref_link name :: !acc; + i := e + ) | _ -> complex := true) | '[' -> complex := true | '(' when !i + 1 < end_ && s.[!i + 1] = '(' -> ( diff --git a/test/test_outline_markdown.ml b/test/test_outline_markdown.ml index 5bb3db28..9b0e72bb 100644 --- a/test/test_outline_markdown.ml +++ b/test/test_outline_markdown.ml @@ -325,6 +325,49 @@ let inline = (Property_Drawer [ ("type", "programming_lang", []); ("creator", "test", []) ]) ) + ; ( "property-value-nested-ref" + , `Quick + , check_aux + ":PROPERTIES:\n\ + :type: [[programming [[clojure]]]]\n\ + :creator: test\n\ + :END:" + (Property_Drawer + [ ( "type" + , "[[programming [[clojure]]]]" + , [ I.Nested_link + { content = "[[programming [[clojure]]]]" + ; children = + [ Nested_link.Label "programming " + ; Nested_link.Nested_link + ( { content = "[[clojure]]" + ; children = [ Nested_link.Label "clojure" ] + } + , None ) + ] + } + ] ) + ; ("creator", "test", []) + ]) ) + ; ( "md-property-nested-ref" + , `Quick + , check_aux "related:: [[programming [[clojure]]]]" + (Property_Drawer + [ ( "related" + , "[[programming [[clojure]]]]" + , [ I.Nested_link + { content = "[[programming [[clojure]]]]" + ; children = + [ Nested_link.Label "programming " + ; Nested_link.Nested_link + ( { content = "[[clojure]]" + ; children = [ Nested_link.Label "clojure" ] + } + , None ) + ] + } + ] ) + ]) ) ; ( "spaces-before-drawer" , `Quick , check_aux