OCaml 中的好友模块

Question

我目前有两个“层”模块表示数据库中的标识符-数据关系。

第一层定义标识符类型，例如IdUser.t 或IdPost.t，而第二层定义数据类型，例如User.t 或Post.t。我需要在第二层的模块之前编译第一层的所有模块，因为Post.t 必须持有其作者的IdUser.t，User.t 持有他最后五个帖子的IdPost.t参观了。

目前，IdUser.t 提供了只能由 User.t 使用的功能，例如将 IdUser.t 转换为 IdUser.current 的功能：出于安全原因，此转换只能由以下人员执行函数User.check_password。由于IdUser 和User 是独立的模块，我需要将这些功能定义为公共函数并依赖约定来避免在User 之外的任何地方调用它们，这很脏。 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

有没有办法在IdUser 中定义一个只能从模块User 中调用的current_of_t : t -> current 函数？

编辑：这是 one 一对模块的简化示例，但是对于不能推广到多对的单对模块有一个明显的解决方案，我需要为多对解决这个问题 - 实际上大约 18 对......所以，我将其扩展为 two 对的示例。

Answer 1

所以IdUser实际上是一个存在类型：对于User，存在一个类型 IdUser.current 以便公众 IdUser.t 可以被提升到它。有几种方法可以对此进行编码：如果静态管理依赖关系就足够了，或者像 Gasche 所示的那样对 User 进行函数化，或者如果您需要更多动态，则使用一流的模块或对象。

为了方便起见，我将进一步研究 Gasche 的示例，使用 private type abbreviations 并展示如何利用半透明性来避免过度私有化实现类型。首先，这可能是一个限制，我想声明一个持久的 ADT 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

有了这个，我可以使用 IDs 的具体类型定义 Posts 的类型，但使用 ADT 来执行与持久性相关的业务规则：

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

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

请注意，在这两种情况下，我都使用具体但私有的 ID 类型。将所有这些绑定在一起是一个简单的问题，即使用它们的持久性规则实际定义 ID ADT：

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)

此时，为了完全解耦依赖关系，您可能需要可以从此模块导出的 USER 和 POST 的签名，但添加它们很简单。

Answer 2

似乎至少对您的简化示例有效的一种方法是将IdUser 和User 分组到同一个模块中：

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

在UserAndFriends 的签名中隐藏危险函数可以得到你想要的结果。如果您不想制作包含IdUser 和User 的大文件，可以使用ocamlc 的选项-pack 创建UserAndFriends。请注意，在这种情况下，您必须仔细制作 Makefile，以便在编译 Post 时，IdUser 和 User 的 .cmi 文件不可见。我不是 Frama-C 的 Makefile 专家，但我认为我们使用单独的目录并仔细定位编译器选项 -I。

Answer 3

我建议您通过IdUser 模块的签名来参数化Post（可能还有User 以保持一致性）：对于User，您可以使用带有current_of_t 的签名，而对于Post 使用不带有Post 的签名.

这保证Post不使用IdUser私有功能，但IdUser的公共接口还是太放任自流了。但是通过这种设置，您已经反转了依赖关系，IdUser（敏感部分）可以直接控制其使用，将自己（与私有部分）交给IdUser，并将公共签名限制为公共部分。

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

编辑：Pascal Cuoq 的并发——在时间意义上——解决方案也非常好。实际上它更简单并且样板更少。我的解决方案添加了一个抽象，允许稍微模块化，因为您可以独立于IdUser 定义User。

我认为哪种解决方案最好可能取决于具体的应用。如果您有很多不同的模块使用PrivateIdUser 私有信息，那么使用函子分别编写它们而不是将每个人捆绑在同一个模块中可能是个好主意。如果只有User 需要在“私有区域”并且不是很大，那么Pascal 的解决方案是一个更好的选择。

最后，虽然强制显式 Private 和 Public 接口可以被视为额外的负担，但它也是一种使不同模块的访问属性更加明确的方法，而不是使用模块层次结构中的位置。

Answer 4

可以通过递归模块、一级模块和 GADT 的组合来实现对签名的细粒度控制，但限制是所有模块都应该在同一个顶级模块中并解包 first-递归模块中的类模块应该在每个函数中单独完成（而不是在模块级别，因为它会导致运行时异常 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 ()