matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Update the code to talk about scopes

This commit is contained in:
Jeremie Dimino 2017-06-05 13:42:13 +01:00
parent 2be5e593d6
commit 11985e3948
11 changed files with 93 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGES.md
View File

@ -18,6 +18,8 @@
- Deprecate `copy-and-add-line-directive` and rename it `copy#`
- Properly define and implement scopes
- Inside user actions, `${^}` now includes files matches by
`(glob_files ...)` or `(file_recursively_in ...)`

28
src/gen_rules.ml
View File

@ -155,7 +155,7 @@ module Gen(P : Params) = struct
let alias_module_build_sandbox = Scanf.sscanf ctx.version "%u.%u"
(fun a b -> a, b) <= (4, 02)
let library_rules (lib : Library.t) ~dir ~all_modules ~files ~package_context =
let library_rules (lib : Library.t) ~dir ~all_modules ~files ~scope =
let dep_kind = if lib.optional then Build.Optional else Required in
let flags = Ocaml_flags.make lib.buildable in
let modules =
@ -204,7 +204,7 @@ module Gen(P : Params) = struct
SC.PP.pped_modules sctx ~dir ~dep_kind ~modules ~preprocess:lib.buildable.preprocess
~preprocessor_deps:lib.buildable.preprocessor_deps
~lib_name:(Some lib.name)
~package_context
~scope
in
let modules =
match alias_module with
@ -415,7 +415,7 @@ module Gen(P : Params) = struct
let rules = Js_of_ocaml_rules.build_exe sctx ~dir ~js_of_ocaml ~src:exe in
SC.add_rules sctx (List.map rules ~f:(fun r -> libs_and_cm >>> r))
let executables_rules (exes : Executables.t) ~dir ~all_modules ~package_context =
let executables_rules (exes : Executables.t) ~dir ~all_modules ~scope =
let dep_kind = Build.Required in
let flags = Ocaml_flags.make exes.buildable in
let modules =
@ -434,7 +434,7 @@ module Gen(P : Params) = struct
~preprocess:exes.buildable.preprocess
~preprocessor_deps:exes.buildable.preprocessor_deps
~lib_name:None
~package_context
~scope
in
let item = List.hd exes.names in
let dep_graph = Ocamldep.rules sctx ~dir ~item ~modules ~alias_module:None in
@ -470,7 +470,7 @@ module Gen(P : Params) = struct
| User rules |
+-----------------------------------------------------------------+ *)
let user_rule (rule : Rule.t) ~dir ~package_context =
let user_rule (rule : Rule.t) ~dir ~scope =
let targets : SC.Action.targets =
match rule.targets with
| Infer -> Infer
@ -485,9 +485,9 @@ module Gen(P : Params) = struct
~dir
~dep_kind:Required
~targets
~package_context)
~scope)
let alias_rules (alias_conf : Alias_conf.t) ~dir ~package_context =
let alias_rules (alias_conf : Alias_conf.t) ~dir ~scope =
let digest =
let deps =
Sexp.To_sexp.list Dep_conf.sexp_of_t alias_conf.deps in
@ -520,7 +520,7 @@ module Gen(P : Params) = struct
~dir
~dep_kind:Required
~targets:(Static [])
~package_context
~scope
; Build.create_file digest_path
])
@ -608,7 +608,7 @@ Add it to your jbuild file to remove this warning.
~dir
~dep_kind:Required
~targets:Infer
~package_context:Pkgs.empty);
~scope:Scope.empty);
{ intf with name = impl_fname } in
String_map.merge impls intfs ~f:(fun name impl intf ->
let impl =
@ -626,14 +626,14 @@ Add it to your jbuild file to remove this warning.
| Stanza |
+-----------------------------------------------------------------+ *)
let rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; pkgs = package_context } =
let rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope } =
(* Interpret user rules and other simple stanzas first in order to populate the known
target table, which is needed for guessing the list of modules. *)
List.iter stanzas ~f:(fun stanza ->
let dir = ctx_dir in
match (stanza : Stanza.t) with
| Rule rule -> user_rule rule ~dir ~package_context
| Alias alias -> alias_rules alias ~dir ~package_context
| Rule rule -> user_rule rule ~dir ~scope
| Alias alias -> alias_rules alias ~dir ~scope
| Library _ | Executables _ | Provides _ | Install _ -> ());
let files = lazy (
let files = SC.sources_and_targets_known_so_far sctx ~src_path:src_dir in
@ -658,10 +658,10 @@ Add it to your jbuild file to remove this warning.
| Library lib ->
Some (library_rules lib ~dir
~all_modules:(Lazy.force all_modules) ~files:(Lazy.force files)
~package_context)
~scope)
| Executables exes ->
Some (executables_rules exes ~dir ~all_modules:(Lazy.force all_modules)
~package_context)
~scope)
| _ -> None)
|> Merlin.add_rules sctx ~dir:ctx_dir

2
src/gen_rules.mli
View File

@ -8,4 +8,4 @@ val gen
-> Jbuild_load.conf
-> (Build_interpret.Rule.t list *
(* Evaluated jbuilds per context names *)
(Path.t * Pkgs.t * Stanzas.t) list String_map.t) Future.t
(Path.t * Scope.t * Stanzas.t) list String_map.t) Future.t

62
src/jbuild.ml
View File

@ -63,17 +63,30 @@ let file_in_current_dir sexp =
of_sexp_error sexp "file in current directory expected";
fn
module Pkgs = struct
module Scope = struct
type t =
{ visible_packages : Package.t String_map.t
; closest_packages : Package.t list
{ name : string option
; packages : Package.t String_map.t
}
let empty =
{ visible_packages = String_map.empty
; closest_packages = []
{ name = None
; packages = String_map.empty
}
let make = function
| [] -> empty
| pkg :: rest as pkgs ->
let name =
List.fold_left rest ~init:pkg.Package.name ~f:(fun acc pkg ->
min acc pkg.Package.name)
in
{ name = Some name
; packages =
String_map.of_alist_exn (List.map pkgs ~f:(fun pkg ->
pkg.Package.name, pkg))
}
let package_listing packages =
let longest_pkg = List.longest_map packages ~f:(fun p -> p.Package.name) in
String.concat ~sep:"\n"
@ -82,11 +95,11 @@ module Pkgs = struct
(Path.to_string (Path.relative pkg.path (pkg.name ^ ".opam")))))
let default t =
match t.closest_packages with
match String_map.values t.packages with
| [pkg] -> Ok pkg
| [] ->
Error
"no packages are defined here.\n\
"The current scope defines no packages.\n\
What do you want me to do with this (install ...) stanzas?.\n\
You need to add a <package>.opam file at the root \
of your project so that\n\
@ -98,28 +111,29 @@ module Pkgs = struct
stanza is for. I have the choice between these ones:\n\
%s\n\
You need to add a (package ...) field in this (install ...) stanza"
(package_listing t.closest_packages))
(package_listing (String_map.values t.packages)))
let resolve t name =
match String_map.find name t.visible_packages with
match String_map.find name t.packages with
| Some pkg ->
Ok pkg
| None ->
if String_map.is_empty t.visible_packages then
if String_map.is_empty t.packages then
Error (sprintf
"package %S is not visible here.\n\
In fact I know of no packages here, \
in order for me to know that package\n\
%S exist, you need to add a %S file at the root of your project."
name name (name ^ ".opam"))
"You cannot declare items to be installed without \
adding a <package>.opam file at the root of your project.\n\
To declare elements to be installed as part of package %S, \
add a %S file at the root of your project."
name (name ^ ".opam"))
else
Error (sprintf
"package %S is not visible here.\n\
The only packages I know of in this directory are:\n\
"The current scope doesn't define package %S.\n\
The only packages for which you can declare \
elements to be installed in this directory are:\n\
%s%s"
name
(package_listing (String_map.values t.visible_packages))
(hint name (String_map.keys t.visible_packages)))
(package_listing (String_map.values t.packages))
(hint name (String_map.keys t.packages)))
let package t sexp =
match resolve t (string sexp) with
@ -477,7 +491,7 @@ module Public_lib = struct
match String.split s ~on:'.' with
| [] -> assert false
| pkg :: rest ->
match Pkgs.resolve pkgs pkg with
match Scope.resolve pkgs pkg with
| Ok pkg ->
Ok (Some
{ package = pkg
@ -604,7 +618,7 @@ module Install_conf = struct
record
(field "section" Install.Section.t >>= fun section ->
field "files" (list file) >>= fun files ->
Pkgs.package_field pkgs >>= fun package ->
Scope.package_field pkgs >>= fun package ->
return
{ section
; files
@ -658,7 +672,7 @@ module Executables = struct
(if multi then "s" else "");
return (t, None))
| files ->
Pkgs.package_field pkgs >>= fun package ->
Scope.package_field pkgs >>= fun package ->
return (t, Some { Install_conf. section = Bin; files; package })
let public_name sexp =
@ -831,7 +845,7 @@ module Alias_conf = struct
record
(field "name" string >>= fun name ->
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
field_o "package" (Pkgs.package pkgs) >>= fun package ->
field_o "package" (Scope.package pkgs) >>= fun package ->
field_o "action" Action.Unexpanded.t >>= fun action ->
return
{ name
@ -872,7 +886,7 @@ module Stanza = struct
; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
]
let select : Jbuild_version.t -> Pkgs.t -> t list Sexp.Of_sexp.t = function
let select : Jbuild_version.t -> Scope.t -> t list Sexp.Of_sexp.t = function
| V1 -> v1
end

12
src/jbuild.mli
View File

@ -9,13 +9,15 @@ module Jbuild_version : sig
val latest_stable : t
end
(** Packages visible in a given directory *)
module Pkgs : sig
module Scope : sig
type t =
{ visible_packages : Package.t String_map.t
; closest_packages : Package.t list
{ name : string option (** First package name in alphabetical order. [None] for
the global scope. *)
; packages : Package.t String_map.t
}
val make : Package.t list -> t
val empty : t
val resolve : t -> string -> (Package.t, string) result
@ -216,6 +218,6 @@ end
module Stanzas : sig
type t = Stanza.t list
val parse : Pkgs.t -> Sexp.Ast.t list -> t
val parse : Scope.t -> Sexp.Ast.t list -> t
val lib_names : (_ * _ * t) list -> String_set.t
end

37
src/jbuild_load.ml
View File

@ -3,12 +3,12 @@ open Jbuild
module Jbuilds = struct
type script =
{ dir : Path.t
; pkgs : Pkgs.t
{ dir : Path.t
; scope : Scope.t
}
type one =
| Literal of (Path.t * Pkgs.t * Stanza.t list)
| Literal of (Path.t * Scope.t * Stanza.t list)
| Script of script
type t = one list
@ -66,7 +66,7 @@ end
let open Future in
List.map jbuilds ~f:(function
| Literal x -> return x
| Script { dir; pkgs = pkgs_ctx } ->
| Script { dir; scope } ->
let file = Path.relative dir "jbuild" in
let generated_jbuild =
Path.append (Path.relative generated_jbuilds_dir context.name) file
@ -118,7 +118,7 @@ end
Did you forgot to call [Jbuild_plugin.V*.send]?"
(Path.to_string file);
let sexps = Sexp_lexer.Load.many (Path.to_string generated_jbuild) in
return (dir, pkgs_ctx, Stanzas.parse pkgs_ctx sexps))
return (dir, scope, Stanzas.parse scope sexps))
|> Future.all
end
@ -129,14 +129,13 @@ type conf =
; packages : Package.t String_map.t
}
let load ~dir ~visible_packages ~closest_packages =
let load ~dir ~scope =
let file = Path.relative dir "jbuild" in
let pkgs = { Pkgs. visible_packages; closest_packages } in
match Sexp_lexer.Load.many_or_ocaml_script (Path.to_string file) with
| Sexps sexps ->
Jbuilds.Literal (dir, pkgs, Stanzas.parse pkgs sexps)
Jbuilds.Literal (dir, scope, Stanzas.parse scope sexps)
| Ocaml_script ->
Script { dir; pkgs }
Script { dir; scope }
let load ?(extra_ignored_subtrees=Path.Set.empty) () =
let ftree = File_tree.load Path.root in
@ -186,26 +185,20 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () =
(List.map pkgs ~f:(fun pkg ->
sprintf "- %s.opam" (Path.to_string pkg.Package.path)))))
in
let packages_per_dir =
let scopes =
String_map.values packages
|> List.map ~f:(fun pkg -> (pkg.Package.path, pkg))
|> Path.Map.of_alist_multi
|> Path.Map.map ~f:Scope.make
in
let rec walk dir jbuilds visible_packages closest_packages =
let rec walk dir jbuilds scope =
let path = File_tree.Dir.path dir in
let files = File_tree.Dir.files dir in
let sub_dirs = File_tree.Dir.sub_dirs dir in
let visible_packages, closest_packages =
match Path.Map.find path packages_per_dir with
| None -> (visible_packages, closest_packages)
| Some pkgs ->
(List.fold_left pkgs ~init:visible_packages ~f:(fun acc pkg ->
String_map.add acc ~key:pkg.Package.name ~data:pkg),
pkgs)
in
let scope = Path.Map.find_default path scopes ~default:scope in
let jbuilds =
if String_set.mem "jbuild" files then
let jbuild = load ~dir:path ~visible_packages ~closest_packages in
let jbuild = load ~dir:path ~scope in
jbuild :: jbuilds
else
jbuilds
@ -216,13 +209,13 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () =
if Path.Set.mem (File_tree.Dir.path dir) ignored_subtrees then
(children, jbuilds)
else
let child, jbuilds = walk dir jbuilds visible_packages closest_packages in
let child, jbuilds = walk dir jbuilds scope in
(child :: children, jbuilds))
in
(Alias.Node (path, children), jbuilds)
in
let root = File_tree.root ftree in
let tree, jbuilds = walk root [] String_map.empty [] in
let tree, jbuilds = walk root [] Scope.empty in
{ file_tree = ftree
; tree
; jbuilds

2
src/jbuild_load.mli
View File

@ -4,7 +4,7 @@ open Jbuild
module Jbuilds : sig
type t
val eval : t -> context:Context.t -> (Path.t * Pkgs.t * Stanzas.t) list Future.t
val eval : t -> context:Context.t -> (Path.t * Scope.t * Stanzas.t) list Future.t
end
type conf =

2
src/main.ml
View File

@ -3,7 +3,7 @@ open Future
type setup =
{ build_system : Build_system.t
; stanzas : (Path.t * Jbuild.Pkgs.t * Jbuild.Stanzas.t) list String_map.t
; stanzas : (Path.t * Jbuild.Scope.t * Jbuild.Stanzas.t) list String_map.t
; contexts : Context.t list
; packages : Package.t String_map.t
}

2
src/main.mli
View File

@ -4,7 +4,7 @@ open Jbuild
type setup =
{ build_system : Build_system.t
; (* Evaluated jbuilds per context names *)
stanzas : (Path.t * Pkgs.t * Stanzas.t) list String_map.t
stanzas : (Path.t * Scope.t * Stanzas.t) list String_map.t
; contexts : Context.t list
; packages : Package.t String_map.t
}

18
src/super_context.ml
View File

@ -8,7 +8,7 @@ module Dir_with_jbuild = struct
{ src_dir : Path.t
; ctx_dir : Path.t
; stanzas : Stanzas.t
; pkgs : Pkgs.t
; scope : Scope.t
}
end
@ -96,12 +96,12 @@ let create
=
let stanzas =
List.map stanzas
~f:(fun (dir, pkgs, stanzas) ->
~f:(fun (dir, scope, stanzas) ->
{ Dir_with_jbuild.
src_dir = dir
; ctx_dir = Path.append context.build_dir dir
; stanzas
; pkgs
; scope
})
in
let internal_libraries =
@ -494,7 +494,7 @@ module Action = struct
| Ok x -> ok_path x
| Error _ as e -> e
let expand_step1 sctx ~dir ~dep_kind ~package_context t =
let expand_step1 sctx ~dir ~dep_kind ~scope t =
let acc =
{ artifacts = String_map.empty
; failures = []
@ -526,7 +526,7 @@ module Action = struct
in
add_artifact acc ~key ~lib_dep:(lib_dep, Required) (map_result res)
| Some ("version", s) -> begin
match Pkgs.resolve package_context s with
match Scope.resolve scope s with
| Ok p ->
let x =
Pkg_version.read sctx p >>^ function
@ -592,9 +592,9 @@ module Action = struct
| Some s -> Some (Strings ([s], cos))
| None -> None)
let run sctx t ~dir ~dep_kind ~targets ~package_context
let run sctx t ~dir ~dep_kind ~targets ~scope
: (Path.t list, Action.t) Build.t =
let t, forms = expand_step1 sctx ~dir ~dep_kind ~package_context t in
let t, forms = expand_step1 sctx ~dir ~dep_kind ~scope t in
let { Action.Infer.Outcome. deps; targets } =
match targets with
| Infer -> Action.Infer.partial t ~all_targets:true
@ -805,7 +805,7 @@ module PP = struct
(* Generate rules to build the .pp files and return a new module map where all filenames
point to the .pp files *)
let pped_modules sctx ~dir ~dep_kind ~modules ~preprocess ~preprocessor_deps ~lib_name
~package_context =
~scope =
let preprocessor_deps =
Build.memoize "preprocessor deps"
(Deps.interpret sctx ~dir preprocessor_deps)
@ -831,7 +831,7 @@ module PP = struct
~dir
~dep_kind
~targets:(Static [dst])
~package_context))
~scope))
| Pps { pps; flags } ->
let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in
pped_module m ~dir ~f:(fun kind src dst ->

8
src/super_context.mli
View File

@ -14,7 +14,7 @@ module Dir_with_jbuild : sig
{ src_dir : Path.t
; ctx_dir : Path.t (** [_build/context-name/src_dir] *)
; stanzas : Stanzas.t
; pkgs : Pkgs.t
; scope : Scope.t
}
end
@ -26,7 +26,7 @@ val create
-> dirs_with_dot_opam_files:Path.Set.t
-> file_tree:File_tree.t
-> packages:Package.t String_map.t
-> stanzas:(Path.t * Pkgs.t * Stanzas.t) list
-> stanzas:(Path.t * Scope.t * Stanzas.t) list
-> filter_out_optional_stanzas_with_missing_deps:bool
-> t
@ -131,7 +131,7 @@ module Action : sig
-> dir:Path.t
-> dep_kind:Build.lib_dep_kind
-> targets:targets
-> package_context:Pkgs.t
-> scope:Scope.t
-> (Path.t list, Action.t) Build.t
end
@ -146,7 +146,7 @@ module PP : sig
-> preprocess:Preprocess_map.t
-> preprocessor_deps:Dep_conf.t list
-> lib_name:string option
-> package_context:Pkgs.t
-> scope:Scope.t
-> Module.t String_map.t
(** Get a path to a cached ppx driver *)