package ctypes

  1. Overview
  2. Docs
package ctypes
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file ctypes_std_views.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
(*
 * Copyright (c) 2013 Jeremy Yallop.
 *
 * This file is distributed under the terms of the MIT License.
 * See the file LICENSE for details.
 *)

let string_of_char_ptr (Ctypes_static.CPointer p) =
  Ctypes_std_view_stubs.string_of_cstring p

let char_ptr_of_string s =
  let p = Ctypes_std_view_stubs.cstring_of_string s in
  Ctypes_static.CPointer (Ctypes_ptr.Fat.make
                            ~managed:(Some (Obj.repr p)) ~reftyp:Ctypes_static.char
                     (Ctypes_memory_stubs.block_address p))

let string = Ctypes_static.(view (ptr (const char)))
  ~read:string_of_char_ptr ~write:char_ptr_of_string

let read_nullable t reftyp =
  let coerce = Ctypes_coerce.coerce Ctypes_static.(ptr reftyp) t in
  fun p -> if Ctypes_memory.is_null p then None else Some (coerce p)

let write_nullable t reftyp =
  let coerce = Ctypes_coerce.coerce t Ctypes_static.(ptr reftyp) in
  Ctypes_memory.(function None -> from_voidp reftyp null | Some f -> coerce f)

let nullable_view ?format_typ ?format t reftyp =
  let read = read_nullable t reftyp
  and write = write_nullable t reftyp
  in Ctypes_static.(view ~read ~write ?format_typ ?format (ptr reftyp))

let read_nullable_funptr t reftyp =
  let coerce = Ctypes_coerce.coerce (Ctypes_static.static_funptr reftyp) t in
  fun (Ctypes_static.Static_funptr p as ptr) ->
    if Ctypes_ptr.Fat.is_null p
    then None
    else Some (coerce ptr)

let write_nullable_funptr t reftyp =
  let coerce = Ctypes_coerce.coerce t Ctypes_static.(static_funptr reftyp) in
  function None -> Ctypes_static.Static_funptr
                     (Ctypes_ptr.Fat.make ~managed:None ~reftyp Ctypes_ptr.Raw.null)
         | Some f -> coerce f

let nullable_funptr_view ?format_typ ?format t reftyp =
  let read = read_nullable_funptr t reftyp
  and write = write_nullable_funptr t reftyp
  in Ctypes_static.(view ~read ~write ?format_typ ?format (static_funptr reftyp))

let ptr_opt t = nullable_view (Ctypes_static.ptr t) t

let string_opt = nullable_view string Ctypes_static.char

module type Signed_type =
sig
  include Signed.S
  val t : t Ctypes_static.typ
end

module type Unsigned_type =
sig
  include Unsigned.S
  val t : t Ctypes_static.typ
end

let signed_typedef name ~size : (module Signed_type) =
  match size with
    1 -> (module struct include Signed.Int
           let t = Ctypes_static.(typedef int8_t name) end)
  | 2 -> (module struct include Signed.Int
           let t = Ctypes_static.(typedef int16_t name) end)
  | 4 -> (module struct include Signed.Int32
           let t = Ctypes_static.(typedef int32_t name) end)
  | 8 -> (module struct include Signed.Int64
           let t = Ctypes_static.(typedef int64_t name) end)
  | n -> Printf.ksprintf failwith "size %d not supported for %s\n" n name

let unsigned_typedef name ~size : (module Unsigned_type) =
  match size with
  | 1 -> (module struct include Unsigned.UInt8
           let t = Ctypes_static.(typedef uint8_t name) end)
  | 2 -> (module struct include Unsigned.UInt16
           let t = Ctypes_static.(typedef uint16_t name) end)
  | 4 -> (module struct include Unsigned.UInt32
           let t = Ctypes_static.(typedef uint32_t name) end)
  | 8 -> (module struct include Unsigned.UInt64
           let t = Ctypes_static.(typedef uint64_t name) end)
  | n -> Printf.ksprintf failwith "size %d not supported for %s\n" n name

module Intptr = (val signed_typedef "intptr_t"
                    ~size:(Ctypes_std_view_stubs.intptr_t_size ()))
module Uintptr = (val unsigned_typedef "uintptr_t"
                    ~size:(Ctypes_std_view_stubs.uintptr_t_size ()))
let intptr_t = Intptr.t
let uintptr_t = Uintptr.t

module Ptrdiff = (val signed_typedef "ptrdiff_t"
                     ~size:(Ctypes_std_view_stubs.ptrdiff_t_size ()))
let ptrdiff_t = Ptrdiff.t