civicaml/phases/parse.ml

open Lexing
open Types
open Util
open Globals

let get_loc lexbuf =
  Util.loc_from_lexpos lexbuf.lex_curr_p lexbuf.lex_curr_p

let shift_loc (fname, ystart, yend, xstart, xend) yshift xshift =
  (fname, ystart + yshift, yend + yshift, xstart + xshift, xend + xshift)

let shift_back lexbuf = shift_loc (get_loc lexbuf) 0 (-1)

let parse_with_error lexbuf =
  try Some (Parser.program Lexer.token lexbuf) with
  | Lexer.SyntaxError msg ->
    raise (LocError ((shift_back lexbuf), msg))
  | Parser.Error ->
    raise (LocError ((shift_back lexbuf), "syntax error"))

let phase = function
  | FileContent (display_name, content) ->
    let lexbuf = Lexing.from_string content in
    lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = display_name };
    let ast = parse_with_error lexbuf in
    begin match ast with
      | None -> raise (CompileError "no syntax tree was constructed")
      | Some node -> Ast node
    end
  | _ -> raise (InvalidInput "parse")