Add support for unknown integer types.

Makefile.tests

@@ -246,6 +246,7 @@ test-enums-struct-stubs: $$(LIB_TARGETS)
 test-enums-stubs.dir  = tests/test-enums/stubs
 test-enums-stubs.threads = yes
 test-enums-stubs.extra_mls = generated_struct_bindings.ml
+test-enums-stubs.deps = integers
 test-enums-stubs.subproject_deps = ctypes \
    test-enums-struct-stubs \
    test-enums-struct-stubs-generator \

src/cstubs/cstubs_structs.ml

@@ -14,6 +14,12 @@ sig
   type 'a const
   val constant : string -> 'a typ -> 'a const
 
+  module type signed = sig include Signed.S val t : t typ end
+  val signed  : string -> (module signed)
+
+  module type unsigned = sig include Unsigned.S val t : t typ end
+  val unsigned : string -> (module unsigned)
+
   val enum : string -> ?typedef:bool -> ?unexpected:(int64 -> 'a) -> ('a * int64 const) list -> 'a typ
 end
 
@@ -233,22 +239,59 @@ let write_enums fmt enums =
     ["  | s ->";
      "    failwith (\"unmatched enum: \"^ s)"]
 
+let write_signeds fmt signeds =
+  let case name =
+    printf1 fmt
+      (Format.sprintf
+         "  | %S -> \n    Cstubs_internals.build_signed_type %S Ctypes_static.%%s\n" name name)
+      (fun fmt ->
+         Format.fprintf fmt
+           "ctypes_arithmetic_type_name(CTYPES_CLASSIFY_ARITHMETIC_TYPE(%s))" name)
+  in
+  cases fmt signeds
+    ["";
+     "module type signed = sig include Signed.S val t : t typ end";
+     "let signed (type a) name = match name with"]
+    ~case
+    ["  | s -> failwith (\"unmatched signed type: \"^ s)"]
+
+let write_unsigneds fmt unsigneds =
+  let case name =
+    printf1 fmt
+      (Format.sprintf
+         "  | %S -> \n    Cstubs_internals.build_unsigned_type %S Ctypes_static.%%s\n" name name)
+      (fun fmt ->
+         Format.fprintf fmt
+           "ctypes_arithmetic_type_name(CTYPES_CLASSIFY_ARITHMETIC_TYPE(%s))" name)
+  in
+  cases fmt unsigneds
+    ["";
+     "module type unsigned = sig include Unsigned.S val t : t typ end";
+     "let unsigned (type a) name = match name with"]
+    ~case
+    ["  | s -> failwith (\"unmatched unsigned type: \"^ s)"]
+
 
-let write_ml fmt fields structures consts enums =
+let write_ml fmt fields structures consts enums signeds unsigneds =
   List.iter (puts fmt) mlprologue;
   write_field fmt fields;
   write_seal fmt structures;
   write_consts fmt consts;
-  write_enums fmt enums
+  write_enums fmt enums;
+  write_signeds fmt signeds;
+  write_unsigneds fmt unsigneds
+
 
 let gen_c () =
   let fields = ref []
   and structures = ref []
   and consts = ref []
   and enums = ref []
+  and signeds = ref []
+  and unsigneds = ref []
   in
   let finally fmt = write_c fmt (fun fmt ->
-                    write_ml fmt !fields !structures !consts !enums) in
+                    write_ml fmt !fields !structures !consts !enums !signeds !unsigneds) in
   let m =
     (module struct
       include Ctypes
@@ -281,6 +324,17 @@ let gen_c () =
 
       type _ const = unit
       let constant name ty  = consts := (name, Ctypes_static.BoxedType ty) :: !consts
+
+      module type signed = sig include Signed.S val t : t typ end
+      let signed name : (module signed) =
+        let () = signeds := name :: !signeds in
+        (module struct include Signed.Int32 let t = int32_t end) (* arbitrary *)
+
+      module type unsigned = sig include Unsigned.S val t : t typ end
+      let unsigned name : (module unsigned) =
+        let () = unsigneds := name :: !unsigneds in
+        (module struct include Unsigned.UInt32 let t = uint32_t end) (* arbitrary *)
+
       let enum name ?(typedef=false) ?unexpected alist =
         let () = enums := (name, typedef) :: !enums in
         let format_typ k fmt = Format.fprintf fmt "%s%s%t"

src/cstubs/cstubs_structs.mli

@@ -12,6 +12,12 @@ sig
   type 'a const
   val constant : string -> 'a typ -> 'a const
 
+  module type signed = sig include Signed.S val t : t typ end
+  val signed  : string -> (module signed)
+
+  module type unsigned = sig include Unsigned.S val t : t typ end
+  val unsigned : string -> (module unsigned)
+
   val enum : string -> ?typedef:bool -> ?unexpected:(int64 -> 'a) -> ('a * int64 const) list -> 'a typ
 end
 

src/ctypes/cstubs_internals.ml

@@ -63,6 +63,37 @@ let int64_of_uint32 x = Int64.of_string (Unsigned.UInt32.to_string x)
 let uint64_of_int64 = Unsigned.UInt64.of_int64
 let int64_of_uint64 = Unsigned.UInt64.to_int64
 
+module type signed = sig include Signed.S val t : t typ end
+let build_signed_type name underlying : (module signed) =
+  let wrong kind =
+    Printf.ksprintf failwith "Signed type detected as %s type: %s" kind name
+  in
+  match underlying with
+    Ctypes_static.Uint8 -> wrong "unsigned"
+  | Ctypes_static.Uint16 -> wrong "unsigned"
+  | Ctypes_static.Uint32 -> wrong "unsigned"
+  | Ctypes_static.Uint64 -> wrong "unsigned"
+  | Ctypes_static.Int8 -> (module struct include Signed.Int let t = Ctypes.int8_t end)
+  | Ctypes_static.Int16 -> (module struct include Signed.Int let t = Ctypes.int16_t end)
+  | Ctypes_static.Int32 -> (module struct include Signed.Int32 let t = Ctypes.int32_t end)
+  | Ctypes_static.Int64 -> (module struct include Signed.Int64 let t = Ctypes.int64_t end)
+  | Ctypes_static.Float | Ctypes_static.Double -> wrong "floating"
+
+
+module type unsigned = sig include Unsigned.S val t : t typ end
+let build_unsigned_type name underlying : (module unsigned) =
+  match underlying with
+    Ctypes_static.Int8 -> (module struct include Signed.Int let t = Ctypes.int8_t end)
+  | Ctypes_static.Int16 -> (module struct include Signed.Int let t = Ctypes.int16_t end)
+  | Ctypes_static.Int32 -> (module struct include Signed.Int32 let t = Ctypes.int32_t end)
+  | Ctypes_static.Int64 -> (module struct include Signed.Int64 let t = Ctypes.int64_t end)
+  | Ctypes_static.Uint8 -> (module struct include Unsigned.UInt8 let t = Ctypes.uint8_t end)
+  | Ctypes_static.Uint16 -> (module struct include Unsigned.UInt16 let t = Ctypes.uint16_t end)
+  | Ctypes_static.Uint32 -> (module struct include Unsigned.UInt32 let t = Ctypes.uint32_t end)
+  | Ctypes_static.Uint64 -> (module struct include Unsigned.UInt64 let t = Ctypes.uint64_t end)
+  | Ctypes_static.Float | Ctypes_static.Double ->
+    Printf.ksprintf failwith "Unsigned type detected as floating type: %s" name
+
 let build_enum_type name underlying ?(typedef=false) ?unexpected alist =
   let build_view t coerce uncoerce =
     let unexpected = match unexpected with

src/ctypes/cstubs_internals.mli

@@ -91,6 +91,14 @@ type 'a prim = 'a Ctypes_primitive_types.prim =
 | Complex64 : Complex.t prim
 | Complexld : ComplexL.t prim
 
+module type signed = sig include Signed.S val t : t typ end
+val build_signed_type :
+  string -> Ctypes_static.arithmetic -> (module signed)
+
+module type unsigned = sig include Unsigned.S val t : t typ end
+val build_unsigned_type :
+  string -> Ctypes_static.arithmetic -> (module unsigned)
+
 val build_enum_type :
   string -> Ctypes_static.arithmetic -> ?typedef:bool ->
   ?unexpected:(int64 -> 'a) -> ('a * int64) list -> 'a typ

src/ctypes/ctypes.ml

@@ -39,6 +39,14 @@ sig
 
   type 'a const
   val constant : string -> 'a typ -> 'a const
+
+  module type signed = sig include Signed.S val t : t typ end
+  val signed  : string -> (module signed)
+
+  module type unsigned = sig include Unsigned.S val t : t typ end
+  val unsigned : string -> (module unsigned)
+
   val enum : string -> ?typedef:bool ->
     ?unexpected:(int64 -> 'a) -> ('a * int64 const) list -> 'a typ
 end
+

src/ctypes/ctypes.mli

@@ -517,6 +517,12 @@ sig
 
          warning: overflow in implicit constant conversion *)
 
+  module type signed = sig include Signed.S val t : t typ end
+  val signed  : string -> (module signed)
+
+  module type unsigned = sig include Unsigned.S val t : t typ end
+  val unsigned : string -> (module unsigned)
+
   val enum : string -> ?typedef:bool ->
     ?unexpected:(int64 -> 'a) -> ('a * int64 const) list -> 'a typ
   (** [enum name ?unexpected alist] builds a type representation for the