Update the code to talk about scopes

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 ...)`
 

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
+      | Rule         rule  -> user_rule   rule  ~dir ~scope
-      | Alias        alias -> alias_rules alias ~dir ~package_context
+      | 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
 

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

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
+    { name     : string option
-    ; closest_packages : Package.t list
+    ; packages : Package.t String_map.t
     }
 
   let empty =
-    { visible_packages = String_map.empty
+    { name     = None
-    ; closest_packages = []
+    ; 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\
+                 "You cannot declare items to be installed without \
-                  In fact I know of no packages here, \
+                  adding a <package>.opam file at the root of your project.\n\
-                  in order for me to know that package\n\
+                  To declare elements to be installed as part of package %S, \
-                  %S exist, you need to add a %S file at the root of your project."
+                  add a %S file at the root of your project."
-                 name name (name ^ ".opam"))
+                 name (name ^ ".opam"))
       else
         Error (sprintf
-                 "package %S is not visible here.\n\
+                 "The current scope doesn't define package %S.\n\
-                  The only packages I know of in this directory are:\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))
+                 (package_listing (String_map.values t.packages))
-                 (hint name (String_map.keys t.visible_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
 

src/jbuild.mli

@@ -9,13 +9,15 @@ module Jbuild_version : sig
   val latest_stable : t
 end
 
-(** Packages visible in a given directory *)
+module Scope : sig
-module Pkgs : sig
   type t =
-    { visible_packages : Package.t String_map.t
+    { name     : string option (** First package name in alphabetical order.  [None] for
-    ; closest_packages : Package.t list
+                                   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

src/jbuild_load.ml

@@ -3,12 +3,12 @@ open Jbuild
 
 module Jbuilds = struct
   type script =
-    { dir  : Path.t
+    { dir   : Path.t
-    ; pkgs : Pkgs.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 =
+    let scope = Path.Map.find_default path scopes ~default:scope in
-      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 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

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 =

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
   }

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
   }

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 ->

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 *)