Source file generated.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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
module CI = Cstubs_internals

external dlm_stubs__1_dlm_create_lockspace
  : _ CI.fatptr -> Unsigned.uint32 -> (CI.voidp * Signed.sint) Lwt_unix.job
  = "dlm_stubs__1_dlm_create_lockspace" 

external dlm_stubs__2_dlm_open_lockspace
  : _ CI.fatptr -> (CI.voidp * Signed.sint) Lwt_unix.job
  = "dlm_stubs__2_dlm_open_lockspace" 

external dlm_stubs__3_dlm_ls_pthread_init
  : _ CI.fatptr -> (int * Signed.sint) Lwt_unix.job
  = "dlm_stubs__3_dlm_ls_pthread_init" 

external dlm_stubs__4_dlm_release_lockspace
  : _ CI.fatptr -> _ CI.fatptr -> int -> (int * Signed.sint) Lwt_unix.job
  = "dlm_stubs__4_dlm_release_lockspace" 

external dlm_stubs__5_dlm_close_lockspace
  : _ CI.fatptr -> (int * Signed.sint) Lwt_unix.job
  = "dlm_stubs__5_dlm_close_lockspace" 

external dlm_stubs__6_dlm_ls_lockx
  : _ CI.fatptr -> Unsigned.uint32 -> _ CI.fatptr -> Unsigned.uint32 ->
    _ CI.fatptr -> Unsigned.uint -> Unsigned.uint32 -> _ CI.fatptr ->
    _ CI.fatptr -> _ CI.fatptr -> _ CI.fatptr -> _ CI.fatptr ->
    (int * Signed.sint) Lwt_unix.job
  = "dlm_stubs__6_dlm_ls_lockx_byte12" "dlm_stubs__6_dlm_ls_lockx" 

external dlm_stubs__7_dlm_ls_unlock_wait
  : _ CI.fatptr -> Unsigned.uint32 -> Unsigned.uint32 -> _ CI.fatptr ->
    (int * Signed.sint) Lwt_unix.job = "dlm_stubs__7_dlm_ls_unlock_wait" 

type 'a result = 'a
type 'a return = { lwt: ('a * Signed.sint) Lwt.t }
let box_lwt lwt = {lwt}
type 'a fn =
 | Returns  : 'a CI.typ   -> 'a return fn
 | Function : 'a CI.typ * 'b fn  -> ('a -> 'b) fn
let map_result f v = Lwt.map (fun (x, y) -> (f x, y)) v
let returning t = Returns t
let (@->) f p = Function (f, p)
let foreign : type a b. string -> (a -> b) fn -> (a -> b) =
  fun name t -> match t, name with
| Function
    (CI.Pointer _,
     Function
       (CI.Primitive CI.Uint32_t,
        Function
          (CI.Primitive CI.Uint32_t,
           Function (CI.Pointer _, Returns (CI.Primitive CI.Int))))),
  "dlm_ls_unlock_wait" ->
  (fun x1 x3 x4 x5 ->
    let CI.CPointer x6 = x5 in
    let CI.CPointer x2 = x1 in
    box_lwt
    (Lwt.bind
     (Lwt_unix.run_job (dlm_stubs__7_dlm_ls_unlock_wait x2 x3 x4 x6))
      (fun x7 -> (CI.use_value (x1, x3, x4, x5, x6, x2); Lwt.return x7))))
| Function
    (CI.Pointer _,
     Function
       (CI.Primitive CI.Uint32_t,
        Function
          (CI.Pointer _,
           Function
             (CI.Primitive CI.Uint32_t,
              Function
                (CI.View {CI.ty = CI.Pointer _; write = x15; _},
                 Function
                   (CI.Primitive CI.Uint,
                    Function
                      (CI.Primitive CI.Uint32_t,
                       Function
                         (CI.View {CI.ty = CI.Pointer _; write = x21; _},
                          Function
                            (CI.View {CI.ty = CI.Pointer _; write = x25; _},
                             Function
                               (CI.View
                                  {CI.ty = CI.Pointer _; write = x29; _},
                                Function
                                  (CI.View
                                     {CI.ty = CI.Pointer _; write = x33; _},
                                   Function
                                     (CI.View
                                        {CI.ty = CI.Pointer _; write = x37;
                                         _},
                                      Returns (CI.Primitive CI.Int))))))))))))),
  "dlm_ls_lockx" ->
  (fun x8 x10 x11 x13 x14 x18 x19 x20 x24 x28 x32 x36 ->
    let CI.CPointer x39 = x37 x36 in
    let CI.CPointer x35 = x33 x32 in
    let CI.CPointer x31 = x29 x28 in
    let CI.CPointer x27 = x25 x24 in
    let CI.CPointer x23 = x21 x20 in
    let CI.CPointer x17 = x15 x14 in
    let CI.CPointer x12 = x11 in
    let CI.CPointer x9 = x8 in
    let x16 = x17 in
    let x22 = x23 in
    let x26 = x27 in
    let x30 = x31 in
    let x34 = x35 in
    let x38 = x39 in
    box_lwt
    (Lwt.bind
     (Lwt_unix.run_job
       (dlm_stubs__6_dlm_ls_lockx x9 x10 x12 x13 x16 x18 x19 x22 x26 x30 x34
         x38))
      (fun x40 ->
        (CI.use_value
         (x8, x10, x11, x13, x14, x18, x19, x20, x24, x28, x32, x36, x39,
          x35, x31, x27, x23, x17, x12, x9, x16, x22, x26, x30, x34, x38);
         Lwt.return x40))))
| Function (CI.Pointer _, Returns (CI.Primitive CI.Int)),
  "dlm_close_lockspace" ->
  (fun x41 ->
    let CI.CPointer x42 = x41 in
    box_lwt
    (Lwt.bind (Lwt_unix.run_job (dlm_stubs__5_dlm_close_lockspace x42))
      (fun x43 -> (CI.use_value (x41, x42); Lwt.return x43))))
| Function
    (CI.View {CI.ty = CI.Pointer _; write = x45; _},
     Function
       (CI.Pointer _,
        Function (CI.Primitive CI.Int, Returns (CI.Primitive CI.Int)))),
  "dlm_release_lockspace" ->
  (fun x44 x48 x50 ->
    let CI.CPointer x49 = x48 in
    let CI.CPointer x47 = x45 x44 in
    let x46 = x47 in
    box_lwt
    (Lwt.bind
     (Lwt_unix.run_job (dlm_stubs__4_dlm_release_lockspace x46 x49 x50))
      (fun x51 ->
        (CI.use_value (x44, x48, x50, x49, x47, x46); Lwt.return x51))))
| Function (CI.Pointer _, Returns (CI.Primitive CI.Int)),
  "dlm_ls_pthread_init" ->
  (fun x52 ->
    let CI.CPointer x53 = x52 in
    box_lwt
    (Lwt.bind (Lwt_unix.run_job (dlm_stubs__3_dlm_ls_pthread_init x53))
      (fun x54 -> (CI.use_value (x52, x53); Lwt.return x54))))
| Function
    (CI.View {CI.ty = CI.Pointer _; write = x56; _},
     Returns (CI.View {CI.ty = CI.Pointer x59; read = x60; _})),
  "dlm_open_lockspace" ->
  (fun x55 ->
    let CI.CPointer x58 = x56 x55 in
    let x57 = x58 in
    box_lwt
    (Lwt.bind
     (map_result x60
       (map_result (CI.make_ptr x59)
         (Lwt_unix.run_job (dlm_stubs__2_dlm_open_lockspace x57))))
      (fun x61 -> (CI.use_value (x55, x58, x57); Lwt.return x61))))
| Function
    (CI.View {CI.ty = CI.Pointer _; write = x63; _},
     Function
       (CI.View {CI.ty = CI.Primitive CI.Uint32_t; write = x67; _},
        Returns (CI.View {CI.ty = CI.Pointer x69; read = x70; _}))),
  "dlm_create_lockspace" ->
  (fun x62 x66 ->
    let CI.CPointer x65 = x63 x62 in
    let x64 = x65 in
    let x68 = x67 x66 in
    box_lwt
    (Lwt.bind
     (map_result x70
       (map_result (CI.make_ptr x69)
         (Lwt_unix.run_job (dlm_stubs__1_dlm_create_lockspace x64 x68))))
      (fun x71 -> (CI.use_value (x62, x66, x65, x64, x68); Lwt.return x71))))
| _, s ->  Printf.ksprintf failwith "No match for %s" s


let foreign_value : type a. string -> a Ctypes.typ -> a Ctypes.ptr =
  fun name t -> match t, name with
| _, s ->  Printf.ksprintf failwith "No match for %s" s