2019-05-13 00:46:25 +04:00
|
|
|
(* type file_location = { *)
|
|
|
|
(* filename : string ; *)
|
|
|
|
(* start_line : int ; *)
|
|
|
|
(* start_column : int ; *)
|
|
|
|
(* end_line : int ; *)
|
|
|
|
(* end_column : int ; *)
|
|
|
|
(* } *)
|
|
|
|
|
|
|
|
type virtual_location = string
|
|
|
|
|
|
|
|
type t =
|
|
|
|
| File of Region.t (* file_location *)
|
|
|
|
| Virtual of virtual_location
|
|
|
|
|
|
|
|
let make (start_pos:Lexing.position) (end_pos:Lexing.position) : t =
|
|
|
|
(* TODO: give correct unicode offsets (the random number is here so
|
|
|
|
that searching for wrong souce locations appearing in messages
|
|
|
|
will quickly lead here *)
|
|
|
|
File (Region.make
|
|
|
|
~start:(Pos.make ~byte:start_pos ~point_num:(-1897000) ~point_bol:(-1897000))
|
|
|
|
~stop:(Pos.make ~byte:end_pos ~point_num:(-1897000) ~point_bol:(-1897000)))
|
|
|
|
|
|
|
|
let virtual_location s = Virtual s
|
|
|
|
let dummy = virtual_location "dummy"
|
2019-05-28 19:36:14 +04:00
|
|
|
let generated = virtual_location "generated"
|
2019-05-13 00:46:25 +04:00
|
|
|
|
|
|
|
type 'a wrap = {
|
|
|
|
wrap_content : 'a ;
|
|
|
|
location : t ;
|
|
|
|
}
|
|
|
|
|
2019-05-28 19:36:14 +04:00
|
|
|
let wrap ?(loc = generated) wrap_content = { wrap_content ; location = loc }
|
2019-05-28 21:02:40 +04:00
|
|
|
let get_location x = x.location
|
2019-05-13 00:46:25 +04:00
|
|
|
let unwrap { wrap_content ; _ } = wrap_content
|
|
|
|
let map f x = { x with wrap_content = f x.wrap_content }
|
|
|
|
let pp_wrap f ppf { wrap_content ; _ } = Format.fprintf ppf "%a" f wrap_content
|
|
|
|
|
|
|
|
let lift_region : 'a Region.reg -> 'a wrap = fun x ->
|
|
|
|
wrap ~loc:(File x.region) x.value
|
2019-05-28 19:36:14 +04:00
|
|
|
let lift : Region.region -> t = fun x -> File x
|
|
|
|
|
|
|
|
let r_extract : 'a Region.reg -> t = fun x -> File x.region
|
|
|
|
let r_split : 'a Region.reg -> ('a * t) = fun x -> x.value , File x.region
|