Commit 6791e866 authored by Thierry Martinez's avatar Thierry Martinez
Browse files

module types

parent b9f8fd46
Pipeline #77858 passed with stage
in 13 minutes and 22 seconds
......@@ -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]`.
......
(executable
(name hashed_type_compare)
(preprocess (staged_pps override)))
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
(executable
(name ordered_hashed_type)
(preprocess (staged_pps override)))
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
module type S = sig
type t
val equal : t -> t -> bool
val hash : t -> int
val compare : t -> t -> int
end
......@@ -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
This diff is collapsed.
......@@ -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
......@@ -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
......@@ -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
......@@ -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
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment