1 (** Handwritten inline lexer. 2 3 Tokenizes bounded text (heading titles, paragraph bodies, etc.) into tokens 4 suitable for the inline Menhir grammar. 5 6 Key design: emphasis delimiters are only emitted as OPEN/CLOSE tokens when 7 they form valid matched pairs. Unmatched delimiters become TEXT. This 8 eliminates ambiguity in the Menhir grammar. Tokens are [Inline_parser.token] 9 values directly. *) 10 11 (** PRE characters that allow an emphasis marker to open. *) 12 let is_pre ch = 13 match ch with 14 | ' ' | '\t' | '-' | '(' | '{' | '\'' | '"' | '\n' -> true 15 | _ -> false 16 17 (** POST characters that allow an emphasis marker to close. *) 18 let is_post ch = 19 match ch with 20 | ' ' | '\t' | '-' | '.' | ',' | ';' | ':' | '!' | '?' | ')' | '}' | '\'' 21 | '"' | '\n' | '[' -> 22 true 23 | _ -> false 24 25 (** Common link protocols for plain link detection. *) 26 let link_protocols = [ "https://"; "http://"; "ftp://"; "file://"; "mailto:" ] 27 28 (** Check if a string starts with a prefix at position [pos]. *) 29 let starts_with_at s pos prefix = 30 let plen = String.length prefix in 31 if pos + plen > String.length s then false else String.sub s pos plen = prefix 32 33 (** Pre-scan for matched emphasis pairs in the input. Returns a set of positions 34 where open/close markers are valid. *) 35 let find_emphasis_pairs input delim = 36 let len = String.length input in 37 let opens = ref [] in 38 let pairs = Hashtbl.create 16 in 39 let i = ref 0 in 40 while !i < len do 41 if input.[!i] = delim then begin 42 (* Check if this could be an opener *) 43 let pre_ok = !i = 0 || is_pre input.[!i - 1] in 44 let next_not_space = 45 !i + 1 < len 46 && match input.[!i + 1] with ' ' | '\t' | '\n' -> false | _ -> true 47 in 48 (* Check if this could be a closer *) 49 let post_ok = !i + 1 >= len || is_post input.[!i + 1] in 50 let prev_not_space = 51 !i > 0 52 && match input.[!i - 1] with ' ' | '\t' | '\n' -> false | _ -> true 53 in 54 if prev_not_space && post_ok && !opens <> [] then begin 55 (* This is a closer — match with most recent opener *) 56 let open_pos = List.hd !opens in 57 opens := List.tl !opens; 58 Hashtbl.replace pairs open_pos `Open; 59 Hashtbl.replace pairs !i `Close 60 end 61 else if pre_ok && next_not_space then begin 62 (* This is a potential opener *) 63 opens := !i :: !opens 64 end 65 end; 66 incr i 67 done; 68 pairs 69 70 type state = { 71 input : string; 72 len : int; 73 mutable pos : int; 74 star_pairs : (int, [ `Open | `Close ]) Hashtbl.t; 75 slash_pairs : (int, [ `Open | `Close ]) Hashtbl.t; 76 under_pairs : (int, [ `Open | `Close ]) Hashtbl.t; 77 plus_pairs : (int, [ `Open | `Close ]) Hashtbl.t; 78 } 79 (** Lexer state. *) 80 81 let create input = 82 { 83 input; 84 len = String.length input; 85 pos = 0; 86 star_pairs = find_emphasis_pairs input '*'; 87 slash_pairs = find_emphasis_pairs input '/'; 88 under_pairs = find_emphasis_pairs input '_'; 89 plus_pairs = find_emphasis_pairs input '+'; 90 } 91 92 (** Try to match a verbatim/code span. *) 93 let try_verbatim_code st delim = 94 let start = st.pos in 95 let pre_ok = start = 0 || is_pre st.input.[start - 1] in 96 if not pre_ok then None 97 else begin 98 let rec find_close i = 99 if i >= st.len then None 100 else if st.input.[i] = '\n' then None 101 else if st.input.[i] = delim then 102 let post_ok = i + 1 >= st.len || is_post st.input.[i + 1] in 103 if post_ok && i > start + 1 then 104 Some (String.sub st.input (start + 1) (i - start - 1), i + 1) 105 else find_close (i + 1) 106 else find_close (i + 1) 107 in 108 find_close (start + 1) 109 end 110 111 (** Try to match a complete timestamp. *) 112 let try_timestamp st = 113 let c = st.input.[st.pos] in 114 let closer = if c = '<' then '>' else if c = '[' then ']' else '\x00' in 115 if closer = '\x00' then None 116 else begin 117 let next_pos = st.pos + 1 in 118 if next_pos >= st.len then None 119 else if not (st.input.[next_pos] >= '0' && st.input.[next_pos] <= '9') then 120 None 121 else begin 122 let rec find_close i = 123 if i >= st.len then None 124 else if st.input.[i] = closer then Some i 125 else if st.input.[i] = '\n' then None 126 else find_close (i + 1) 127 in 128 match find_close next_pos with 129 | None -> None 130 | Some end_pos -> 131 let ts = String.sub st.input st.pos (end_pos - st.pos + 1) in 132 (* Check for range *) 133 let after = end_pos + 1 in 134 if 135 after + 2 < st.len 136 && st.input.[after] = '-' 137 && st.input.[after + 1] = '-' 138 then begin 139 let range_start = after + 2 in 140 if range_start < st.len && st.input.[range_start] = c then 141 let next2 = range_start + 1 in 142 if 143 next2 < st.len 144 && st.input.[next2] >= '0' 145 && st.input.[next2] <= '9' 146 then 147 match find_close next2 with 148 | Some end2 -> 149 let full = String.sub st.input st.pos (end2 - st.pos + 1) in 150 Some (full, end2 + 1) 151 | None -> Some (ts, after) 152 else Some (ts, after) 153 else Some (ts, after) 154 end 155 else Some (ts, after) 156 end 157 end 158 159 (** Try to match an angle link: <protocol:path> *) 160 let try_angle_link st = 161 if st.input.[st.pos] <> '<' then None 162 else begin 163 let start = st.pos + 1 in 164 let rec find_close i = 165 if i >= st.len then None 166 else if st.input.[i] = '>' then 167 let content = String.sub st.input start (i - start) in 168 if String.contains content ':' && not (String.contains content ' ') then 169 Some (content, i + 1) 170 else None 171 else if st.input.[i] = '\n' || st.input.[i] = ' ' then None 172 else find_close (i + 1) 173 in 174 find_close start 175 end 176 177 (** Try to match a plain link. *) 178 let try_plain_link st = 179 let rec try_protocols = function 180 | [] -> None 181 | proto :: rest -> 182 if starts_with_at st.input st.pos proto then begin 183 let plen = String.length proto in 184 let rec find_end i = 185 if i >= st.len then i 186 else 187 match st.input.[i] with 188 | ' ' | '\t' | '\n' | '>' | '<' | ']' -> i 189 | _ -> find_end (i + 1) 190 in 191 let end_pos = find_end (st.pos + plen) in 192 let end_pos = ref end_pos in 193 while 194 !end_pos > st.pos + plen 195 && 196 match st.input.[!end_pos - 1] with 197 | '.' | ',' | ';' | ':' | '!' | '?' | ')' -> true 198 | _ -> false 199 do 200 decr end_pos 201 done; 202 if !end_pos > st.pos + plen then 203 Some (String.sub st.input st.pos (!end_pos - st.pos), !end_pos) 204 else None 205 end 206 else try_protocols rest 207 in 208 try_protocols link_protocols 209 210 (** Try to match a line break: \\\\ at end of line *) 211 let try_line_break st = 212 if 213 st.pos + 1 < st.len 214 && st.input.[st.pos] = '\\' 215 && st.input.[st.pos + 1] = '\\' 216 then begin 217 let rec skip_space i = 218 if i >= st.len then Some i 219 else 220 match st.input.[i] with 221 | ' ' | '\t' -> skip_space (i + 1) 222 | '\n' -> Some (i + 1) 223 | _ -> None 224 in 225 skip_space (st.pos + 2) 226 end 227 else None 228 229 (** Get the next token. *) 230 let next_token st = 231 if st.pos >= st.len then Inline_parser.EOF 232 else 233 let c = st.input.[st.pos] in 234 (* Try line break *) 235 match try_line_break st with 236 | Some new_pos -> 237 st.pos <- new_pos; 238 Inline_parser.LINE_BREAK 239 | None -> 240 (* Try verbatim/code *) 241 if c = '~' then ( 242 match try_verbatim_code st '~' with 243 | Some (content, new_pos) -> 244 st.pos <- new_pos; 245 Inline_parser.TILDE content 246 | None -> 247 st.pos <- st.pos + 1; 248 Inline_parser.TEXT "~") 249 else if c = '=' then ( 250 match try_verbatim_code st '=' with 251 | Some (content, new_pos) -> 252 st.pos <- new_pos; 253 Inline_parser.EQUALS content 254 | None -> 255 st.pos <- st.pos + 1; 256 Inline_parser.TEXT "=") 257 else if 258 (* Try link brackets *) 259 c = '[' && st.pos + 1 < st.len && st.input.[st.pos + 1] = '[' 260 then begin 261 st.pos <- st.pos + 2; 262 Inline_parser.LINK_OPEN 263 end 264 else if c = ']' && st.pos + 1 < st.len && st.input.[st.pos + 1] = ']' 265 then begin 266 st.pos <- st.pos + 2; 267 Inline_parser.LINK_CLOSE 268 end 269 else if c = ']' && st.pos + 1 < st.len && st.input.[st.pos + 1] = '[' 270 then begin 271 st.pos <- st.pos + 2; 272 Inline_parser.LINK_SEP 273 end 274 else if 275 (* Try timestamp *) 276 c = '<' 277 || c = '[' 278 && st.pos + 1 < st.len 279 && st.input.[st.pos + 1] >= '0' 280 && st.input.[st.pos + 1] <= '9' 281 then 282 begin match try_timestamp st with 283 | Some (ts, new_pos) -> 284 st.pos <- new_pos; 285 Inline_parser.TIMESTAMP ts 286 | None -> 287 if c = '<' then ( 288 match try_angle_link st with 289 | Some (content, new_pos) -> 290 st.pos <- new_pos; 291 Inline_parser.ANGLE_LINK content 292 | None -> 293 st.pos <- st.pos + 1; 294 Inline_parser.TEXT "<") 295 else begin 296 st.pos <- st.pos + 1; 297 Inline_parser.TEXT "[" 298 end 299 end 300 else 301 (* Try plain link *) 302 begin match try_plain_link st with 303 | Some (link, new_pos) -> 304 st.pos <- new_pos; 305 Inline_parser.PLAIN_LINK link 306 | None -> 307 (* Try emphasis markers — only emit OPEN/CLOSE if pre-scan found a pair *) 308 if c = '*' then begin 309 let tok = 310 match Hashtbl.find_opt st.star_pairs st.pos with 311 | Some `Open -> Inline_parser.STAR_OPEN 312 | Some `Close -> Inline_parser.STAR_CLOSE 313 | None -> Inline_parser.TEXT "*" 314 in 315 st.pos <- st.pos + 1; 316 tok 317 end 318 else if c = '/' then begin 319 let tok = 320 match Hashtbl.find_opt st.slash_pairs st.pos with 321 | Some `Open -> Inline_parser.SLASH_OPEN 322 | Some `Close -> Inline_parser.SLASH_CLOSE 323 | None -> Inline_parser.TEXT "/" 324 in 325 st.pos <- st.pos + 1; 326 tok 327 end 328 else if c = '_' then begin 329 let tok = 330 match Hashtbl.find_opt st.under_pairs st.pos with 331 | Some `Open -> Inline_parser.UNDER_OPEN 332 | Some `Close -> Inline_parser.UNDER_CLOSE 333 | None -> Inline_parser.TEXT "_" 334 in 335 st.pos <- st.pos + 1; 336 tok 337 end 338 else if c = '+' then begin 339 let tok = 340 match Hashtbl.find_opt st.plus_pairs st.pos with 341 | Some `Open -> Inline_parser.PLUS_OPEN 342 | Some `Close -> Inline_parser.PLUS_CLOSE 343 | None -> Inline_parser.TEXT "+" 344 in 345 st.pos <- st.pos + 1; 346 tok 347 end 348 else if c = '\n' then begin 349 st.pos <- st.pos + 1; 350 Inline_parser.NEWLINE 351 end 352 else begin 353 (* Accumulate plain text *) 354 let start = st.pos in 355 let rec scan i = 356 if i >= st.len then i 357 else 358 match st.input.[i] with 359 | '*' | '/' | '_' | '+' | '~' | '=' | '[' | ']' | '<' | '\n' 360 | '\\' -> 361 i 362 | _ -> 363 if 364 List.exists 365 (fun proto -> starts_with_at st.input i proto) 366 link_protocols 367 then i 368 else scan (i + 1) 369 in 370 let end_pos = scan (start + 1) in 371 st.pos <- end_pos; 372 Inline_parser.TEXT (String.sub st.input start (end_pos - start)) 373 end 374 end 375 376 (** Tokenize an entire string into a list of tokens. *) 377 let tokenize input = 378 let st = create input in 379 let rec loop acc = 380 let tok = next_token st in 381 match tok with 382 | Inline_parser.EOF -> List.rev (Inline_parser.EOF :: acc) 383 | _ -> loop (tok :: acc) 384 in 385 loop [] 386