Merge pull request #462 from rgrinberg/scope-ppx-bug-new-scopes
Fix scoping related ppx bug
This commit is contained in:
commit
a80d70aa26
|
@ -862,7 +862,7 @@ Add it to your jbuild file to remove this warning.
|
|||
{ m with source_dirs =
|
||||
Path.Set.add (Path.relative src_dir ".") m.source_dirs
|
||||
})
|
||||
|> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir);
|
||||
|> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir ~scope);
|
||||
Option.iter (Utop.exe_stanzas stanzas) ~f:(fun (exe, all_modules) ->
|
||||
let dir = Utop.utop_exe_dir ~dir:ctx_dir in
|
||||
let merlin = executables_rules exe ~dir ~all_modules ~scope in
|
||||
|
@ -1003,7 +1003,8 @@ Add it to your jbuild file to remove this warning.
|
|||
else
|
||||
pps
|
||||
in
|
||||
let ppx_exe = SC.PP.get_ppx_driver sctx pps in
|
||||
let scope = Lib_db.find_scope' (SC.libs sctx) ~dir in
|
||||
let ppx_exe = SC.PP.get_ppx_driver sctx ~scope pps in
|
||||
[ppx_exe]
|
||||
in
|
||||
List.concat
|
||||
|
|
|
@ -101,3 +101,7 @@ let remove_dups_preserve_order libs =
|
|||
in
|
||||
loop String_set.empty libs []
|
||||
;;
|
||||
|
||||
let public_name = function
|
||||
| External pkg -> Some pkg.name
|
||||
| Internal (_, lib) -> Option.map lib.public ~f:(fun p -> p.name)
|
||||
|
|
|
@ -33,3 +33,5 @@ val remove_dups_preserve_order : t list -> t list
|
|||
|
||||
(*val ppx_runtime_libraries : t list -> String_set.t
|
||||
*)
|
||||
|
||||
val public_name : t -> string option
|
||||
|
|
|
@ -17,6 +17,7 @@ type t =
|
|||
instalable_internal_libs : Lib.Internal.t String_map.t
|
||||
; local_public_libs : Path.t String_map.t
|
||||
; anonymous_root : Path.t
|
||||
; by_scope_name : (string, scope) Hashtbl.t
|
||||
}
|
||||
|
||||
let rec internal_name_scope t ~dir =
|
||||
|
@ -144,6 +145,9 @@ module Scope = struct
|
|||
Some { dst_fn = result_fn; src_fn })
|
||||
|
||||
let root t = t.scope.scope.root
|
||||
let name t =
|
||||
Option.value ~default:"" t.scope.scope.name
|
||||
|
||||
let resolve t =
|
||||
(* TODO do something with required_by here *)
|
||||
Jbuild.Scope.resolve t.data.scope.scope
|
||||
|
@ -273,15 +277,22 @@ let create findlib ~scopes ~root internal_libraries =
|
|||
; instalable_internal_libs = String_map.empty
|
||||
; local_public_libs
|
||||
; anonymous_root = root
|
||||
; by_scope_name = Hashtbl.create 1024
|
||||
}
|
||||
in
|
||||
(* Initializes the scopes, including [Path.root] so that when there are no <pkg>.opam
|
||||
files in parent directories, the scope is the whole workspace. *)
|
||||
List.iter scopes ~f:(fun (scope : Jbuild.Scope.t) ->
|
||||
Hashtbl.add t.by_internal_name ~key:scope.root
|
||||
~data:{ libs = String_map.empty
|
||||
; scope
|
||||
});
|
||||
let lib_scope = { libs = String_map.empty; scope } in
|
||||
Option.iter scope.name ~f:(fun name ->
|
||||
assert (name <> "");
|
||||
assert (not (Hashtbl.mem t.by_scope_name name));
|
||||
Hashtbl.add t.by_scope_name ~key:name ~data:lib_scope;
|
||||
);
|
||||
Hashtbl.add t.by_internal_name ~key:scope.root ~data:lib_scope
|
||||
);
|
||||
let anon_scope = internal_name_scope t ~dir:t.anonymous_root in
|
||||
Hashtbl.add t.by_scope_name ~key:"" ~data:anon_scope;
|
||||
List.iter internal_libraries ~f:(fun ((dir, lib) as internal) ->
|
||||
let scope = internal_name_scope t ~dir in
|
||||
scope.libs <- String_map.add scope.libs ~key:lib.Library.name ~data:internal;
|
||||
|
@ -326,3 +337,8 @@ let anonymous_scope t =
|
|||
lib_db = t
|
||||
; scope = internal_name_scope t ~dir:t.anonymous_root
|
||||
}
|
||||
|
||||
let find_scope_by_name_exn t ~name =
|
||||
match Hashtbl.find t.by_scope_name name with
|
||||
| None -> die "Invalid scope '%s'" name
|
||||
| Some scope -> { Scope.scope ; lib_db = t }
|
||||
|
|
|
@ -34,6 +34,7 @@ module Scope : sig
|
|||
val lib_is_available : t with_required_by -> string -> bool
|
||||
|
||||
val root : t -> Path.t
|
||||
val name : t -> string
|
||||
|
||||
val resolve : t with_required_by -> string -> (Package.t, string) result
|
||||
|
||||
|
@ -87,3 +88,7 @@ val anonymous_scope : t -> Scope.t
|
|||
|
||||
(** Contains only publicly, and external (findlib) libraries *)
|
||||
val external_scope : t -> Scope.t
|
||||
|
||||
(** Find scope by the their explicit names (opam package names) [""] corresponds
|
||||
to the anonymous scope *)
|
||||
val find_scope_by_name_exn : t -> name:string -> Scope.t
|
||||
|
|
|
@ -12,12 +12,12 @@ type t =
|
|||
; source_dirs: Path.Set.t
|
||||
}
|
||||
|
||||
let ppx_flags sctx ~dir:_ ~src_dir:_ { preprocess; libname; _ } =
|
||||
let ppx_flags sctx ~dir:_ ~scope ~src_dir:_ { preprocess; libname; _ } =
|
||||
match preprocess with
|
||||
| Pps { pps; flags } ->
|
||||
let exe = SC.PP.get_ppx_driver sctx pps in
|
||||
let exe = SC.PP.get_ppx_driver sctx ~scope pps in
|
||||
let command =
|
||||
List.map (Path.to_absolute_filename exe
|
||||
List.map (Path.to_absolute_filename exe
|
||||
:: "--as-ppx"
|
||||
:: SC.PP.cookie_library_name libname
|
||||
@ flags)
|
||||
|
@ -27,7 +27,7 @@ let ppx_flags sctx ~dir:_ ~src_dir:_ { preprocess; libname; _ } =
|
|||
[sprintf "FLG -ppx %s" (Filename.quote command)]
|
||||
| _ -> []
|
||||
|
||||
let dot_merlin sctx ~dir ({ requires; flags; _ } as t) =
|
||||
let dot_merlin sctx ~dir ~scope ({ requires; flags; _ } as t) =
|
||||
match Path.drop_build_context dir with
|
||||
| Some remaindir ->
|
||||
let merlin_file = Path.relative dir ".merlin" in
|
||||
|
@ -46,7 +46,7 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) =
|
|||
SC.add_rule sctx ~mode:Promote_but_delete_on_clean (
|
||||
requires &&& flags
|
||||
>>^ (fun (libs, flags) ->
|
||||
let ppx_flags = ppx_flags sctx ~dir ~src_dir:remaindir t in
|
||||
let ppx_flags = ppx_flags sctx ~dir ~scope ~src_dir:remaindir t in
|
||||
let internals, externals =
|
||||
List.fold_left libs ~init:([], []) ~f:(fun (internals, externals) ->
|
||||
function
|
||||
|
@ -117,6 +117,6 @@ let merge_all = function
|
|||
| [] -> None
|
||||
| init::ts -> Some (List.fold_left ~init ~f:merge_two ts)
|
||||
|
||||
let add_rules sctx ~dir merlin =
|
||||
let add_rules sctx ~dir ~scope merlin =
|
||||
if (SC.context sctx).merlin then
|
||||
dot_merlin sctx ~dir merlin
|
||||
dot_merlin sctx ~dir ~scope merlin
|
||||
|
|
|
@ -11,5 +11,10 @@ type t =
|
|||
val merge_all : t list -> t option
|
||||
|
||||
(** Add rules for generating the .merlin in a directory *)
|
||||
val add_rules : Super_context.t -> dir:Path.t -> t -> unit
|
||||
val add_rules
|
||||
: Super_context.t
|
||||
-> dir:Path.t
|
||||
-> scope:Lib_db.Scope.t Lib_db.with_required_by
|
||||
-> t
|
||||
-> unit
|
||||
|
||||
|
|
|
@ -853,6 +853,12 @@ module PP = struct
|
|||
| [key] ->
|
||||
let ppx_dir = Path.relative sctx.ppx_dir key in
|
||||
let exe = Path.relative ppx_dir "ppx.exe" in
|
||||
let (key, scope) =
|
||||
match String.rsplit2 key ~on:'@' with
|
||||
| None ->
|
||||
(key, Libs.external_scope sctx)
|
||||
| Some (key, scope) ->
|
||||
(key, Lib_db.find_scope_by_name_exn sctx.libs ~name:scope) in
|
||||
let names =
|
||||
match key with
|
||||
| "+none+" -> []
|
||||
|
@ -866,27 +872,57 @@ module PP = struct
|
|||
in
|
||||
let scope =
|
||||
{ Lib_db.
|
||||
data = Lib_db.anonymous_scope sctx.libs
|
||||
data = scope
|
||||
; required_by = [sprintf "required by (pps (%s))"
|
||||
(String.concat names ~sep:", ")]
|
||||
} in
|
||||
build_ppx_driver sctx names ~scope ~dep_kind:Required ~target:exe ~driver
|
||||
| _ -> ()
|
||||
|
||||
let get_ppx_driver sctx pps =
|
||||
let names =
|
||||
let get_ppx_driver sctx ~scope pps =
|
||||
let (driver, names) =
|
||||
match List.rev_map pps ~f:Pp.to_string with
|
||||
| [] -> []
|
||||
| driver :: rest ->
|
||||
List.sort rest ~cmp:String.compare @ [driver]
|
||||
| [] -> (None, [])
|
||||
| driver :: rest -> (Some driver, rest)
|
||||
in
|
||||
let sctx = host_sctx sctx in
|
||||
let public_name name =
|
||||
match Lib_db.Scope.find scope name with
|
||||
| None -> Some name (* XXX unknown but assume it's public *)
|
||||
| Some lib -> Lib.public_name lib in
|
||||
let (driver_private, driver) =
|
||||
match driver with
|
||||
| None -> (false, None)
|
||||
| Some driver ->
|
||||
begin match public_name driver with
|
||||
| None -> (true, Some driver)
|
||||
| Some driver -> (false, Some driver)
|
||||
end in
|
||||
let (libs, has_private_libs) =
|
||||
List.fold_left ~f:(fun (libs, has_private_libs) lib ->
|
||||
match public_name lib with
|
||||
| None -> (lib :: libs, true)
|
||||
| Some pub_name -> (pub_name :: libs, has_private_libs)
|
||||
) ~init:([], driver_private) names in
|
||||
let libs = List.sort ~cmp:String.compare libs in
|
||||
let names =
|
||||
match driver with
|
||||
| None -> libs
|
||||
| Some driver -> libs @ [driver] in
|
||||
let key =
|
||||
match names with
|
||||
| [] -> "+none+"
|
||||
| _ -> String.concat names ~sep:"+"
|
||||
in
|
||||
let sctx = host_sctx sctx in
|
||||
let ppx_dir = Path.relative sctx.ppx_dir key in
|
||||
let ppx_dir =
|
||||
Path.relative sctx.ppx_dir (
|
||||
if has_private_libs then (
|
||||
sprintf "%s@%s" key (Lib_db.Scope.name scope.data)
|
||||
) else (
|
||||
key
|
||||
)
|
||||
) in
|
||||
Path.relative ppx_dir "ppx.exe"
|
||||
|
||||
let target_var = String_with_vars.virt_var __POS__ "@"
|
||||
|
@ -971,7 +1007,7 @@ module PP = struct
|
|||
~scope)
|
||||
)
|
||||
| Pps { pps; flags } ->
|
||||
let ppx_exe = get_ppx_driver sctx pps in
|
||||
let ppx_exe = get_ppx_driver sctx ~scope pps in
|
||||
Module.iter ast ~f:(fun kind src ->
|
||||
let src_path = Path.relative dir src.name in
|
||||
let args =
|
||||
|
@ -1035,7 +1071,7 @@ module PP = struct
|
|||
lint_module ~ast ~source:m;
|
||||
ast
|
||||
| Pps { pps; flags } ->
|
||||
let ppx_exe = get_ppx_driver sctx pps in
|
||||
let ppx_exe = get_ppx_driver sctx ~scope pps in
|
||||
let ast = setup_reason_rules sctx ~dir m in
|
||||
lint_module ~ast ~source:m;
|
||||
let uses_ppx_driver = uses_ppx_driver ~pps in
|
||||
|
|
|
@ -216,7 +216,11 @@ module PP : sig
|
|||
-> Module.t String_map.t
|
||||
|
||||
(** Get a path to a cached ppx driver *)
|
||||
val get_ppx_driver : t -> Pp.t list -> Path.t
|
||||
val get_ppx_driver
|
||||
: t
|
||||
-> scope:Lib_db.Scope.t Lib_db.with_required_by
|
||||
-> Pp.t list
|
||||
-> Path.t
|
||||
|
||||
(** [cookie_library_name lib_name] is ["--cookie"; lib_name] if [lib_name] is not
|
||||
[None] *)
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
ocamlc ppx/fooppx.{cmi,cmo,cmt}
|
||||
ocamlopt ppx/fooppx.{cmx,o}
|
||||
ocamlopt ppx/fooppx.{a,cmxa}
|
||||
ocamlopt .ppx/fooppx/ppx.exe
|
||||
ocamlopt .ppx/fooppx@/ppx.exe
|
||||
ppx w_omp_driver.pp.ml
|
||||
ocamldep w_omp_driver.depends.ocamldep-output
|
||||
ocamlc w_omp_driver.{cmi,cmo,cmt}
|
||||
|
|
|
@ -1,5 +1,22 @@
|
|||
$ $JBUILDER build -j1 --root . @install
|
||||
Error: External library "a_kernel" not found.
|
||||
-> required by "required by (pps (a_kernel))"
|
||||
Hint: try: jbuilder external-lib-deps --missing --root . @install
|
||||
[1]
|
||||
ocamldep a/ppx/a.depends.ocamldep-output
|
||||
ocamlc a/ppx/a.{cmi,cmo,cmt}
|
||||
ocamldep a/kernel/a_kernel.depends.ocamldep-output
|
||||
ocamlc a/kernel/a_kernel.{cmi,cmo,cmt}
|
||||
ocamlopt a/ppx/a.{cmx,o}
|
||||
ocamlc a/ppx/a.cma
|
||||
ocamlopt a/kernel/a_kernel.{cmx,o}
|
||||
ocamlc a/kernel/a_kernel.cma
|
||||
ocamlopt a/ppx/a.{a,cmxa}
|
||||
ocamlopt a/kernel/a_kernel.{a,cmxa}
|
||||
ocamlopt a/ppx/a.cmxs
|
||||
ocamlopt a/kernel/a_kernel.cmxs
|
||||
ocamlopt .ppx/a.kernel/ppx.exe
|
||||
ocamlopt .ppx/a/ppx.exe
|
||||
ppx b/b.pp.ml
|
||||
ocamldep b/b.depends.ocamldep-output
|
||||
ocamlc b/b.{cmi,cmo,cmt}
|
||||
ocamlopt b/b.{cmx,o}
|
||||
ocamlc b/b.cma
|
||||
ocamlopt b/b.{a,cmxa}
|
||||
ocamlopt b/b.cmxs
|
||||
|
|
Loading…
Reference in New Issue