I want to return different modules from a function. This is the general idea of what I wish would work.
module type First = sig
val speak : unit -> unit
end
module First = struct
let speak () = print_endline "hi"
end
module type Second = sig
val another_speaker : unit -> unit
end
module Second = struct
let another_speaker () = print_endline "another hi"
end
type mods = First | Second
let load = function
| First -> (module First : First)
| Second -> (module Second : Second)
1) But it doesn't because load's return type gets determined on the first match. How can I make this general idea work?
2) How can I write something like this and have it work.
type a = [`First of (module type First )]
The "good" solution is to use the same module type for everyone:
module type S = sig
val speak : unit -> unit
end
module First = struct
let speak () = print_endline "hi"
end
module Second = struct
let speak () = print_endline "another hi"
end
type mods = First | Second
let load = function
| First -> (module First : S)
| Second -> (module Second : S)
If you really can't, apart from the variant solution given by Jeffrey, there is the GADT solution:
type 'a t = First : (module First) t | Second : (module Second) t
let load : type a . a t -> a = function
| First -> (module First : First)
| Second -> (module Second : Second)
You can't treat the two module types as the same type, because they're different. But you can combine them into a variant type.
This works for me:
module type First = sig
val speak : unit -> unit
end
module type Second = sig
val another_speaker : unit -> unit
end
type modvar = MFirst of (module First) | MSecond of (module Second)
type mods = First | Second
module First = struct
let speak () = print_endline "hi"
end
module Second = struct
let another_speaker () = print_endline "another hi"
end
let load = function
| First -> MFirst (module First)
| Second -> MSecond (module Second)
I'm not sure if this is what you're looking for.
Update
Here's the same code rewritten to use polymorphic variants:
module type First = sig
val speak : unit -> unit
end
module type Second = sig
val another_speaker : unit -> unit
end
type mods = First | Second
module First = struct
let speak () = print_endline "hi"
end
module Second = struct
let another_speaker () = print_endline "another hi"
end
let load = function
| First -> `MFirst (module First: First)
| Second ->`MSecond (module Second: Second)
The key is that you need to tag the values returned by load. Otherwise they have to be the same type, which they aren't.
Related
I wonder why one example fails and not the other.
(* this fails *)
(* (l fails to type check)
This expression has type 'a but an expression was expected of type
(module M.TFixU)
The module type M.TFixU would escape its scope
*)
let foldList1 (type ar) algr l =
let module M = FixT (ListIntF) in
let (module LU : M.TFixU) = l in
assert false
(* but this works *)
let foldList2 (type ar) algr l =
let (module LU : FixT(ListIntF).TFixU) = l in
assert false
complete code
module Higher = struct
type ('a, 't) app
module type NewType1 = sig
type 'a s
type t
val inj : 'a s -> ('a, t) app
val prj : ('a, t) app -> 'a s
end
module NewType1 (X : sig
type 'a t
end) =
struct
type 'a s = 'a X.t
type t
external inj : 'a s -> ('a, t) app = "%identity"
external prj : ('a, t) app -> 'a s = "%identity"
end
end
module Fix = struct
open Higher
module FixT (T : NewType1) = struct
module type T_Alg = sig
type a
val alg : (a, T.t) app -> a
end
module type TFixU = sig
module App : functor (A : T_Alg) -> sig
val res : A.a
end
end
type tFixU = (module TFixU)
end
end
module Pb = struct
open Higher
open Fix
(* intro *)
type 'r listIntF = Empty | Succ of (int * 'r)
module ListIntF = NewType1 (struct
type 'r t = 'r listIntF
end)
(* this fails *)
let foldList1 (type ar) algr l =
let module M = FixT (ListIntF) in
let (module LU : M.TFixU) = l in
(* (l fails to type check)
This expression has type 'a but an expression was expected of type
(module M.TFixU)
The module type M.TFixU would escape its scope
*)
let module T = LU.App (struct
type a = ar
let alg = algr
end) in
T.res
(* but this doesn't *)
let foldList2 (type ar) algr l =
let (module LU : FixT(ListIntF).TFixU) = l in
let module T = LU.App (struct
type a = ar
let alg = algr
end) in
T.res
end
In the first case, the type of l is unified with the type defined in the module M, which defines the module type. Since the type is introduced after the value l, which is a parameter in an eager language so it already exists, the value l receives a type that doesn't yet exist at the time of its creation. It is the soundness requirement of the OCaml type system that the value lifetime has to be enclosed with its type lifetime, or more simply each value must have a type. The simplest example is,
let x = ref None (* here `x` doesn't have a type since it is defined later *)
type foo = Foo;; (* the `foo` scope starts here *)
x := Some Foo (* foo escapes the scope as it is assigned to `x` via `foo option` *)
Another simplified example, that involves a function parameter is the following,
let foo x =
let open struct
type foo = Foo
end in
match x with
| Some Foo -> true (* again, type foo escapes the scope as it binds to `x` *)
| None -> false
A very good article that will help you understand in-depth scopes and generalization is Oleg Kiselyov's How OCaml type checker works -- or what polymorphism and garbage collection have in common.
Concerning the second case, you clearly specified the type of l using the applicative nature of OCaml functors. And since the typechecker knows that the lifetime of FixT(ListIntF).TFixU is greater than the lifetime of l it is happy.
Is it possible to write the module Nat as a fixpoint or a universal algebra for some functor NatF ?
module rec Nat : sig
type t = Z | S of Nat.t
end = struct
type t = Z | S of Nat.t
end
Presumably to_int would then be a regular fold
let rec to_int : Nat.t -> int = function Z -> 0 | S x -> 1 + to_int x
I am not sure that I fully understand your question, but it looks like that you want to define a fixed-point combinator on the type level, so that you can write,
module NatF = Fix(functor (F : F)(T:T) -> struct
type t = Z | S of F(T).t
end)
module R = NatF(struct type s type t = Z | S of s end)
It is possible, e.g.,
module type T = sig type t end
module type F = functor (T : T) -> T
module type F2F = functor (F : F) -> F
module type Fix = functor (F : F2F) -> F
module rec Fix : Fix = functor (F : F2F) -> F (Fix(F))
but the problem is that it will leave the resulting type R.t abstract, so you can't write the to_int function over R.t. Even if you will try to define the to_int function inside of the open-recursive functor, you won't be able to recurse over the F(T).t type of the S branch as it will be abstract.
So, I believe, that in the end, you will still have to rely either on the recursion that is implicit in the type definition or on recursive modules to tighten up the fixed point, e.g.,
module type T = sig type t end
module Nat (T : T) = struct
module type S = sig
type t = Z | S of T.t
end
end
module type F = functor (T : T) -> Nat(T).S
module type F2F = functor (F : F) -> F
module type Fix = functor (F : F2F) -> F
module rec Fix : Fix = functor (F : F2F) -> F (Fix(F))
module F = functor(F : F)(T : T) -> struct
type t = F(T).t = Z | S of T.t
end
module rec R : sig
type t = Z | S of R.t
end = Fix(F)(R)
rephrasing Ivg's answer and its issue (with a tweak to make it compile - interesting to understand "safe module")
module Ivg = struct
module type T = sig type t end
module type F = functor (T : T) -> T
module NatF (T : T) = struct
type t = Z | S of T.t
end
module type Fix = functor (F : F) -> T
module rec Fix : Fix =
functor (F : F) -> F (struct type t = Fix(F).t end) (*tweak - prevent loop at definition - cf "safe module" at https://caml.inria.fr/pub/papers/xleroy-recursive_modules-03.pdf *)
module Nat = Fix (NatF)
(* As mentioned by #ivg :
it will leave the resulting type Nat.t abstract,
so you can't write the to_int function over Nat.t.
Even if you will try to define the to_int function inside of the open-recursive functor,
you won't be able to recurse over the F(T).t type of the S branch as it will be abstract. *)
end
Whose solution can be approximated by
module type T = sig type t end
module type F = functor (T : T) -> T
module rec NatF : F =
functor (T : T) ->
struct
type t = Z | S of T.t
end
and FixedNat : T = struct
type t = NatF(FixedNat).t
end
Fix now statically know it is being applied to NatF.
But T is still abstract
I don't know any other way as of yet (modular implicit ?)
Another way of expressing Nat
(* type 't natF = Z | S of 't *)
module rec FixedNat : sig
module type Z = sig end
module type S = sig
val n : FixedNat.n
end
type n = Z | S of (module S)
end =
FixedNat
let rec to_int : FixedNat.n -> int = function
| Z -> 0
| S (module N) -> to_int N.n
which still does not express FixedNat as an explicit fix point of an algebra
Another approximate solution.
The encoding of modules fixed point can be done through its universal property for type level algebras
module Algebras = struct
(* type level natf_algebra : 'a natF -> 'a *)
module type natF_algebra = sig
type a
val zero : a
val succ : a -> a
end
(* A type level algebra lowered *)
type 'a natF_algebra = (module natF_algebra with type a = 'a)
(* is an ordinary value level algebra *)
type 'a natf = Z | S of 'a
type 'a natf_algebra = { alg : 'a natf -> 'a }
end
module Encoding = struct
open Algebras
(* Universal encoding *)
module type NatU = sig
module Ap : functor (F : natF_algebra) -> sig
val res : F.a
end
end
type natU = (module NatU)
(* recursive module *)
module rec FixedNat : sig
module type Z = sig end
module type S = sig
val n : FixedNat.n
end
type n = Z | S of (module S)
end =
FixedNat
end
module Equivalence = struct
open Algebras
open Encoding
let fixedNat_to_natU : FixedNat.n -> natU =
fun n ->
(module struct
module Ap (F : natF_algebra) = struct
let rec foldNat = function
| FixedNat.Z -> F.zero
| FixedNat.S (module N) -> foldNat N.n |> F.succ
let res = foldNat n
end
end)
let rec natU_to_fixedNat : natU -> FixedNat.n =
fun (module N) ->
let module M = N.Ap (struct
type a = FixedNat.n
let zero = FixedNat.Z
let succ x =
FixedNat.S
(module struct
let n = x
end)
end) in
M.res
end
I'm trying to create a functor that makes a polynomial ring out of a ring. My underlying type, Ring_elt, has the following signature:
module type Ring_elt = sig
type t
val add : t -> t -> t
val mul : t -> t -> t
val zer : t
val one : t
val neg : t -> t
end;;
My polynomial functor looks like:
module Make_Poly2(Underlying:Ring_elt) = struct
type t = Poly of Underlying.t list
let rec create lst =
match List.rev lst with
| Underlying.zer :: tl -> create List.rev tl
| _ -> Poly of lst
end;;
(so the 'create' function should take a list, remove the leading zeros, and then return the polynomial of the result). However, I get a syntax error and utop underlines the "zer" after "Underlying."
By comparison, the following code (for making integer polynomials) works:
module Make_int_poly = struct
type t = Poly of int list
let rec create lst =
match List.rev lst with
| 0 :: tl -> create (List.rev tl)
| _ -> Poly lst
end;;
Any idea what's going on?
An OCaml pattern is built from constants, data constructors, and new names bound by the pattern match. Underlying.zer isn't any of those things. But 0 is one of them.
Seems like you can just use an if to compare against Underlying.zer.
Jeffrey's answer is good but instead of correcting it with an if construction, what you should do is the following : use algebraic data types
Instead of writing
val zer : t
val one : t
You could write
module type Ring_elt = sig
type t = Zer | One | Num of t
val add : t -> t -> t
val mul : t -> t -> t
val neg : t -> t
end
module Make_int_poly = struct
type t = Poly of int list
let rec create lst =
match List.rev lst with
| Underlying.Zer :: tl -> create (List.rev tl)
| _ -> Poly lst
end
It's a much better way of doing it since you can easily pattern match on it and even add some constants to your type t without problems.
In my code I've module M = Implementation1 and then I reference M, instead of Implementation1. The problem is, I've to recompile my program to change Implementation1 to Implementation2. I'd like to control which implementation to use from with a command line parameter. Is that possible?
Is the situation simpler, when all implementations share signature?
Since both implementation are known statically you can use first class modules. There are quite a few different possibilities on how to structure your program, here's one that minimizes toplevel reference cells and toplevel effectful statements:
module type M = sig
val test : unit -> unit
end
module M1 : M = struct
let test () = Printf.printf "Implementation 1\n%!"
end
module M2 : M = struct
let test () = Printf.printf "Implementation 2\n%!"
end
let test m =
let module M = (val m : M) in
(* If other modules of your program depend on the implementation of
M, functorize them over sig M and instantiate them with M here. *)
M.test ()
let main () =
let exec = Filename.basename Sys.executable_name in
let usage = Printf.sprintf
"Usage: %s [OPTION]...\n\
Program synopsis.\n\
Options:" exec
in
let m = ref (module M1 : M) in
let options = [
"-m1", Arg.Unit (fun () -> m := (module M1 : M)),
" Use implementation 1 (default)";
"-m2", Arg.Unit (fun () -> m := (module M2 : M)),
" Use implementation 2"; ]
in
let anon _ = raise (Arg.Bad "no positional argument supported") in
Arg.parse (Arg.align options) anon usage;
test !m
let () = main ()
For most versions of OCaml you can do this with camlp4.
IFDEF USE_IMP1 THEN
module M = Implementation1
ELSE
module M = Implementation2
END
Then passing the pre-processing options like the following will choose the correct one to incorporate in the build.
-pp "camlp4of -UUSE_IMP1" //to undefine USE_IMP1
-pp "camlp4of -DUSE_IMP1" //to define USE_IMP2
For versions of OCaml >= 4.00.0 you can use the First-Class modules and an expression like,
module Choose = (val (if use_impl1 then (module Impl_1) else (module Impl_2)) : IMP)
to use an if statement to choose the module as determined by the use_impl1 value.
I currently have two "layers" of modules that represent identifier-data relationships in a database.
The first layer defines identifier types, such as IdUser.t or IdPost.t while the second layer defines data types such as User.t or Post.t. I need all the modules of the first layer to be compiled before the modules of the second layer, because a Post.t must hold the IdUser.t of its author and the User.t holds the IdPost.t of the last five posts he visited.
Right now, IdUser.t provides functionality that should only ever be used by User.t, such as the ability to transform an IdUser.t into an IdUser.current: for security reasons, this transform must only ever be performed by the function User.check_password. Since IdUser and User are independent modules, I need to define those features as public functions and rely on conventions to avoid calling them anywhere outside of User, which is rather dirty. A symmetrical situation happens in IdPost.mine:
module IdUser : sig
type t
type current
val current_of_t : t -> current (* <--- Should not be public! *)
end = struct
type t = string
type current = string
let current_of_t x = x
end
module IdPost : sig
type t
type mine
val mine_of_t : t -> mine (* <--- Should not be public! *)
end = struct
type t = string
type mine = string
let mine_of_t x = x
end
module Post : sig
(* Should not "see" IdUser.current_of_t but needs IdPost.mine_of_t *)
val is_mine : IdUser.current -> IdPost.t -> IdPost.mine
end
module User : sig
(* Should not "see" IdPost.mine_of_t but needs IdUser.current_of_t *)
val check_password : IdUser.t -> password:string -> IdUser.current
end
Is there a way of defining an current_of_t : t -> current function in IdUser that can only be called from within module User ?
EDIT: this was a simplified example of one pair of modules, but there's an obvious solution for a single pair that cannot be generalized to multiple pairs and I need to solve this for multiple pairs — about 18 pairs, actually... So, I've extended it to be an example of two pairs.
So IdUser is in reality an existential type: For User there exists a type
IdUser.current such that the public IdUser.t can be lifted to it. There are a couple of ways to encode this: either functorize User as Gasche shows if statically managing the dependence is sufficient, or use first-class modules or objects if you need more dynamism.
I'll work out Gasche's example a bit more, using private type abbreviations for convenience and to show how to leverage translucency to avoid privatizing implementation types too much. First, and this might be a limitation, I want to declare an ADT of persistent IDs:
(* File id.ml *)
module type ID = sig
type t
type current = private t
end
module type PERSISTENT_ID = sig
include ID
val persist : t -> current
end
With this I can define the type of Posts using concrete types for the IDs but with ADTs to enforce the business rules relating to persistence:
(* File post.ml *)
module Post
(UID : ID with type t = string)
(PID : PERSISTENT_ID with type t = int)
: sig
val is_mine : UID.current -> PID.t -> PID.current
end = struct
let is_mine uid pid =
if (uid : UID.current :> UID.t) = "me" && pid = 0
then PID.persist pid
else failwith "is_mine"
end
The same thing with Users:
(* File user.ml *)
module User
(UID : PERSISTENT_ID with type t = string)
: sig
val check_password : UID.t -> password:string -> UID.current
end = struct
let check_password uid ~password =
if uid = "scott" && password = "tiger"
then UID.persist uid
else failwith "check_password"
end
Note that in both cases I make use of the concrete but private ID types. Tying all together is a simple matter of actually defining the ID ADTs with their persistence rules:
module IdUser = struct
type t = string
type current = string
let persist x = x
end
module IdPost = struct
type t = int
type current = int
let persist x = x
end
module MyUser = User (IdUser)
module MyPost = Post (IdUser) (IdPost)
At this point and to fully decouple the dependencies you will probably need signatures for USER and POST that can be exported from this module, but it's a simple matter of adding them in.
One way that seems to work at least on your simplified example is to group IdUser and User inside a same module:
module UserAndFriends : sig ... end = struct
module IdUser : sig
...
end = struct
...
end
module User = struct
...
end
end
module Post : sig
val create : (* <--- Should not "see" IdUser.current_of_t *)
author:IdUser.current -> title:string -> body:string -> IdPost.t
end
Hiding the dangerous function(s) in the signature of UserAndFriends gives the result you desire. If you do not want to make a big file containing both IdUser and User, you can use option -pack of ocamlc to create UserAndFriends. Note that in this case, you must craft your Makefile carefully so that the .cmi files of IdUser and User are not visible when compiling Post. I am not the Makefile specialist for Frama-C, but I think we use separate directories and position the compiler option -I carefully.
I suggest you parametrize Post (and possibly User for consistency) by a signature for the IdUser module : you would use a signature with current_of_t for User, and one without for Post.
This guarantee that Post doesn't use IdUser private features, but the public interface of IdUser is still too permissive. But with this setup, you have reversed the dependencies, and IdUser (the sensitive part) can control its use directly, give itself (with the private part) to IdUser and restrict the public signature to the public parts.
module type PrivateIdUser = sig
val secret : unit
end
module type PublicIdUser = sig
end
module type UserSig = sig
(* ... *)
end
module MakeUser (IdUser : PrivateIdUser) : UserSig = struct
(* ... *)
end
module IdUser : sig
include PublicIdUser
module User : UserSig
end
= struct
module IdUser = struct
let secret = ()
end
module User = MakeUser(IdUser)
include IdUser
end
module Post = struct
(* ... *)
end
Edit : Pascal Cuoq's concurrent -- in the temporal sense -- solution is alos very nice. Actually it's simpler and has less boilerplate. My solution adds an abstraction that allows for slightly more modularity, as you can define User independently of IdUser.
I think which solution is best probably depends on the specific application. If you have a lot of different modules that use PrivateIdUser private information, then using functors to write them separately instead of bundling everyone in the same module can be a good idea. If only User needs to be in the "private zone" and it's not very big, then Pascal's solution is a better choice.
Finally, while being forced to explicit Private and Public interfaces can be seen as an additional burden, it is also a way to make the access properties of different modules more explicit that using the position inside the module hierarchy.
It's possible to achieve fine-grained control over signatures with a combination of recursive modules, first-class modules and GADTs, but the limitation would be that all modules should then be inside the same top-level module and unpackings of first-class modules inside the recursive modules should be done in each function separately (not on the module-level as it would cause runtime exception Undefined_recursive_module):
module rec M1 : sig
module type M2's_sig = sig
val a : int
val c : float
end
module type M3's_sig = sig
val b : string
val c : float
end
type _ accessor =
| I'm_M2 : M2.wit -> (module M2's_sig) accessor
| I'm_M3 : M3.wit -> (module M3's_sig) accessor
val access : 'a accessor -> 'a
type wit
val do_it : unit -> unit
end = struct
module type M2's_sig = sig
val a : int
val c : float
end
module type M3's_sig = sig
val b : string
val c : float
end
type _ accessor =
| I'm_M2 : M2.wit -> (module M2's_sig) accessor
| I'm_M3 : M3.wit -> (module M3's_sig) accessor
module M1 = struct
let a = 1
let b = "1"
let c = 1.
end
let access : type a. a accessor -> a =
function
| I'm_M2 _ -> (module M1)
| I'm_M3 _ -> (module M1)
type wit = W
let do_it () =
let (module M2) = M2.(access ## I'm_M1 W) in
let (module M3) = M3.(access ## I'm_M1 W) in
Printf.printf "M1: M2: %d %s M3: %d %s\n" M2.a M2.b M3.a M3.b
end
and M2 : sig
module type M1's_sig = sig
val a : int
val b : string
end
module type M3's_sig = sig
val b : string
val c : float
end
type _ accessor =
| I'm_M1 : M1.wit -> (module M1's_sig) accessor
| I'm_M3 : M3.wit -> (module M3's_sig) accessor
val access : 'a accessor -> 'a
type wit
val do_it : unit -> unit
end = struct
module type M1's_sig = sig
val a : int
val b : string
end
module type M3's_sig = sig
val b : string
val c : float
end
type _ accessor =
| I'm_M1 : M1.wit -> (module M1's_sig) accessor
| I'm_M3 : M3.wit -> (module M3's_sig) accessor
module M2 = struct
let a = 2
let b = "2"
let c = 2.
end
let access : type a. a accessor -> a =
function
| I'm_M1 _ -> (module M2)
| I'm_M3 _ -> (module M2)
type wit = W
let do_it () =
let (module M1) = M1.(access ## I'm_M2 W) in
let (module M3) = M3.(access ## I'm_M2 W) in
Printf.printf "M2: M1: %d %f M3: %d %f\n" M1.a M1.c M3.a M3.c
end
and M3 : sig
module type M1's_sig = sig
val a : int
val b : string
end
module type M2's_sig = sig
val a : int
val c : float
end
type _ accessor =
| I'm_M1 : M1.wit -> (module M1's_sig) accessor
| I'm_M2 : M2.wit -> (module M2's_sig) accessor
val access : 'a accessor -> 'a
type wit
val do_it : unit -> unit
end = struct
module type M1's_sig = sig
val a : int
val b : string
end
module type M2's_sig = sig
val a : int
val c : float
end
type _ accessor =
| I'm_M1 : M1.wit -> (module M1's_sig) accessor
| I'm_M2 : M2.wit -> (module M2's_sig) accessor
module M3 = struct
let a = 3
let b = "3"
let c = 3.
end
let access : type a. a accessor -> a =
function
| I'm_M1 _ -> (module M3)
| I'm_M2 _ -> (module M3)
type wit = W
let do_it () =
let (module M1) = M1.(access ## I'm_M3 W) in
let (module M2) = M2.(access ## I'm_M3 W) in
Printf.printf "M3: M1: %s %f M2: %s %f\n" M1.b M1.c M2.b M2.c
end
let () =
M1.do_it ();
M2.do_it ();
M3.do_it ()