Source file `ppx_here_expander.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
open Ppxlib
module Filename = Stdlib.Filename

let dirname = ref None
let set_dirname dn = dirname := dn

let () =
  Driver.add_arg
    "-dirname"
    (String (fun s -> dirname := Some s))
    ~doc:"<dir> Name of the current directory relative to the root of the project"
;;

let chop_dot_slash_prefix ~fname =
  match Base.String.chop_prefix ~prefix:"./" fname with
  | Some fname -> fname
  | None -> fname
;;

let expand_filename fname =
  match Filename.is_relative fname, !dirname with
  | true, Some dirname ->
    (* If [dirname] is given and [fname] is relative, then prepend [dirname]. *)
    Filename.concat dirname (chop_dot_slash_prefix ~fname)
  | _ -> fname
;;

let lift_position ~loc =
  let loc = { loc with loc_ghost = true } in
  let (module Builder) = Ast_builder.make loc in
  let open Builder in
  let pos = loc.Location.loc_start in
  let id = Located.lident in
  pexp_record
    [ id "Ppx_here_lib.pos_fname", estring (expand_filename pos.Lexing.pos_fname)
    ; id "pos_lnum", eint pos.Lexing.pos_lnum
    ; id "pos_cnum", eint pos.Lexing.pos_cnum
    ; id "pos_bol", eint pos.Lexing.pos_bol
    ]
    None
;;

let lift_position_as_string ~(loc : Location.t) =
  let { Lexing.pos_fname; pos_lnum; pos_cnum; pos_bol } = loc.loc_start in
  Ast_builder.Default.estring
    ~loc
    (Printf.sprintf "%s:%d:%d" (expand_filename pos_fname) pos_lnum (pos_cnum - pos_bol))
;;