module types

README.md

@@ -98,6 +98,38 @@ module%override Map = struct
 end
 ```
 
+This works with module types too: the following example changes the
+definition of [Hashtbl.HashedType] to take a [compare] predicate instead
+of [equal] ([`hashed_type_compare.ml`]).
+Note that since there is no `with module type` constraint, the signature
+of `Hashtbl` have to be expanded in the code generated by the notation
+to remove the original `HashedType` definition.
+
+[`hashed_type_compare.ml`]: https://gitlab.inria.fr/tmartine/override/blob/master/examples/hashed_type_compare/hashed_type_compare.ml
+
+```ocaml
+module%override Hashtbl = struct
+  module type HashedType = sig
+    type t
+
+    val compare : t -> t -> int
+
+    val hash : t -> int
+  end
+
+  module Make (X : HashedType) = struct
+    include Hashtbl.Make (struct
+      type t = X.t
+
+      let equal x y =
+        X.compare x y = 0
+
+      let hash = X.hash
+    end)
+  end
+end
+```
+
 ## Importing types
 
 If the imported module defines a type, we can override its definition
@@ -246,6 +278,34 @@ themselves are not included. Since `Asttypes` and `Parsetree`
 interfaces have no implementations, there would have been a link-time
 failure if they were included.
 
+## `[%%symbols]`: importing all the symbols from a module
+
+The notation `[%%symbols]` can be used in signatures to import all
+the symbols (types, module types, values and module declarations) that
+are defined in the imported module. The following example defines
+the signature of a module for ordered and hashed types by constructing
+the union of `Hashtbl.HashedType` and `Hashtbl.OrderedType`
+([`ordered_hashed_type.ml`]).
+
+[`ordered_hashed_type.ml`]: https://gitlab.inria.fr/tmartine/override/blob/master/examples/ordered_hashed_type/ordered_hashed_type.ml
+
+```ocaml
+module type S = sig
+  module%import Hashtbl : sig
+    module type%import HashedType = sig
+      [%%symbols]
+    end
+  end
+
+  module%import Map : sig
+    module type%import OrderedType = sig
+      type t [@@remove]
+      [%%symbols]
+    end
+  end
+end
+```
+
 ## `[@@remove]`: removing types
 
 Types may be removed from signature with the annotation `[@@remove]`.

examples/hashed_type_compare/dune

+(executable
+  (name hashed_type_compare)
+  (preprocess (staged_pps override)))

examples/hashed_type_compare/hashed_type_compare.ml

+module%override Hashtbl = struct
+  module type HashedType = sig
+    type t
+
+    val compare : t -> t -> int
+
+    val hash : t -> int
+  end
+
+  module Make (X : HashedType) = struct
+    include Hashtbl.Make (struct
+      type t = X.t
+
+      let equal x y =
+        X.compare x y = 0
+
+      let hash = X.hash
+    end)
+  end
+end

examples/ordered_hashed_type/dune

+(executable
+  (name ordered_hashed_type)
+  (preprocess (staged_pps override)))

examples/ordered_hashed_type/ordered_hashed_type.ml

+module type S = sig
+  module%import Hashtbl : sig
+    module type%import HashedType = sig
+      [%%symbols]
+    end
+  end
+
+  module%import Map : sig
+    module type%import OrderedType = sig
+      type t [@@remove]
+      [%%symbols]
+    end
+  end
+end
+    

examples/ordered_hashed_type/ordered_hashed_type.mli

+module type S = sig
+  type t
+
+  val equal : t -> t -> bool
+
+  val hash : t -> int
+
+  val compare : t -> t -> int
+end

src/ast_wrapper.ml

@@ -70,6 +70,10 @@ module type S = sig
 
   val build : wrapped_item -> item
 
+  val choose :
+      (unit -> Parsetree.structure_item) -> (unit -> Parsetree.signature_item) ->
+        item
+
   val map : Ast_mapper.mapper -> Ast_mapper.mapper -> contents -> contents
 
   val map_item : Ast_mapper.mapper -> Ast_mapper.mapper -> item -> item
@@ -86,7 +90,7 @@ module type S = sig
 
   val build_module_expr : wrapped_module_expr -> module_expr
 
-  val choose :
+  val choose_module_expr :
       (unit -> Parsetree.module_expr) -> (unit -> Parsetree.module_type) ->
         module_expr
 end
@@ -144,6 +148,9 @@ module Structure : S with module Types = Structure_types = struct
     | Include inc -> Ast_helper.Str.include_ ~loc inc
     | Other item -> Ast_helper.Str.mk ~loc item.pstr_desc
 
+  let choose structure _signature =
+    structure ()
+
   let map (mapper : Ast_mapper.mapper) submapper (contents : contents) : contents =
     mapper.structure submapper contents
 
@@ -201,7 +208,7 @@ module Structure : S with module Types = Structure_types = struct
           Ast_helper.Mod.constraint_ ~loc ~attrs (Lazy.force m) t
       | Other expr -> Ast_helper.Mod.mk ~loc ~attrs expr.pmod_desc
 
-  let choose make_expr make_type =
+  let choose_module_expr make_expr _make_type =
     make_expr ()
 end
 
@@ -241,6 +248,9 @@ module Signature : S with module Types = Signature_types = struct
     | Include inc -> Ast_helper.Sig.include_ ~loc inc
     | Other item -> item
 
+  let choose _make_structure make_signature =
+    make_signature ()
+
   let map (mapper : Ast_mapper.mapper) submapper contents =
     mapper.signature submapper contents
 
@@ -293,6 +303,6 @@ module Signature : S with module Types = Signature_types = struct
       | Constraint (_m, t) -> t
       | Other expr -> Ast_helper.Mty.mk ~loc ~attrs expr.pmty_desc
 
-  let choose make_expr make_type =
+  let choose_module_expr _make_expr make_type =
     make_type ()
 end

tests/base.ml

@@ -47,3 +47,21 @@ module Rec_group = struct
 
   type c = C of d and d = D of c
 end
+
+module Module_type = struct
+  type first
+
+  module type S = sig
+    type t = first
+  end
+
+  type last = (module S)
+end
+
+module Redefine_module_type = struct
+  let x = ()
+
+  module type S = sig
+    type t
+  end
+end

tests/tests.ml

@@ -36,4 +36,17 @@ module%override Base : Tests_spec.S = struct
   module%override Rec_group = struct
     type c = _ and co [@@deriving]
   end
+
+  module%override Module_type = struct
+    type first = bool
+    [%%types]
+  end
+
+  module%override Redefine_module_type = struct
+    module type%override S = sig
+      type t
+
+      val compare : t -> t -> int
+    end
+  end
 end

tests/tests.mli

@@ -36,4 +36,17 @@ module%override Base : sig
   module%override Rec_group : sig
     type c = _ and co [@@deriving]
   end
+
+  module%override Module_type : sig
+    type first = bool
+    [%%types]
+  end
+
+  module%override Redefine_module_type : sig
+    module type%override S = sig
+      type t
+
+      val compare : t -> t -> int
+    end
+  end
 end

tests/tests_spec.mli

@@ -47,4 +47,20 @@ module type S = sig
     type a = Base.Rec_group.a = A of b and b = Base.Rec_group.b = B of a
     type c = Base.Rec_group.c = C of d and d = Base.Rec_group.d = D of c
   end
+
+  module Module_type : sig
+    type first = bool
+    module type S = sig type t = first end
+    type last = (module S)
+  end
+
+  module Redefine_module_type : sig
+    val x : unit
+
+    module type S = sig
+      type t
+
+      val compare : t -> t -> int
+    end
+  end
 end