From 06ab34981c55ba90947e2a032c4337cded8fa25a Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 8 Jun 2017 10:54:46 +0100 Subject: [PATCH] Capture locations of string-with-vars generated inside jbuilder --- src/jbuild.ml | 60 +++++++++++++++++++++------------------- src/loc.ml | 12 ++++++++ src/loc.mli | 3 ++ src/string_with_vars.ml | 4 ++- src/string_with_vars.mli | 8 ++++-- src/super_context.ml | 4 +-- 6 files changed, 58 insertions(+), 33 deletions(-) diff --git a/src/jbuild.ml b/src/jbuild.ml index 295fbefb..c8ca4d04 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -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 - ; flags : String_with_vars.t list - ; modules: string list + { 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)) diff --git a/src/loc.ml b/src/loc.ml index 003a639b..57e92029 100644 --- a/src/loc.ml +++ b/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 "" let print ppf { start; stop } = diff --git a/src/loc.mli b/src/loc.mli index 76cae178..331edb0a 100644 --- a/src/loc.mli +++ b/src/loc.mli @@ -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" *) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 5e3c2501..b3e635b8 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -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 diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index c6555530..5c7ea39a 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -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 diff --git a/src/super_context.ml b/src/super_context.ml index 86437f18..25f74026 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -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