1 (** "Handwritten" structural line lexer. 2 3 Classifies physical lines into high-level structural tokens that the Menhir 4 grammar will consume. The lexer is context-aware: it knows the TODO keywords 5 from the pre-scan to assist heading classification (though heading title 6 parsing is deferred to normalization). 7 8 The lexer operates line-by-line. Each call to [next_token] returns the 9 classification of the next line. Tokens are [Parser.token] values directly. 10 *) 11 12 type state = { 13 lines : string array; 14 mutable line_idx : int; 15 mutable line_number : int; (** 1-based line number *) 16 config : Config.t; 17 } 18 (** Lexer state. *) 19 20 (** Create a new lexer state from input text. *) 21 let create ~config input = 22 let lines = String.split_on_char '\n' input |> Array.of_list in 23 { lines; line_idx = 0; line_number = 1; config } 24 25 (** Get the current (1-based) line number. *) 26 let line_number st = st.line_number 27 28 (** Check if a line is entirely whitespace. *) 29 let is_blank_line s = 30 let len = String.length s in 31 let rec loop i = 32 if i >= len then true 33 else match s.[i] with ' ' | '\t' | '\r' -> loop (i + 1) | _ -> false 34 in 35 loop 0 36 37 (** Count leading spaces (tabs = 1 for simplicity in indentation). *) 38 let leading_indent s = 39 let len = String.length s in 40 let rec loop i = 41 if i >= len then i 42 else match s.[i] with ' ' -> loop (i + 1) | '\t' -> loop (i + 8) | _ -> i 43 in 44 loop 0 45 46 (** Check if string starts with prefix at position [pos]. *) 47 let starts_at s pos prefix = 48 let plen = String.length prefix in 49 if pos + plen > String.length s then false 50 else 51 let rec loop i = 52 if i >= plen then true 53 else if s.[pos + i] <> prefix.[i] then false 54 else loop (i + 1) 55 in 56 loop 0 57 58 (** Case-insensitive prefix check at position. *) 59 let starts_at_ci s pos prefix = 60 let plen = String.length prefix in 61 if pos + plen > String.length s then false 62 else 63 let rec loop i = 64 if i >= plen then true 65 else 66 let c1 = Char.lowercase_ascii s.[pos + i] in 67 let c2 = Char.lowercase_ascii prefix.[i] in 68 if c1 <> c2 then false else loop (i + 1) 69 in 70 loop 0 71 72 let rstrip = String_util.rstrip 73 74 (** Affiliated keyword names per Org spec defaults. *) 75 let affiliated_keywords = 76 [ "CAPTION"; "DATA"; "HEADER"; "HEADERS"; "NAME"; "PLOT"; "RESULTS" ] 77 78 let attr_prefix = "ATTR_" 79 80 (** Check if a keyword key is an affiliated keyword. Affiliated keywords: 81 CAPTION, DATA, HEADER, HEADERS, NAME, PLOT, RESULTS, ATTR_* *) 82 let is_affiliated_key key = 83 let ukey = String.uppercase_ascii key in 84 List.mem ukey affiliated_keywords 85 || (String.length ukey > 5 && String.sub ukey 0 5 = attr_prefix) 86 87 (** Try to classify a line as a keyword: #+KEY: VALUE Returns Some (key, value) 88 or None. *) 89 let try_keyword line start = 90 let len = String.length line in 91 if start + 1 >= len || line.[start] <> '#' || line.[start + 1] <> '+' then 92 None 93 else 94 let rest_start = start + 2 in 95 (* Find the colon *) 96 let rec find_colon i = 97 if i >= len then None 98 else if line.[i] = ':' then Some i 99 else if line.[i] = ' ' || line.[i] = '\t' then 100 None (* space before colon = not keyword *) 101 else find_colon (i + 1) 102 in 103 match find_colon rest_start with 104 | None -> None 105 | Some colon_pos -> 106 let key = String.sub line rest_start (colon_pos - rest_start) in 107 let value = 108 if colon_pos + 1 < len then 109 let v = String.sub line (colon_pos + 1) (len - colon_pos - 1) in 110 (* Strip leading space from value *) 111 if String.length v > 0 && v.[0] = ' ' then 112 String.sub v 1 (String.length v - 1) 113 else v 114 else "" 115 in 116 Some (key, rstrip value) 117 118 (** Try to parse a #+begin_NAME line. Returns Some (name_lowercase, 119 params_option) or None. *) 120 let try_begin_block line start = 121 let len = String.length line in 122 if not (starts_at_ci line start "#+begin_") then None 123 else 124 let name_start = start + 8 in 125 (* Find end of name (next space or end of line) *) 126 let rec find_end i = 127 if i >= len then i 128 else if line.[i] = ' ' || line.[i] = '\t' then i 129 else find_end (i + 1) 130 in 131 let name_end = find_end name_start in 132 if name_end = name_start then None (* empty name *) 133 else 134 let name = 135 String.lowercase_ascii 136 (String.sub line name_start (name_end - name_start)) 137 in 138 let params = 139 if name_end < len then 140 let p = rstrip (String.sub line name_end (len - name_end)) in 141 let p = 142 if String.length p > 0 && p.[0] = ' ' then 143 String.sub p 1 (String.length p - 1) 144 else p 145 in 146 if String.length p > 0 then Some p else None 147 else None 148 in 149 Some (name, params) 150 151 (** Try to parse a #+end_NAME line. *) 152 let try_end_block line start = 153 let len = String.length line in 154 if not (starts_at_ci line start "#+end_") then None 155 else 156 let name_start = start + 6 in 157 let rec find_end i = 158 if i >= len then i 159 else if line.[i] = ' ' || line.[i] = '\t' then i 160 else find_end (i + 1) 161 in 162 let name_end = find_end name_start in 163 if name_end = name_start then None 164 else 165 Some 166 (String.lowercase_ascii 167 (String.sub line name_start (name_end - name_start))) 168 169 (** Try to parse a drawer begin line: :NAME: *) 170 let try_drawer_begin line start = 171 let len = String.length line in 172 if start >= len || line.[start] <> ':' then None 173 else 174 (* Must end with : and contain only word chars, hyphens, underscores between *) 175 let rec find_end i = 176 if i >= len then None 177 else if line.[i] = ':' then 178 (* Check rest is blank *) 179 let rest = rstrip (String.sub line (i + 1) (len - i - 1)) in 180 if String.length rest = 0 then Some i else None 181 else if 182 (line.[i] >= 'a' && line.[i] <= 'z') 183 || (line.[i] >= 'A' && line.[i] <= 'Z') 184 || (line.[i] >= '0' && line.[i] <= '9') 185 || line.[i] = '-' 186 || line.[i] = '_' 187 then find_end (i + 1) 188 else None 189 in 190 match find_end (start + 1) with 191 | None -> None 192 | Some end_pos -> 193 let name = String.sub line (start + 1) (end_pos - start - 1) in 194 if String.length name = 0 then None else Some name 195 196 (** Check if a line is :end: (drawer end). *) 197 let is_drawer_end line start = 198 starts_at_ci line start ":end:" 199 && 200 let rest = String.sub line (start + 5) (String.length line - start - 5) in 201 is_blank_line rest 202 203 (** Check if a line is a property: :NAME: VALUE or :NAME+: VALUE *) 204 let try_property line start = 205 let len = String.length line in 206 if start >= len || line.[start] <> ':' then None 207 else 208 let rec find_colon i = 209 if i >= len then None 210 else if line.[i] = ':' then Some i 211 else if 212 (line.[i] >= 'a' && line.[i] <= 'z') 213 || (line.[i] >= 'A' && line.[i] <= 'Z') 214 || (line.[i] >= '0' && line.[i] <= '9') 215 || line.[i] = '-' 216 || line.[i] = '_' 217 || line.[i] = '+' 218 then find_colon (i + 1) 219 else None 220 in 221 match find_colon (start + 1) with 222 | None -> None 223 | Some colon_pos -> 224 let name = String.sub line (start + 1) (colon_pos - start - 1) in 225 if String.length name = 0 then None 226 else 227 let value_start = colon_pos + 1 in 228 let value = 229 if value_start < len then 230 let v = 231 rstrip (String.sub line value_start (len - value_start)) 232 in 233 let v = 234 if String.length v > 0 && v.[0] = ' ' then 235 String.sub v 1 (String.length v - 1) 236 else v 237 in 238 if String.length v > 0 then Some v else None 239 else None 240 in 241 Some (name, value) 242 243 (** Try to classify a line as a list item. List items start with: - item, + 244 item, * item (not at column 0), 1. item, 1) item, a. item, a) item *) 245 let try_list_item line = 246 let len = String.length line in 247 let indent = leading_indent line in 248 if indent >= len then None 249 else 250 let pos = ref indent in 251 (* Try bullet markers *) 252 let bullet_result = 253 if !pos >= len then None 254 else 255 let c = line.[!pos] in 256 if (c = '-' || c = '+') && !pos + 1 < len && line.[!pos + 1] = ' ' then begin 257 pos := !pos + 2; 258 Some (String.make 1 c ^ " ") 259 end 260 else if c = '*' && indent > 0 && !pos + 1 < len && line.[!pos + 1] = ' ' 261 then begin 262 (* * at column >0 is a list bullet; at column 0 it's a heading *) 263 pos := !pos + 2; 264 Some "* " 265 end 266 else begin 267 (* Try ordered: digit(s) followed by . or ) then space *) 268 let start = !pos in 269 let rec scan_digits i = 270 if i >= len then None 271 else if line.[i] >= '0' && line.[i] <= '9' then scan_digits (i + 1) 272 else if 273 i > start 274 && (line.[i] = '.' || line.[i] = ')') 275 && i + 1 < len 276 && line.[i + 1] = ' ' 277 then begin 278 let bullet_text = String.sub line start (i - start + 1) ^ " " in 279 pos := i + 2; 280 Some bullet_text 281 end 282 else if 283 i = start 284 && ((line.[i] >= 'a' && line.[i] <= 'z') 285 || (line.[i] >= 'A' && line.[i] <= 'Z')) 286 && i + 1 < len 287 && (line.[i + 1] = '.' || line.[i + 1] = ')') 288 && i + 2 < len 289 && line.[i + 2] = ' ' 290 then begin 291 let bullet_text = String.sub line start 2 ^ " " in 292 pos := i + 3; 293 Some bullet_text 294 end 295 else None 296 in 297 scan_digits start 298 end 299 in 300 match bullet_result with 301 | None -> None 302 | Some bullet -> 303 (* Check for counter set: [@N] *) 304 let counter_set = 305 if !pos + 2 < len && line.[!pos] = '[' && line.[!pos + 1] = '@' then begin 306 let start = !pos + 2 in 307 let rec find_bracket i = 308 if i >= len then None 309 else if line.[i] = ']' then 310 let num_str = String.sub line start (i - start) in 311 try 312 pos := i + 1; 313 if !pos < len && line.[!pos] = ' ' then incr pos; 314 Some (int_of_string num_str) 315 with Failure _ -> None 316 else find_bracket (i + 1) 317 in 318 find_bracket start 319 end 320 else None 321 in 322 (* Check for checkbox: [ ], [X], [-] *) 323 let checkbox = 324 if 325 !pos + 2 < len 326 && line.[!pos] = '[' 327 && (line.[!pos + 1] = ' ' 328 || line.[!pos + 1] = 'X' 329 || line.[!pos + 1] = 'x' 330 || line.[!pos + 1] = '-') 331 && line.[!pos + 2] = ']' 332 then begin 333 let cb = String.sub line !pos 3 in 334 pos := !pos + 3; 335 if !pos < len && line.[!pos] = ' ' then incr pos; 336 Some cb 337 end 338 else None 339 in 340 let rest = 341 if !pos < len then String.sub line !pos (len - !pos) else "" 342 in 343 Some 344 { 345 Token.lid_indent = indent; 346 lid_bullet = bullet; 347 lid_counter_set = counter_set; 348 lid_checkbox = checkbox; 349 lid_rest = rstrip rest; 350 } 351 352 (** Check if a line is a horizontal rule: 5+ hyphens, nothing else. *) 353 let is_horizontal_rule line start = 354 let len = String.length line in 355 let rec count i = 356 if i >= len then i - start 357 else if line.[i] = '-' then count (i + 1) 358 else if line.[i] = ' ' || line.[i] = '\t' || line.[i] = '\r' then 359 (* trailing whitespace ok *) 360 let rest = rstrip (String.sub line i (len - i)) in 361 if String.length rest = 0 then i - start else 0 362 else 0 363 in 364 count start >= 5 365 366 (** Check if a line is a planning line (starts with DEADLINE:, SCHEDULED:, or 367 CLOSED:). *) 368 let is_planning_line line start = 369 starts_at line start "DEADLINE:" 370 || starts_at line start "SCHEDULED:" 371 || starts_at line start "CLOSED:" 372 373 (** Check if a line is a table row (starts with |). *) 374 let is_table_row line start = start < String.length line && line.[start] = '|' 375 376 (** Check if a line is a comment: # followed by space or end of line. *) 377 let try_comment_line line start = 378 let len = String.length line in 379 if start >= len || line.[start] <> '#' then None 380 else if start + 1 >= len then Some "" 381 else if line.[start + 1] = ' ' then 382 Some (rstrip (String.sub line (start + 2) (len - start - 2))) 383 else if line.[start + 1] = '+' then None (* keyword, not comment *) 384 else None (* # followed by non-space non-+ is not a comment *) 385 386 (** Check if a line is fixed-width: ": " or ":" at end of line. *) 387 let try_fixed_width line start = 388 let len = String.length line in 389 if start >= len || line.[start] <> ':' then None 390 else if start + 1 >= len then Some "" 391 else if line.[start + 1] = ' ' then 392 Some (rstrip (String.sub line (start + 2) (len - start - 2))) 393 else None 394 395 (** Check if a line is a heading: starts with one or more * followed by space. 396 *) 397 let try_heading line = 398 let len = String.length line in 399 if len = 0 || line.[0] <> '*' then None 400 else 401 let rec count_stars i = 402 if i >= len then i else if line.[i] = '*' then count_stars (i + 1) else i 403 in 404 let stars = count_stars 0 in 405 if stars >= len then 406 (* Line is all stars with no space — it's a heading with empty title *) 407 None (* Actually per spec, space after stars is mandatory *) 408 else if line.[stars] = ' ' then 409 let rest = String.sub line (stars + 1) (len - stars - 1) in 410 Some (stars, rstrip rest) 411 else None 412 413 (** Classify the next line and return its token. *) 414 let classify_line _st line = 415 let line = rstrip line in 416 if is_blank_line line then Parser.BLANK 417 else 418 let indent = leading_indent line in 419 let start = indent in 420 (* Headings must be at column 0 *) 421 if indent = 0 then 422 begin match try_heading line with 423 | Some (level, rest) -> Parser.HEADING (level, rest) 424 | None -> ( 425 (* Try keyword/block *) 426 match try_begin_block line start with 427 | Some (name, params) -> Parser.BEGIN_BLOCK (name, params) 428 | None -> ( 429 match try_end_block line start with 430 | Some name -> Parser.END_BLOCK name 431 | None -> ( 432 match try_keyword line start with 433 | Some (key, value) -> 434 if is_affiliated_key key then 435 Parser.AFFILIATED_KEYWORD 436 (String.uppercase_ascii key, None, value) 437 else Parser.KEYWORD (String.uppercase_ascii key, value) 438 | None -> ( 439 if is_drawer_end line start then Parser.DRAWER_END 440 else 441 match try_drawer_begin line start with 442 | Some name -> Parser.DRAWER_BEGIN name 443 | None -> ( 444 match try_property line start with 445 | Some (name, value) -> Parser.PROPERTY (name, value) 446 | None -> ( 447 if is_horizontal_rule line start then 448 Parser.HORIZONTAL_RULE 449 else if is_planning_line line start then 450 Parser.PLANNING line 451 else if is_table_row line start then 452 Parser.TABLE_ROW line 453 else 454 match try_comment_line line start with 455 | Some content -> Parser.COMMENT_LINE content 456 | None -> ( 457 match try_fixed_width line start with 458 | Some content -> 459 Parser.FIXED_WIDTH content 460 | None -> ( 461 match try_list_item line with 462 | Some data -> Parser.LIST_ITEM data 463 | None -> Parser.TEXT_LINE line))))))) 464 ) 465 end 466 else 467 (* Indented lines *) 468 begin if is_planning_line line start then Parser.PLANNING line 469 else if is_table_row line start then Parser.TABLE_ROW line 470 else if is_drawer_end line start then Parser.DRAWER_END 471 else 472 match try_drawer_begin line start with 473 | Some name -> Parser.DRAWER_BEGIN name 474 | None -> ( 475 match try_begin_block line start with 476 | Some (name, params) -> Parser.BEGIN_BLOCK (name, params) 477 | None -> ( 478 match try_end_block line start with 479 | Some name -> Parser.END_BLOCK name 480 | None -> ( 481 match try_keyword line start with 482 | Some (key, value) -> 483 if is_affiliated_key key then 484 Parser.AFFILIATED_KEYWORD 485 (String.uppercase_ascii key, None, value) 486 else Parser.KEYWORD (String.uppercase_ascii key, value) 487 | None -> ( 488 match try_property line start with 489 | Some (name, value) -> Parser.PROPERTY (name, value) 490 | None -> ( 491 match try_comment_line line start with 492 | Some content -> Parser.COMMENT_LINE content 493 | None -> ( 494 match try_fixed_width line start with 495 | Some content -> Parser.FIXED_WIDTH content 496 | None -> ( 497 match try_list_item line with 498 | Some data -> Parser.LIST_ITEM data 499 | None -> Parser.TEXT_LINE line))))))) 500 end 501 502 (** Get the next token from the lexer. *) 503 let next_token st = 504 if st.line_idx >= Array.length st.lines then Parser.EOF 505 else begin 506 let line = st.lines.(st.line_idx) in 507 st.line_idx <- st.line_idx + 1; 508 st.line_number <- st.line_number + 1; 509 classify_line st line 510 end 511 512 (** Tokenize the entire input into a list of (token, line_number) pairs. Useful 513 for testing and for feeding Menhir. *) 514 let tokenize ~config input = 515 let st = create ~config input in 516 let rec loop acc = 517 let ln = st.line_number in 518 let tok = next_token st in 519 match tok with 520 | Parser.EOF -> List.rev ((Parser.EOF, ln) :: acc) 521 | _ -> loop ((tok, ln) :: acc) 522 in 523 loop [] 524