let rec parse_bstr state str ~max_pos ~pos = if pos > max_pos then mk_cont "parse" parse_bstr state else match str.{pos} with | '(' -> state.pstack <- [] :: state.pstack; bump_pos_cont state str ~max_pos ~pos parse_bstr | ')' as c -> (match state.pstack with | [] -> raise_unexpected_char state ~loc:"parse" pos c | rev_sexp_lst :: sexp_stack -> let sexp = List (List.rev rev_sexp_lst) in match sexp_stack with | [] -> Done (sexp, mk_parse_pos state (pos + 1)) | higher_rev_sexp_lst :: higher_sexp_stack -> state.pstack <- (sexp :: higher_rev_sexp_lst) :: higher_sexp_stack; bump_pos_cont state str ~max_pos ~pos parse_bstr) | ' ' | '\009' | '\012' -> bump_pos_cont state str ~max_pos ~pos parse_bstr | '\010' -> bump_line_cont state str ~max_pos ~pos parse_bstr | '\013' -> bump_line_cont state str ~max_pos ~pos parse_nl | ';' -> bump_pos_cont state str ~max_pos ~pos parse_comment | '"' -> bump_pos_cont state str ~max_pos ~pos parse_quoted | c -> 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_bstr 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_bstr | '\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_bstr | '(' -> let pbuf = state.pbuf in let atom = Atom (Buffer.contents pbuf) in (match state.pstack with | [] -> Done (atom, mk_parse_pos state pos) | rev_sexp_lst :: sexp_stack -> Buffer.clear pbuf; state.pstack <- [] :: (atom :: rev_sexp_lst) :: sexp_stack; bump_pos_cont state str ~max_pos ~pos parse_bstr) | ')' -> let pbuf = state.pbuf in let atom = Atom (Buffer.contents pbuf) in (match state.pstack with | [] -> Done (atom, mk_parse_pos state pos) | rev_sexp_lst :: sexp_stack -> let sexp = List (List.rev_append rev_sexp_lst [atom]) in match sexp_stack with | [] -> Done (sexp, mk_parse_pos state (pos + 1)) | higher_rev_sexp_lst :: higher_sexp_stack -> Buffer.clear pbuf; state.pstack <- (sexp :: higher_rev_sexp_lst) :: higher_sexp_stack; bump_pos_cont state str ~max_pos ~pos parse_bstr) | '\010' -> bump_found_atom bump_text_line state str ~max_pos ~pos parse_bstr | '\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 parse_quoted | c -> add_bump_pos state str ~max_pos ~pos c parse_atom 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 atom = Atom (Buffer.contents pbuf) in (match state.pstack with | [] -> Done (atom, mk_parse_pos state (pos + 1)) | rev_sexp_lst :: sexp_stack -> Buffer.clear pbuf; state.pstack <- (atom :: rev_sexp_lst) :: sexp_stack; bump_pos_cont state str ~max_pos ~pos parse_bstr) | '\\' -> 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 state "parse_dec" 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 state ~loc:"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 state "parse_hex" 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 state ~loc:"parse_hex" pos c