Advance

lib/env.ml

@@ -175,9 +175,9 @@ and find_elt opt aliases what where env name rest = function
           let name = List.hd (List.rev rest) in
           let m = Module.unknown name in
           Query.return (name, `Module m))
-  | Module.Pack ms -> (
+  | Module.Namespace ms -> (
       match rest with
-      | [] -> Query.return (name, `Pack ms)
+      | [] -> Query.return (name, `Namespace ms)
       | _ :: _ ->
           let[@warning "-8"] (Ok path) = Mod.Path.of_list_of_names rest in
           find opt aliases what where (restrict_as_a_pack env ms) path)
@@ -189,7 +189,8 @@ let is_exterior path t =
   | None -> false
   | Some q -> (
       match q.Query.v with
-      | Module.(Pack _ | Sig { origin = Module.Origin.Unit _; _ } | Link _) ->
+      | Module.(Namespace _ | Sig { origin = Module.Origin.Unit _; _ } | Link _)
+        ->
           true
       | Module.(Alias _ | Sig _ | Abstract _ | Functor _) -> false)
 
@@ -223,7 +224,7 @@ and resolve_alias_me path definition =
       match Mod.Path.of_list_of_names q with
       | Ok q -> resolve_alias_signature q signature
       | Error _ -> None)
-  | Module.Pack me -> (
+  | Module.Namespace me -> (
       match Mod.Path.of_list_of_names q with
       | Ok q -> resolve_alias_me q me
       | Error _ -> None)
@@ -245,8 +246,18 @@ let expand path t =
   | None -> path
   | Some m -> (
       match m.Query.v with
-      | Module.Pack _ -> path
-      | Module.Sig { origin = Module.Origin.Unit _; _ } -> assert false
+      | Module.Namespace _ -> path
+      | Module.Sig { origin = Module.Origin.Unit (_, v); _ } -> (
+          let name = Nsd.name v in
+          let path =
+            match q with
+            | [] -> Mod.Path.singleton name
+            | _ ->
+                let[@warning "-8"] (Ok q) = Mod.Path.of_list_of_names q in
+                Mod.Path.join name q in
+          match Nsd.namespace v with
+          | None -> path
+          | Some path' -> Mod.Path.concat path' path)
       | Module.Alias { name; _ } -> (
           match q with
           | [] -> Nsd.to_path name
@@ -257,3 +268,10 @@ let add_unit env ?namespace name m =
   let name, m = Module.with_namespace (Nsd.v ?namespace name) m in
   let top' = Module.Dictionary.(union env.top (of_list [ (name, m) ])) in
   top { env with top = top' }
+
+let add_namespace env v =
+  let add x =
+    top Module.Dictionary.{ env with top = union env.top (of_list [ x ]) } in
+  match Nsd.namespace v with
+  | None -> add (Nsd.name v, Link v)
+  | Some _ -> add (Module.namespace v)

lib/env.mli

@@ -11,7 +11,7 @@ val find :
   t ->
   ( Deps.t
     * Mod.t
-    * [ `Pack of Module.dictionary | `Module of Module.simple Module.t ],
+    * [ `Namespace of Module.dictionary | `Module of Module.simple Module.t ],
     [> `Not_found | `Msg of string ] )
   result
 
@@ -24,7 +24,7 @@ val find_within :
   t ->
   ( Deps.t
     * Mod.t
-    * [ `Pack of Module.dictionary | `Module of Module.simple Module.t ],
+    * [ `Namespace of Module.dictionary | `Module of Module.simple Module.t ],
     [> `Not_found | `Msg of string ] )
   result
 
@@ -33,8 +33,21 @@ val is_exterior : Mod.Path.t -> t -> bool
     [env]. Otherwise, it returns [false]. *)
 
 val resolve_alias : Mod.Path.t -> t -> Nsd.t option
+(** [resolve_alias v t] tries to resolve the given path if it's an {i alias}.
+    It returns the resolved/namespaced module name. *)
+
 val expand : Mod.Path.t -> t -> Mod.Path.t
+(** [expand path env] tries to expand the given module [path] from the given
+    [env] in relation to existing {!const:Module.Alias}. For instance, from
+    [A.B.C] when [B] is an alias to [D.E], we expand the path to [A.D.E.C]. *)
+
 val extend : t -> Summary.t -> t
 
 val add_unit :
   t -> ?namespace:Mod.Path.t -> Mod.t -> Module.extended Module.t -> t
+(** [add_unit env name v] adds a new module (possibly namespaced) into the
+    given [env]. *)
+
+val add_namespace : t -> Nsd.t -> t
+(** [add_namespace env namespaced] adds a new namespaced module which
+    points into a {!const:Module.Link}. *)

lib/module.ml

@@ -112,7 +112,7 @@ type 'a t =
         ]} *)
   | Functor : 'a t Arg.t option * 'a t -> 'a t
   | Link : Nsd.t -> extended t
-  | Pack : dictionary -> extended t
+  | Namespace : dictionary -> extended t
 
 and extended = |
 and simple = |
@@ -156,7 +156,7 @@ and pp ppf = function
       Fmt.pf ppf "%a:%a" Origin.pp origin pp_signature signature
   | Functor (arg, x) ->
       Fmt.pf ppf "%a -> %a" Fmt.(option ~none:(any "()") pp_arg) arg pp x
-  | Pack ms ->
+  | Namespace ms ->
       Fmt.pf ppf "@[[%a]@]"
         Fmt.(Dump.iter_bindings Mod.Map.iter (any "pack") Mod.pp pp)
         ms
@@ -177,7 +177,8 @@ module Dictionary = struct
       | Sig { origin = Unit (_, name); _ }, Link link when Nsd.equal name link
         ->
           Some x
-      | Pack p0, Pack p1 -> Some (Pack (Mod.Map.union merge p0 p1))
+      | Namespace p0, Namespace p1 ->
+          Some (Namespace (Mod.Map.union merge p0 p1))
       | _, v -> Some v in
     Mod.Map.union merge
 end
@@ -204,19 +205,32 @@ let rec with_namespace namespaced m =
       match tl with
       | [] ->
           let v = with_namespace (Nsd.v name) m in
-          (hd, Pack (Dictionary.of_list [ v ]))
+          (hd, Namespace (Dictionary.of_list [ v ]))
       | _ ->
           let[@warning "-8"] (Ok namespace) = Mod.Path.of_list_of_names tl in
           let namespaced = Nsd.v ~namespace name in
           let v = with_namespace namespaced m in
-          (hd, Pack (Dictionary.of_list [ v ])))
+          (hd, Namespace (Dictionary.of_list [ v ])))
+
+let namespace path =
+  let rec go global path =
+    match Mod.Path.to_list path with
+    | [] -> assert false (* XXX(dinosaure): a [Mod.Path.t] can not be empty. *)
+    | [ name ] ->
+        (name, Namespace (Dictionary.of_list [ (Nsd.name global, Link global) ]))
+    | name :: rest ->
+        let[@warning "-8"] (Ok rest) = Mod.Path.of_list_of_names rest in
+        (name, Namespace (Dictionary.of_list [ go global rest ])) in
+  match Nsd.namespace path with
+  | None -> invalid_arg "Module.namespace: empty namespace"
+  | Some namespace -> go path namespace
 
 let rec spirit_away p root = function
   | Alias a as alias ->
       if not root then Alias { a with phantom = Some p } else alias
   | (Abstract _ | Functor _) as v -> v
   | Link _ as link -> link (* TODO *)
-  | Pack v -> Pack (Mod.Map.map (spirit_away p false) v)
+  | Namespace v -> Namespace (Mod.Map.map (spirit_away p false) v)
   | Sig { origin; signature } ->
       let origin' = Origin.Phantom (root, p) in
       let origin =
@@ -303,5 +317,5 @@ module Partial = struct
               { Arg.name; signature = of_extended signature })
             a in
         Functor (a, of_extended x)
-    | _ -> invalid_arg "Impossible to simplify Alias, Link or Pack"
+    | _ -> invalid_arg "Impossible to simplify Alias, Link or Namespace"
 end

lib/module.mli

@@ -1,5 +1,5 @@
 module Source : sig
-  type t = private [ `Local | `Unknown | `Path of Fpath.t | `Special ] * Nsd.t
+  type t = [ `Local | `Unknown | `Path of Fpath.t | `Special ] * Nsd.t
   (** Localized path for a module. *)
 
   val of_path : Fpath.t -> t
@@ -24,6 +24,7 @@ module Divergence : sig
       shadows all modules present in the current, or none. *)
 
   val pp : t Fmt.t
+  (** Pretty-printer of {!type:t}. *)
 end
 
 module Arg : sig
@@ -78,7 +79,7 @@ and 'a t =
   | Abstract : Id.t -> 'a t
   | Functor : 'a t Arg.t option * 'a t -> 'a t
   | Link : Nsd.t -> extended t
-  | Pack : dictionary -> extended t
+  | Namespace : dictionary -> extended t
 
 module Dictionary : sig
   type v = extended t
@@ -92,13 +93,27 @@ val unknown : ?origin:Origin.t -> ?path:Fpath.t -> Mod.t -> _ t
 (** [unknown ?origin ?path name] create a module without a signature.
     Depending on the given [origin] and the given [path], we can consider
     [name] as a {i unit} module iff:
-    - [name] is a {!val:Mod.Path.singleton}
+    - [name] is a {!type:Mod.t}
     - [path] is a directory containing the module [name] or the location
       of [name] (like [unknown ~path:foo/bar.ml Bar])
 
     Otherwise, if the [origin] is not given, we consider the given module
     [name] as a {i sub-module}. *)
 
+val namespace : Nsd.t -> Mod.t * extended t
+(** [namespace namespaced] returns a module name with its value/representation
+    as a {!const:Link} to the given [namespaced] value. Like:
+    {[
+      # let a_b_c = Nsd.of_path (Mod.Path.of_string_exn "A.B.C")
+      # Module.namespace a_b_c
+      - : Mod.t * extended t =
+        "C", Namespace [ "A", Namespace [ "B", Namespace [ "C", Link a_b_c) ]]]
+    ]}
+
+    The given [namespaced] value must be namespaced ([Nsd.namespace v <> None]).
+    Otherwise, we raise an [Invalid_argument].
+*)
+
 val with_namespace : Nsd.t -> extended t -> Mod.t * extended t
 val spirit_away : Divergence.t -> extended t -> extended t
 
@@ -135,5 +150,5 @@ module Partial : sig
   val of_extended : extended t -> simple t
   (** [of_extended v] casts the given {i extended} value
       to a simpler one (and refutes {!const:Alias}, {!const:Link} and
-      {!const:Pack} as possibilities of [v]). *)
+      {!const:Namespace} as possibilities of [v]). *)
 end

lib/nsd.mli

@@ -15,6 +15,7 @@
     solution) for our module [Bar]. *)
 
 type t
+(** Type of a {i namespaced} module. *)
 
 val pp : t Fmt.t
 (** Pretty-printer of {!type:t}. *)
@@ -34,6 +35,8 @@ val to_path : t -> Mod.Path.t
     module name. *)
 
 val v : ?namespace:Mod.Path.t -> Mod.t -> t
+(** [v ?namespace name] returns a possibly namespaced module. *)
+
 val equal : t -> t -> bool
 
 module Map : Map.S with type key = t

test/mod.ml

@@ -159,5 +159,5 @@ let () =
     [
       ("simple", [ simple01; simple02; simple03; simple04 ]);
       ("path", [ path01; path02; path03; path04 ]);
-      ("with_apply", [ with_apply01 ]);
+      ("with apply", [ with_apply01 ]);
     ]