Capture locations of string-with-vars generated inside jbuilder
This commit is contained in:
parent
e4300e7b51
commit
06ab34981c
|
@ -730,79 +730,83 @@ module Rule = struct
|
|||
sexp
|
||||
|
||||
let ocamllex_v1 names =
|
||||
let str s = String_with_vars.of_string s ~loc:Loc.none in
|
||||
let module S = String_with_vars in
|
||||
List.map names ~f:(fun name ->
|
||||
let src = name ^ ".mll" in
|
||||
let dst = name ^ ".ml" in
|
||||
{ targets = Static [dst]
|
||||
; deps = [File (str src)]
|
||||
; deps = [File (S.virt_text __POS__ src)]
|
||||
; action =
|
||||
Chdir
|
||||
(str "${ROOT}",
|
||||
Run (str "${bin:ocamllex}",
|
||||
[str "-q"; str "-o"; str "${@}"; str "${<}"]))
|
||||
(S.virt_var __POS__ "ROOT",
|
||||
Run (S.virt_text __POS__ "ocamllex",
|
||||
[ S.virt_text __POS__ "-q"
|
||||
; S.virt_text __POS__ "-o"
|
||||
; S.virt_var __POS__ "@"
|
||||
; S.virt_var __POS__"<"
|
||||
]))
|
||||
})
|
||||
|
||||
let ocamlyacc_v1 names =
|
||||
let str s = String_with_vars.of_string s ~loc:Loc.none in
|
||||
let module S = String_with_vars in
|
||||
List.map names ~f:(fun name ->
|
||||
let src = name ^ ".mly" in
|
||||
{ targets = Static [name ^ ".ml"; name ^ ".mli"]
|
||||
; deps = [File (str src)]
|
||||
; deps = [File (S.virt_text __POS__ src)]
|
||||
; action =
|
||||
Chdir
|
||||
(str "${ROOT}",
|
||||
Run (str "${bin:ocamlyacc}",
|
||||
[str "${<}"]))
|
||||
(S.virt_var __POS__ "ROOT",
|
||||
Run (S.virt_text __POS__ "ocamlyacc",
|
||||
[S.virt_var __POS__ "<"]))
|
||||
})
|
||||
end
|
||||
|
||||
module Menhir = struct
|
||||
type t =
|
||||
{ base : string option
|
||||
{ merge_into : string option
|
||||
; flags : String_with_vars.t list
|
||||
; modules : string list
|
||||
}
|
||||
|
||||
let v1 =
|
||||
record
|
||||
(field_o "merge_into" string >>= fun base ->
|
||||
(field_o "merge_into" string >>= fun merge_into ->
|
||||
field "flags" (list String_with_vars.t) ~default:[] >>= fun flags ->
|
||||
field "modules" (list string) >>= fun modules ->
|
||||
return
|
||||
{ base
|
||||
{ merge_into
|
||||
; flags
|
||||
; modules
|
||||
}
|
||||
)
|
||||
|
||||
let v1_to_rule t =
|
||||
let str s = String_with_vars.of_string s ~loc:Loc.none in
|
||||
let module S = String_with_vars in
|
||||
let targets n = [n ^ ".ml"; n ^ ".mli"] in
|
||||
match t.base with
|
||||
match t.merge_into with
|
||||
| None ->
|
||||
List.map t.modules ~f:(fun name ->
|
||||
let src = name ^ ".mly" in
|
||||
{ Rule.
|
||||
targets = Static (targets name)
|
||||
; deps = [Dep_conf.File (str src)]
|
||||
; deps = [Dep_conf.File (S.virt_text __POS__ src)]
|
||||
; action =
|
||||
Chdir
|
||||
(str "${ROOT}",
|
||||
Run (str "${bin:menhir}",
|
||||
t.flags @ [str "${<}"]))
|
||||
(S.virt_var __POS__ "ROOT",
|
||||
Run (S.virt_text __POS__ "menhir",
|
||||
t.flags @ [S.virt_var __POS__ "<"]))
|
||||
})
|
||||
| Some base ->
|
||||
let mly m = str (m ^ ".mly") in
|
||||
| Some merge_into ->
|
||||
let mly m = S.virt_text __POS__ (m ^ ".mly") in
|
||||
[{ Rule.
|
||||
targets = Static (targets base)
|
||||
targets = Static (targets merge_into)
|
||||
; deps = List.map ~f:(fun m -> Dep_conf.File (mly m)) t.modules
|
||||
; action =
|
||||
Chdir
|
||||
(str "${ROOT}",
|
||||
Run (str "${bin:menhir}",
|
||||
[ str "--base"
|
||||
; str base
|
||||
(S.virt_var __POS__ "ROOT",
|
||||
Run (S.virt_text __POS__ "menhir",
|
||||
[ S.virt_text __POS__ "--base"
|
||||
; S.virt_text __POS__ merge_into
|
||||
]
|
||||
@ t.flags
|
||||
@ (List.map ~f:mly t.modules))
|
||||
|
|
12
src/loc.ml
12
src/loc.ml
|
@ -37,6 +37,18 @@ let in_file fn =
|
|||
; stop = pos
|
||||
}
|
||||
|
||||
let of_pos (fname, lnum, cnum, enum) =
|
||||
let pos : Lexing.position =
|
||||
{ pos_fname = fname
|
||||
; pos_lnum = lnum
|
||||
; pos_cnum = cnum
|
||||
; pos_bol = 0
|
||||
}
|
||||
in
|
||||
{ start = pos
|
||||
; stop = { pos with pos_cnum = enum }
|
||||
}
|
||||
|
||||
let none = in_file "<none>"
|
||||
|
||||
let print ppf { start; stop } =
|
||||
|
|
|
@ -12,6 +12,9 @@ val fail_lex : Lexing.lexbuf -> ('a, Format.formatter, unit, 'b) format4 -> 'a
|
|||
|
||||
val in_file : string -> t
|
||||
|
||||
(** To be used with [__POS__] *)
|
||||
val of_pos : (string * int * int * int) -> t
|
||||
|
||||
val none : t
|
||||
|
||||
(** Prints "File ..., line ..., characters ...:\n" *)
|
||||
|
|
|
@ -65,7 +65,9 @@ let t sexp = of_string ~loc:(Sexp.Ast.loc sexp) (Sexp.Of_sexp.string sexp)
|
|||
|
||||
let loc t = t.loc
|
||||
|
||||
let raw ~loc s = { loc; items = [Text s]}
|
||||
let virt pos s = of_string ~loc:(Loc.of_pos pos) s
|
||||
let virt_var pos s = { loc = Loc.of_pos pos; items = [Var (Braces, s)] }
|
||||
let virt_text pos s = { loc = Loc.of_pos pos; items = [Text s] }
|
||||
|
||||
let just_a_var t =
|
||||
match t.items with
|
||||
|
|
|
@ -11,9 +11,13 @@ val sexp_of_t : t -> Sexp.t
|
|||
|
||||
val loc : t -> Loc.t
|
||||
|
||||
val of_string : loc:Loc.t -> string -> t
|
||||
val to_string : t -> string
|
||||
val raw : loc:Loc.t -> string -> t
|
||||
|
||||
(** [t] generated by the OCaml code. The first argument should be [__POS__]. The second is
|
||||
either a string to parse, a variable name or plain text. *)
|
||||
val virt : (string * int * int * int) -> string -> t
|
||||
val virt_var : (string * int * int * int) -> string -> t
|
||||
val virt_text : (string * int * int * int) -> string -> t
|
||||
|
||||
val just_a_var : t -> string option
|
||||
|
||||
|
|
|
@ -818,8 +818,8 @@ module PP = struct
|
|||
Hashtbl.add sctx.ppx_drivers ~key ~data:exe;
|
||||
exe
|
||||
|
||||
let target_var = String_with_vars.of_string "${@}" ~loc:Loc.none
|
||||
let root_var = String_with_vars.of_string "${ROOT}" ~loc:Loc.none
|
||||
let target_var = String_with_vars.virt_var __POS__ "@"
|
||||
let root_var = String_with_vars.virt_var __POS__ "ROOT"
|
||||
|
||||
let cookie_library_name lib_name =
|
||||
match lib_name with
|
||||
|
|
Loading…
Reference in New Issue