Source file g.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
[@@@warning "-9-27"]
include Ctypes
let lift x = x
open Ctypes_static

let rec field : type t a. t typ -> string -> a typ -> (a, t) field =
  fun s fname ftype -> match s, fname with
  | View { ty; _ }, _ ->
    let { ftype; foffset; fname } = field ty fname ftype in
    { ftype; foffset; fname }
  | _ -> failwith ("Unexpected field "^ fname)

let rec seal : type a. a typ -> unit = function
  | Struct { tag; spec = Complete _; _ } ->
    raise (ModifyingSealedType tag)
  | Union { utag; uspec = Some _; _ } ->
    raise (ModifyingSealedType utag)
  | View { ty; _ } -> seal ty
  | _ ->
    raise (Unsupported "Sealing a non-structured type")

type 'a const = 'a
let constant (type t) name (t : t typ) : t = match t, name with
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_PP_ALL" ->
    2
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_PP_ROOT" ->
    1
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_PP_NONE" ->
    0
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_BT_BPH" ->
    4
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_BT_BLB" ->
    3
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_BT_BFS" ->
    2
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_BT_DFS" ->
    1
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_BR_PCH" ->
    5
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_BR_DTH" ->
    4
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_BR_MFV" ->
    3
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_BR_LFV" ->
    2
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_BR_FFV" ->
    1
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_USE_NT" ->
    2
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_USE_AT" ->
    1
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_RT_FLIP" ->
    51
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_RT_HAR" ->
    34
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_RT_STD" ->
    17
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_PT_PSE" ->
    34
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_PT_STD" ->
    17
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_DUAL" ->
    3
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_DUALP" ->
    2
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_PRIMAL" ->
    1
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_MSG_DBG" ->
    4
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_MSG_ALL" ->
    3
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_MSG_ON" ->
    2
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_MSG_ERR" ->
    1
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_MSG_OFF" ->
    0
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_UNBND" ->
    6
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_OPT" ->
    5
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_NOFEAS" ->
    4
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_INFEAS" ->
    3
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_FEAS" ->
    2
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_UNDEF" ->
    1
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_FX" ->
    5
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_DB" ->
    4
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_UP" ->
    3
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_LO" ->
    2
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_FR" ->
    1
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_BV" ->
    3
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_IV" ->
    2
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_CV" ->
    1
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_MAX" ->
    2
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_MIN" ->
    1
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_OFF" ->
    0
  | Ctypes_static.Primitive Cstubs_internals.Int, "GLP_ON" ->
    1
  | _, s -> failwith ("unmatched constant: "^ s)

let enum (type a) name ?typedef ?unexpected (alist : (a * int64) list) =
  match name with
  | s ->
    failwith ("unmatched enum: "^ s)