parse.ml 1.0 KB

123456789101112131415161718192021222324252627282930313233
  1. open Lexing
  2. open Types
  3. let loc_from_lexpos pstart pend =
  4. let (fname, ystart, yend, xstart, xend) = begin
  5. pstart.pos_fname,
  6. pstart.pos_lnum,
  7. pend.pos_lnum,
  8. (pstart.pos_cnum - pstart.pos_bol + 1),
  9. (pend.pos_cnum - pend.pos_bol)
  10. end in
  11. if ystart = yend && xend < xstart then
  12. (fname, ystart, yend, xstart, xstart)
  13. else
  14. (fname, ystart, yend, xstart, xend)
  15. let get_loc lexbuf =
  16. loc_from_lexpos lexbuf.lex_curr_p lexbuf.lex_curr_p
  17. let shift_loc (fname, ystart, yend, xstart, xend) yshift xshift =
  18. (fname, ystart + yshift, yend + yshift, xstart + xshift, xend + xshift)
  19. let shift_back lexbuf =
  20. shift_loc (get_loc lexbuf) 0 (-1)
  21. let parse_input display_name content =
  22. let lexbuf = Lexing.from_string content in
  23. lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = display_name };
  24. try Parser.stylesheet Lexer.token lexbuf with
  25. | Syntax_error msg ->
  26. raise (Loc_error (shift_back lexbuf, msg))
  27. | Parser.Error ->
  28. raise (Loc_error (shift_back lexbuf, "syntax error"))