let rec parse_bigstring_annot state str ~max_pos ~pos = if pos > max_pos then mk_cont "parse" parse_bigstring_annot state else match str.{pos} with | '(' -> add_annot_pos state pos; let pstack = [] :: state.pstack.Annot.stack in state.pstack.Annot.stack <- pstack; bump_pos_cont state str ~max_pos ~pos parse_bigstring_annot | ')' as c -> (match state.pstack.Annot.stack with | [] -> raise_unexpected_char ( `Annot state) "parse" pos c | rev_sexp_lst :: sexp_stack -> let sexp_lst = List.rev rev_sexp_lst in let sexp = mk_annot_list state sexp_lst pos in match sexp_stack with | [] -> Done (sexp, mk_parse_pos state (pos + 1)) | higher_rev_sexp_lst :: higher_sexp_stack -> let pstack = (sexp :: higher_rev_sexp_lst) :: higher_sexp_stack in state.pstack.Annot.stack <- pstack; bump_pos_cont state str ~max_pos ~pos parse_bigstring_annot) | ' ' | '\009' | '\012' -> bump_pos_cont state str ~max_pos ~pos parse_bigstring_annot | '\010' -> bump_line_cont state str ~max_pos ~pos parse_bigstring_annot | '\013' -> bump_line_cont state str ~max_pos ~pos parse_nl | ';' -> bump_pos_cont state str ~max_pos ~pos parse_comment | '"' -> add_annot_pos1 state pos; bump_pos_cont state str ~max_pos ~pos parse_quoted | c -> add_annot_pos state pos; add_bump_pos state str ~max_pos ~pos c parse_atom and parse_nl state str ~max_pos ~pos = if pos > max_pos then mk_cont "parse_nl" parse_nl state else let pos = if str.{pos} = '\010' then pos + 1 else pos in parse_bigstring_annot state str ~max_pos ~pos and parse_comment state str ~max_pos ~pos = if pos > max_pos then mk_cont "parse_comment" parse_comment state else match str.{pos} with | '\010' -> bump_line_cont state str ~max_pos ~pos parse_bigstring_annot | '\013' -> bump_line_cont state str ~max_pos ~pos parse_nl | _ -> bump_pos_cont state str ~max_pos ~pos parse_comment and parse_atom state str ~max_pos ~pos = if pos > max_pos then mk_cont "parse_atom" parse_atom state else match str.{pos} with | ' ' | '\009' | '\012' -> bump_found_atom bump_text_pos state str ~max_pos ~pos parse_bigstring_annot | '(' -> let pbuf = state.pbuf in let pbuf_str = Buffer.contents pbuf in let atom = mk_annot_atom state pbuf_str pos in (match state.pstack.Annot.stack with | [] -> Done (atom, mk_parse_pos state pos) | rev_sexp_lst :: sexp_stack -> add_annot_pos state pos; Buffer.clear pbuf; let pstack = [] :: (atom :: rev_sexp_lst) :: sexp_stack in state.pstack.Annot.stack <- pstack; bump_pos_cont state str ~max_pos ~pos parse_bigstring_annot) | ')' -> let pbuf = state.pbuf in let pbuf_str = Buffer.contents pbuf in let atom = mk_annot_atom state pbuf_str pos in (match state.pstack.Annot.stack with | [] -> Done (atom, mk_parse_pos state pos) | rev_sexp_lst :: sexp_stack -> let sexp_lst = List.rev_append rev_sexp_lst [atom] in let sexp = mk_annot_list state sexp_lst pos in match sexp_stack with | [] -> Done (sexp, mk_parse_pos state (pos + 1)) | higher_rev_sexp_lst :: higher_sexp_stack -> Buffer.clear pbuf; let pstack = (sexp :: higher_rev_sexp_lst) :: higher_sexp_stack in state.pstack.Annot.stack <- pstack; bump_pos_cont state str ~max_pos ~pos parse_bigstring_annot) | '\010' -> bump_found_atom bump_text_line state str ~max_pos ~pos parse_bigstring_annot | '\013' -> bump_found_atom bump_text_line state str ~max_pos ~pos parse_nl | ';' -> bump_found_atom bump_text_pos state str ~max_pos ~pos parse_comment | '"' -> bump_found_atom bump_text_pos state str ~max_pos ~pos reg_parse_quoted | c -> add_bump_pos state str ~max_pos ~pos c parse_atom and reg_parse_quoted state str ~max_pos ~pos = add_annot_pos state pos; parse_quoted state str ~max_pos ~pos and parse_quoted state str ~max_pos ~pos = if pos > max_pos then mk_cont "parse_quoted" parse_quoted state else match str.{pos} with | '"' -> let pbuf = state.pbuf in let pbuf_str = Buffer.contents pbuf in let atom = mk_annot_atom state pbuf_str pos in (match state.pstack.Annot.stack with | [] -> Done (atom, mk_parse_pos state (pos + 1)) | rev_sexp_lst :: sexp_stack -> Buffer.clear pbuf; let pstack = (atom :: rev_sexp_lst) :: sexp_stack in state.pstack.Annot.stack <- pstack; bump_pos_cont state str ~max_pos ~pos parse_bigstring_annot) | '\\' -> bump_pos_cont state str ~max_pos ~pos parse_escaped | '\010' as c -> add_bump_line state str ~max_pos ~pos c parse_quoted | '\013' as c -> add_bump_line state str ~max_pos ~pos c parse_quoted_nl | c -> add_bump_pos state str ~max_pos ~pos c parse_quoted and parse_quoted_nl state str ~max_pos ~pos = if pos > max_pos then mk_cont "parse_quoted_nl" parse_quoted_nl state else let pos = let c = '\010' in if str.{pos} = c then ( Buffer.add_char state.pbuf c; pos + 1 ) else pos in parse_quoted state str ~max_pos ~pos and parse_escaped state str ~max_pos ~pos = if pos > max_pos then mk_cont "parse_escaped" parse_escaped state else match str.{pos} with | '\010' -> bump_line_cont state str ~max_pos ~pos parse_skip_ws | '\013' -> bump_line_cont state str ~max_pos ~pos parse_skip_ws_nl | '0' .. '9' as c -> bump_text_pos state; let d = Char.code c - 48 in parse_dec state str ~max_pos ~pos:(pos + 1) ~count:2 ~d | 'x' -> bump_text_pos state; parse_hex state str ~max_pos ~pos:(pos + 1) ~count:2 ~d:0 | ('\\' | '"' | '\'' ) as c -> add_bump_pos state str ~max_pos ~pos c parse_quoted | 'n' -> add_bump_pos state str ~max_pos ~pos '\n' parse_quoted | 't' -> add_bump_pos state str ~max_pos ~pos '\t' parse_quoted | 'b' -> add_bump_pos state str ~max_pos ~pos '\b' parse_quoted | 'r' -> add_bump_pos state str ~max_pos ~pos '\r' parse_quoted | c -> Buffer.add_char state.pbuf '\\'; add_bump_pos state str ~max_pos ~pos c parse_quoted and parse_skip_ws state str ~max_pos ~pos = if pos > max_pos then mk_cont "parse_skip_ws" parse_skip_ws state else match str.{pos} with | ' ' | '\009' -> bump_pos_cont state str ~max_pos ~pos parse_skip_ws | _ -> parse_quoted state str ~max_pos ~pos and parse_skip_ws_nl state str ~max_pos ~pos = if pos > max_pos then mk_cont "parse_skip_ws_nl" parse_skip_ws_nl state else let pos = if str.{pos} = '\010' then pos + 1 else pos in parse_skip_ws state str ~max_pos ~pos and parse_dec state str ~max_pos ~pos ~count ~d = if pos > max_pos then mk_cont "parse_dec" (parse_dec ~count ~d) state else match str.{pos} with | '0' .. '9' as c -> let d = 10 * d + Char.code c - 48 in if count = 1 then if d > 255 then let err_msg = sprintf "illegal decimal escape: \\%d" d in raise_parse_error ( `Annot state) "parse_dec" pos err_msg else add_bump_pos state str ~max_pos ~pos (Char.chr d) parse_quoted else ( bump_text_pos state; parse_dec state str ~max_pos ~pos:(pos + 1) ~count:(count - 1) ~d) | c -> raise_unexpected_char ( `Annot state) "parse_dec" pos c and parse_hex state str ~max_pos ~pos ~count ~d = if pos > max_pos then mk_cont "parse_hex" (parse_hex ~count ~d) state else match str.{pos} with | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' as c -> let corr = if c >= 'a' then 87 else if c >= 'A' then 55 else 48 in let d = 16 * d + Char.code c - corr in if count = 1 then if d > 255 then let err_msg = sprintf "illegal hexadecimal escape: \\%x" d in raise_parse_error ( `Annot state) "parse_hex" pos err_msg else add_bump_pos state str ~max_pos ~pos (Char.chr d) parse_quoted else ( bump_text_pos state; parse_hex state str ~max_pos ~pos:(pos + 1) ~count:(count - 1) ~d) | c -> raise_unexpected_char ( `Annot state) "parse_hex" pos c