Hygiene: Add MESSAGE_STORAGE. No leak Uint32/64

.gitignore

@@ -1,3 +1,4 @@
 _build
+_opam
 .merlin
 capnp.install

CHANGES.md

@@ -1,3 +1,13 @@
+# PENDING
+
+New features:
+
+- Expose module type `MESSAGE_STORAGE` which was used as a `Capnp.Message.Make`
+  functor parameter but was previously hidden in `Capnp__MessageStorage.S`.
+  Expose module `ListStorageType` that was previously hidden in
+  `Capnp.MessageSig.ListStorageType`.
+  Stop leaking `Uint32` and `Uint64` in module types. (@jonahbeckford #91)
+
 # v3.6.0
 
 - Update README to talk about stdint, not uint (reported by @liyishuai).  

src/runtime/builderInc.ml

@@ -34,9 +34,6 @@
    pointer will cause struct storage to be immediately allocated if that pointer
    was null). *)
 
-module Uint32 = Stdint.Uint32
-module Uint64 = Stdint.Uint64
-
 type ro = Message.ro
 type rw = Message.rw
 let invalid_msg = Message.invalid_msg
@@ -307,22 +304,22 @@ module Make (NM : RPC.S) = struct
       numeric lxor default
 
     let get_uint32
-        ~(default : Uint32.t)
+        ~(default : Stdint.Uint32.t)
         (struct_storage : (rw, _) NM.StructStorage.t)
         (byte_ofs : int)
-      : Uint32.t =
+      : Stdint.Uint32.t =
       let data = struct_storage.NM.StructStorage.data in
       let numeric = NM.Slice.get_uint32 data byte_ofs in
-      Uint32.logxor numeric default
+      Stdint.Uint32.logxor numeric default
 
     let get_uint64
-        ~(default : Uint64.t)
+        ~(default : Stdint.Uint64.t)
         (struct_storage : (rw, _) NM.StructStorage.t)
         (byte_ofs : int)
-      : Uint64.t =
+      : Stdint.Uint64.t =
       let data = struct_storage.NM.StructStorage.data in
       let numeric = NM.Slice.get_uint64 data byte_ofs in
-      Uint64.logxor numeric default
+      Stdint.Uint64.logxor numeric default
 
     let get_float32
         ~(default_bits : int32)
@@ -442,25 +439,25 @@ module Make (NM : RPC.S) = struct
 
     let set_uint32
         ?(discr : Discr.t option)
-        ~(default : Uint32.t)
+        ~(default : Stdint.Uint32.t)
         (struct_storage : (rw, _) NM.StructStorage.t)
         (byte_ofs : int)
-        (value : Uint32.t)
+        (value : Stdint.Uint32.t)
       : unit =
       let data = struct_storage.NM.StructStorage.data in
       let () = set_opt_discriminant data discr in
-      NM.Slice.set_uint32 data byte_ofs (Uint32.logxor value default)
+      NM.Slice.set_uint32 data byte_ofs (Stdint.Uint32.logxor value default)
 
     let set_uint64
         ?(discr : Discr.t option)
-        ~(default : Uint64.t)
+        ~(default : Stdint.Uint64.t)
         (struct_storage : (rw, _) NM.StructStorage.t)
         (byte_ofs : int)
-        (value : Uint64.t)
+        (value : Stdint.Uint64.t)
       : unit =
       let data = struct_storage.NM.StructStorage.data in
       let () = set_opt_discriminant data discr in
-      NM.Slice.set_uint64 data byte_ofs (Uint64.logxor value default)
+      NM.Slice.set_uint64 data byte_ofs (Stdint.Uint64.logxor value default)
 
     let set_float32
         ?(discr : Discr.t option)
@@ -666,15 +663,15 @@ module Make (NM : RPC.S) = struct
         ?(default : ro DM.ListStorage.t option)
         (struct_storage : (rw, _) NM.StructStorage.t)
         (pointer_word : int)
-      : (rw, Uint32.t, rw NM.ListStorage.t) InnerArray.t =
+      : (rw, Stdint.Uint32.t, rw NM.ListStorage.t) InnerArray.t =
       get_list ?default ~storage_type:ListStorageType.Bytes4
         ~codecs:uint32_list_codecs struct_storage pointer_word
 
     let get_uint64_list
         ?(default : ro DM.ListStorage.t option)
         (struct_storage : (rw, _) NM.StructStorage.t)
         (pointer_word : int)
-      : (rw, Uint64.t, rw NM.ListStorage.t) InnerArray.t =
+      : (rw, Stdint.Uint64.t, rw NM.ListStorage.t) InnerArray.t =
       get_list ?default ~storage_type:ListStorageType.Bytes8
         ~codecs:uint64_list_codecs struct_storage pointer_word
 
@@ -976,17 +973,17 @@ module Make (NM : RPC.S) = struct
         ?(discr : Discr.t option)
         (struct_storage : (rw, _) NM.StructStorage.t)
         (pointer_word : int)
-        (value : ('cap1, Uint32.t, 'cap2 NM.ListStorage.t) InnerArray.t)
-      : (rw, Uint32.t, rw NM.ListStorage.t) InnerArray.t =
+        (value : ('cap1, Stdint.Uint32.t, 'cap2 NM.ListStorage.t) InnerArray.t)
+      : (rw, Stdint.Uint32.t, rw NM.ListStorage.t) InnerArray.t =
       set_list ?discr ~storage_type:ListStorageType.Bytes4 ~codecs:uint32_list_codecs
         struct_storage pointer_word value
 
     let set_uint64_list
         ?(discr : Discr.t option)
         (struct_storage : (rw, _) NM.StructStorage.t)
         (pointer_word : int)
-        (value : ('cap1, Uint64.t, 'cap2 NM.ListStorage.t) InnerArray.t)
-      : (rw, Uint64.t, rw NM.ListStorage.t) InnerArray.t =
+        (value : ('cap1, Stdint.Uint64.t, 'cap2 NM.ListStorage.t) InnerArray.t)
+      : (rw, Stdint.Uint64.t, rw NM.ListStorage.t) InnerArray.t =
       set_list ?discr ~storage_type:ListStorageType.Bytes8 ~codecs:uint64_list_codecs
         struct_storage pointer_word value
 
@@ -1238,7 +1235,7 @@ module Make (NM : RPC.S) = struct
         (struct_storage : (rw, _) NM.StructStorage.t)
         (pointer_word : int)
         (num_elements : int)
-      : (rw, Uint32.t, rw NM.ListStorage.t) InnerArray.t =
+      : (rw, Stdint.Uint32.t, rw NM.ListStorage.t) InnerArray.t =
       init_list ?discr ~storage_type:ListStorageType.Bytes4 ~codecs:uint32_list_codecs
         struct_storage pointer_word num_elements
 
@@ -1247,7 +1244,7 @@ module Make (NM : RPC.S) = struct
         (struct_storage : (rw, _) NM.StructStorage.t)
         (pointer_word : int)
         (num_elements : int)
-      : (rw, Uint64.t, rw NM.ListStorage.t) InnerArray.t =
+      : (rw, Stdint.Uint64.t, rw NM.ListStorage.t) InnerArray.t =
       init_list ?discr ~storage_type:ListStorageType.Bytes8 ~codecs:uint64_list_codecs
         struct_storage pointer_word num_elements
 

src/runtime/bytesStorage.ml

@@ -29,9 +29,6 @@
 
 open EndianBytes
 
-module Uint32 = Stdint.Uint32
-module Uint64 = Stdint.Uint64
-
 type t = Bytes.t
 
 let alloc size = Bytes.make size '\x00'
@@ -41,16 +38,16 @@ let length = Bytes.length
 
 let get_uint8      = LittleEndian.get_uint8
 let get_uint16     = LittleEndian.get_uint16
-let get_uint32 s i = Uint32.of_int32 (LittleEndian.get_int32 s i)
-let get_uint64 s i = Uint64.of_int64 (LittleEndian.get_int64 s i)
+let get_uint32 s i = Stdint.Uint32.of_int32 (LittleEndian.get_int32 s i)
+let get_uint64 s i = Stdint.Uint64.of_int64 (LittleEndian.get_int64 s i)
 
 let get_int8  = LittleEndian.get_int8
 let get_int16 = LittleEndian.get_int16
 let get_int32 = LittleEndian.get_int32
 let get_int64 = LittleEndian.get_int64
 
-let set_uint32 s i v = LittleEndian.set_int32 s i (Uint32.to_int32 v)
-let set_uint64 s i v = LittleEndian.set_int64 s i (Uint64.to_int64 v)
+let set_uint32 s i v = LittleEndian.set_int32 s i (Stdint.Uint32.to_int32 v)
+let set_uint64 s i v = LittleEndian.set_int64 s i (Stdint.Uint64.to_int64 v)
 
 let set_int32 = LittleEndian.set_int32
 let set_int64 = LittleEndian.set_int64

src/runtime/bytesStorage.mli

@@ -0,0 +1 @@
+include MessageStorage.S with type t = Bytes.t

src/runtime/capnp.ml

@@ -27,12 +27,17 @@
  * POSSIBILITY OF SUCH DAMAGE.
  ******************************************************************************)
 
+(** [MESSAGE_STORAGE] is the module type of underlying storage used for
+    message segments. *)
+module type MESSAGE_STORAGE = MessageStorage.S
+
 module MessageSig   = MessageSig
 module Message      = Message
 module Array        = CArray
 module BytesStorage = BytesStorage
 module BytesMessage = Message.BytesMessage
 module Codecs       = Codecs
+module ListStorageType = ListStorageType
 module RPC          = RPC
 module Runtime = struct
   module BuilderInc      = BuilderInc

src/runtime/codecs.ml

@@ -101,7 +101,7 @@ module UncompStream = struct
           in
           let () =
             if segment_count > (max_int / 4) - 2 then
-              Util.out_of_int_range "Uint32.to_int"
+              Util.out_of_int_range "Stdint.Uint32.to_int"
           in
           let segment_count = segment_count + 1 in
           let frame_header_size =

src/runtime/listStorageType.ml

@@ -3,23 +3,13 @@ let sizeof_uint64 = 8
 
 type t =
   | Empty
-  (** list(void), no storage required *)
-
   | Bit
-  (** list(bool), tightly packed bits *)
-
   | Bytes1
   | Bytes2
   | Bytes4
   | Bytes8
-  (** either primitive values or a data-only struct *)
-
   | Pointer
-  (** either a pointer to an external object, or a pointer-only struct *)
-
   | Composite of int * int
-  (** typical struct; parameters are per-element word size for data section
-      and pointers section, respectively *)
 
 let get_byte_count storage_type =
   match storage_type with

src/runtime/listStorageType.mli

@@ -0,0 +1,25 @@
+(** @canonical Capnp.ListStorageType  *)
+
+type t =
+  | Empty
+  (** list(void), no storage required *)
+
+  | Bit
+  (** list(bool), tightly packed bits *)
+
+  | Bytes1
+  | Bytes2
+  | Bytes4
+  | Bytes8
+  (** either primitive values or a data-only struct *)
+
+  | Pointer
+  (** either a pointer to an external object, or a pointer-only struct *)
+
+  | Composite of int * int
+  (** typical struct; parameters are per-element word size for data section
+      and pointers section, respectively *)
+
+val get_byte_count : t -> int
+
+val to_string : t -> string

src/runtime/message.ml

@@ -27,8 +27,6 @@
  * POSSIBILITY OF SUCH DAMAGE.
  ******************************************************************************)
 
-module Uint32 = Stdint.Uint32
-
 type ro = MessageSig.ro
 type rw = MessageSig.rw
 
@@ -410,7 +408,7 @@ module Make (Storage : MessageStorage.S) = struct
       | None
       | List of 'cap ListStorage.t
       | Struct of ('cap, 'a) StructStorage.t
-      | Capability of Uint32.t
+      | Capability of Stdint.Uint32.t
   end
 
 end [@@inline]

src/runtime/messageSig.ml

@@ -27,9 +27,6 @@
  * POSSIBILITY OF SUCH DAMAGE.
  ******************************************************************************)
 
-module Uint32 = Stdint.Uint32
-module Uint64 = Stdint.Uint64
-
 type ro
 type rw
 
@@ -72,8 +69,8 @@ module type SEGMENT = sig
 
   val get_uint8  : 'cap t -> int -> int
   val get_uint16 : 'cap t -> int -> int
-  val get_uint32 : 'cap t -> int -> Uint32.t
-  val get_uint64 : 'cap t -> int -> Uint64.t
+  val get_uint32 : 'cap t -> int -> Stdint.Uint32.t
+  val get_uint64 : 'cap t -> int -> Stdint.Uint64.t
 
   (** [get_intXX s ofs] reads a signed integer of the specified width,
       starting at byte offset [ofs] within message segment [s]. *)
@@ -89,8 +86,8 @@ module type SEGMENT = sig
 
   val set_uint8  : rw t -> int -> int -> unit
   val set_uint16 : rw t -> int -> int -> unit
-  val set_uint32 : rw t -> int -> Uint32.t -> unit
-  val set_uint64 : rw t -> int -> Uint64.t -> unit
+  val set_uint32 : rw t -> int -> Stdint.Uint32.t -> unit
+  val set_uint64 : rw t -> int -> Stdint.Uint64.t -> unit
 
   (** [set_intXX s ofs val] writes the value of the width-restricted
       signed integer [val] into read/write-qualified message segment [s],
@@ -241,8 +238,8 @@ module type SLICE = sig
 
   val get_uint8  : 'cap t -> int -> int
   val get_uint16 : 'cap t -> int -> int
-  val get_uint32 : 'cap t -> int -> Uint32.t
-  val get_uint64 : 'cap t -> int -> Uint64.t
+  val get_uint32 : 'cap t -> int -> Stdint.Uint32.t
+  val get_uint64 : 'cap t -> int -> Stdint.Uint64.t
 
   (** [get_intXX s ofs] reads a signed integer of the specified width,
       starting at byte offset [ofs] within the [slice]. *)
@@ -258,8 +255,8 @@ module type SLICE = sig
 
   val set_uint8  : rw t -> int -> int -> unit
   val set_uint16 : rw t -> int -> int -> unit
-  val set_uint32 : rw t -> int -> Uint32.t -> unit
-  val set_uint64 : rw t -> int -> Uint64.t -> unit
+  val set_uint32 : rw t -> int -> Stdint.Uint32.t -> unit
+  val set_uint64 : rw t -> int -> Stdint.Uint64.t -> unit
 
   (** [set_intXX s ofs val] writes the value of the width-restricted
       signed integer [val] into the read/write-qualified [slice],
@@ -335,7 +332,7 @@ module type S = sig
       | None
       | List of 'cap ListStorage.t
       | Struct of ('cap, 'a) StructStorage.t
-      | Capability of Uint32.t
+      | Capability of Stdint.Uint32.t
   end
 end
 

src/runtime/messageStorage.ml

@@ -27,10 +27,9 @@
  * POSSIBILITY OF SUCH DAMAGE.
  ******************************************************************************)
 
-module Uint32 = Stdint.Uint32
-module Uint64 = Stdint.Uint64
-
 module type S = sig
+  (** @canonical Capnp.MESSAGE_STORAGE *)
+
   (** [t] is the type of the underlying storage used for message segments. *)
   type t
 
@@ -51,8 +50,8 @@ module type S = sig
 
   val get_uint8  : t -> int -> int
   val get_uint16 : t -> int -> int
-  val get_uint32 : t -> int -> Uint32.t
-  val get_uint64 : t -> int -> Uint64.t
+  val get_uint32 : t -> int -> Stdint.Uint32.t
+  val get_uint64 : t -> int -> Stdint.Uint64.t
 
   (** [get_intXX s ofs] reads a signed integer of the specified width,
       starting at byte offset [ofs] within the message segment. *)
@@ -68,8 +67,8 @@ module type S = sig
 
   val set_uint8  : t -> int -> int -> unit
   val set_uint16 : t -> int -> int -> unit
-  val set_uint32 : t -> int -> Uint32.t -> unit
-  val set_uint64 : t -> int -> Uint64.t -> unit
+  val set_uint32 : t -> int -> Stdint.Uint32.t -> unit
+  val set_uint64 : t -> int -> Stdint.Uint64.t -> unit
 
   (** [set_intXX s ofs val] writes the value of the width-restricted
       signed integer [val] into the message segment, starting at