(* camlp5r *)
(* ploc.ml,v *)
(* Copyright (c) INRIA 2007-2017 *)

(* #load "pa_macro.cmo" *)

type t =
  { fname : string;
    line_nb : int;
    bol_pos : int;
    line_nb_last : int;
    bol_pos_last : int;
    bp : int;
    ep : int;
    comm : string;
    ecomm : string }
;;

let make_loc fname line_nb bol_pos (bp, ep) comm =
  {fname = fname; line_nb = line_nb; bol_pos = bol_pos;
   line_nb_last = line_nb; bol_pos_last = bol_pos; bp = bp; ep = ep;
   comm = comm; ecomm = ""}
;;

let make_unlined (bp, ep) =
  {fname = ""; line_nb = 1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
   bp = bp; ep = ep; comm = ""; ecomm = ""}
;;

let dummy =
  {fname = ""; line_nb = 1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
   bp = 0; ep = 0; comm = ""; ecomm = ""}
;;

let file_name loc = loc.fname;;
let first_pos loc = loc.bp;;
let last_pos loc = loc.ep;;
let line_nb loc = loc.line_nb;;
let bol_pos loc = loc.bol_pos;;
let line_nb_last loc = loc.line_nb_last;;
let bol_pos_last loc = loc.bol_pos_last;;
let comment loc = loc.comm;;
let comment_last loc = loc.ecomm;;

let encl loc1 loc2 =
  if loc1.bp < loc2.bp then
    if loc1.ep < loc2.ep then
      {fname = loc1.fname; line_nb = loc1.line_nb; bol_pos = loc1.bol_pos;
       line_nb_last = loc2.line_nb_last; bol_pos_last = loc2.bol_pos_last;
       bp = loc1.bp; ep = loc2.ep; comm = loc1.comm; ecomm = loc2.comm}
    else loc1
  else if loc2.ep < loc1.ep then
    {fname = loc2.fname; line_nb = loc2.line_nb; bol_pos = loc2.bol_pos;
     line_nb_last = loc1.line_nb_last; bol_pos_last = loc1.bol_pos_last;
     bp = loc2.bp; ep = loc1.ep; comm = loc2.comm; ecomm = loc1.comm}
  else loc2
;;
let shift sh loc = {loc with bp = sh + loc.bp; ep = sh + loc.ep};;
let sub loc sh len = {loc with bp = loc.bp + sh; ep = loc.bp + sh + len};;
let after loc sh len = {loc with bp = loc.ep + sh; ep = loc.ep + sh + len};;
let with_comment loc comm = {loc with comm = comm};;
let with_comment_last loc ecomm = {loc with ecomm = ecomm};;
let with_line_nb_last loc n = {loc with line_nb_last = n};;
let with_bol_pos_last loc n = {loc with bol_pos_last = n};;

let name = ref "loc";;

let from_file fname loc =
  let (bp, ep) = first_pos loc, last_pos loc in
  try
    let ic = open_in_bin fname in
    let strm = Stream.of_channel ic in
    let rec loop fname lin =
      let rec not_a_line_dir col (strm__ : _ Stream.t) =
        let cnt = Stream.count strm__ in
        match Stream.peek strm__ with
          Some c ->
            Stream.junk strm__;
            let s = strm__ in
            if cnt < bp then
              if c = '\n' then loop fname (lin + 1)
              else not_a_line_dir (col + 1) s
            else let col = col - (cnt - bp) in fname, lin, col, col + ep - bp
        | _ -> fname, lin, col, col + 1
      in
      let rec a_line_dir str n col (strm__ : _ Stream.t) =
        match Stream.peek strm__ with
          Some '\n' -> Stream.junk strm__; loop str n
        | Some _ ->
            Stream.junk strm__; let s = strm__ in a_line_dir str n (col + 1) s
        | _ -> raise Stream.Failure
      in
      let rec spaces col (strm__ : _ Stream.t) =
        match Stream.peek strm__ with
          Some ' ' -> Stream.junk strm__; let s = strm__ in spaces (col + 1) s
        | _ -> col
      in
      let rec check_string str n col (strm__ : _ Stream.t) =
        match Stream.peek strm__ with
          Some '"' ->
            Stream.junk strm__;
            let col =
              try spaces (col + 1) strm__ with
                Stream.Failure -> raise (Stream.Error "")
            in
            let s = strm__ in a_line_dir str n col s
        | Some c when c <> '\n' ->
            Stream.junk strm__;
            let s = strm__ in
            check_string (str ^ String.make 1 c) n (col + 1) s
        | _ -> not_a_line_dir col strm__
      in
      let check_quote n col (strm__ : _ Stream.t) =
        match Stream.peek strm__ with
          Some '"' ->
            Stream.junk strm__;
            let s = strm__ in check_string "" n (col + 1) s
        | _ -> not_a_line_dir col strm__
      in
      let rec check_num n col (strm__ : _ Stream.t) =
        match Stream.peek strm__ with
          Some ('0'..'9' as c) ->
            Stream.junk strm__;
            let s = strm__ in
            check_num (10 * n + Char.code c - Char.code '0') (col + 1) s
        | _ ->
            let col = spaces col strm__ in
            let s = strm__ in check_quote n col s
      in
      let begin_line (strm__ : _ Stream.t) =
        match Stream.peek strm__ with
          Some '#' ->
            Stream.junk strm__;
            let col =
              try spaces 1 strm__ with
                Stream.Failure -> raise (Stream.Error "")
            in
            let s = strm__ in check_num 0 col s
        | _ -> not_a_line_dir 0 strm__
      in
      begin_line strm
    in
    let r =
      try loop fname 1 with
        Stream.Failure ->
          let bol = bol_pos loc in fname, line_nb loc, bp - bol, ep - bol
    in
    close_in ic; r
  with Sys_error _ -> fname, 1, bp, ep
;;

let second_line fname ep0 (line, bp) ep =
  let ic = open_in fname in
  seek_in ic bp;
  let rec loop line bol p =
    if p = ep then
      begin close_in ic; if bol = bp then line, ep0 else line, ep - bol end
    else
      let (line, bol) =
        match input_char ic with
          '\n' -> line + 1, p + 1
        | _ -> line, bol
      in
      loop line bol (p + 1)
  in
  loop line bp bp
;;

let get loc =
  if loc.fname = "" || loc.fname = "-" then
    loc.line_nb, loc.bp - loc.bol_pos, loc.line_nb, loc.ep - loc.bol_pos,
    loc.ep - loc.bp
  else
    let (bl, bc, ec) =
      loc.line_nb, loc.bp - loc.bol_pos, loc.ep - loc.bol_pos
    in
    let (el, eep) = second_line loc.fname ec (bl, loc.bp) loc.ep in
    bl, bc, el, eep, ec - bc
;;

let call_with r v f a =
  let saved = !r in
  try r := v; let b = f a in r := saved; b with e -> r := saved; raise e
;;

exception Exc of t * exn;;

let raise loc exc =
  match exc with
    Exc (_, _) -> raise exc
  | _ -> raise (Exc (loc, exc))
;;

type 'a vala =
    VaAnt of string
  | VaVal of 'a
;;

let warned = ref true;;
let warning_deprecated_since_6_00 name =
  if not !warned then
    begin
      Printf.eprintf "<W> %s deprecated since version 6.00" name;
      warned := true
    end
;;

let make line_nb bol_pos (bp, ep) =
  let _ = warning_deprecated_since_6_00 "Ploc.make" in
  {fname = ""; line_nb = line_nb; bol_pos = bol_pos; line_nb_last = line_nb;
   bol_pos_last = bol_pos; bp = bp; ep = ep; comm = ""; ecomm = ""}
;;


let string_of_loc fname line bp ep =
  match Sys.os_type with
    "MacOS" ->
      Printf.sprintf "File \"%s\"; line %d; characters %d to %d\n### " fname
        line bp ep
  | _ ->
      Printf.sprintf "File \"%s\", line %d, characters %d-%d:\n" fname line bp
        ep
;;

let string_of_location
    {fname = fname; bp = bp; ep = ep; line_nb = line; bol_pos = bol} =
  string_of_loc fname line (bp - bol) (ep - bol)
;;
