From 11985e394853f025dbfb9a5266ac45d81dd1a4ef Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Mon, 5 Jun 2017 13:42:13 +0100 Subject: [PATCH] Update the code to talk about scopes --- CHANGES.md | 2 ++ src/gen_rules.ml | 28 +++++++++---------- src/gen_rules.mli | 2 +- src/jbuild.ml | 62 ++++++++++++++++++++++++++----------------- src/jbuild.mli | 12 +++++---- src/jbuild_load.ml | 37 +++++++++++--------------- src/jbuild_load.mli | 2 +- src/main.ml | 2 +- src/main.mli | 2 +- src/super_context.ml | 18 ++++++------- src/super_context.mli | 8 +++--- 11 files changed, 93 insertions(+), 82 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 6528e6eb..8dda010c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -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 ...)` diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 637f0d6e..42fc461a 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -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 diff --git a/src/gen_rules.mli b/src/gen_rules.mli index e8d3810a..91732799 100644 --- a/src/gen_rules.mli +++ b/src/gen_rules.mli @@ -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 diff --git a/src/jbuild.ml b/src/jbuild.ml index 7fa6a8c1..295fbefb 100644 --- a/src/jbuild.ml +++ b/src/jbuild.ml @@ -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 .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 .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 diff --git a/src/jbuild.mli b/src/jbuild.mli index 4e6bb42b..dfa781d2 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -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 diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index 5eb78efc..48ba61cc 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -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 diff --git a/src/jbuild_load.mli b/src/jbuild_load.mli index 3e8a42ff..2f8fb6ff 100644 --- a/src/jbuild_load.mli +++ b/src/jbuild_load.mli @@ -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 = diff --git a/src/main.ml b/src/main.ml index 6ff0918f..9d2962bc 100644 --- a/src/main.ml +++ b/src/main.ml @@ -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 } diff --git a/src/main.mli b/src/main.mli index df76eb7d..949ebb5e 100644 --- a/src/main.mli +++ b/src/main.mli @@ -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 } diff --git a/src/super_context.ml b/src/super_context.ml index 69c01583..de120f87 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -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 -> diff --git a/src/super_context.mli b/src/super_context.mli index 25d55450..b805dd3e 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -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 *)