Source file generated_types.ml

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
  | Struct ({ tag = "dlm_lksb"} as s'), "sb_lvbptr" ->
    let f = {ftype; fname; foffset = 16} in 
    (s'.fields <- BoxedField f :: s'.fields; f)
  | Struct ({ tag = "dlm_lksb"} as s'), "sb_flags" ->
    let f = {ftype; fname; foffset = 8} in 
    (s'.fields <- BoxedField f :: s'.fields; f)
  | Struct ({ tag = "dlm_lksb"} as s'), "sb_lkid" ->
    let f = {ftype; fname; foffset = 4} in 
    (s'.fields <- BoxedField f :: s'.fields; f)
  | Struct ({ tag = "dlm_lksb"} as s'), "sb_status" ->
    let f = {ftype; fname; foffset = 0} in 
    (s'.fields <- BoxedField f :: s'.fields; f)
  | 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 = "dlm_lksb"; spec = Incomplete _ } as s') ->
    s'.spec <- Complete { size = 24; align = 8 }
  | 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.Uint32_t, "DLM_LSFL_TIMEWARN" ->
    Unsigned.UInt32.of_string "2"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_WAIT" ->
    Unsigned.UInt32.of_string "2147483648"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_TIMEOUT" ->
    Unsigned.UInt32.of_string "262144"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_ALTCW" ->
    Unsigned.UInt32.of_string "65536"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_ALTPR" ->
    Unsigned.UInt32.of_string "32768"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_NOORDER" ->
    Unsigned.UInt32.of_string "8192"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_HEADQUE" ->
    Unsigned.UInt32.of_string "4096"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_NOQUEUEBAST" ->
    Unsigned.UInt32.of_string "2048"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_NODLCKBLK" ->
    Unsigned.UInt32.of_string "512"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_NODLCKWT" ->
    Unsigned.UInt32.of_string "256"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_CONVDEADLK" ->
    Unsigned.UInt32.of_string "64"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_PERSISTENT" ->
    Unsigned.UInt32.of_string "128"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_EXPEDITE" ->
    Unsigned.UInt32.of_string "1024"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_QUECVT" ->
    Unsigned.UInt32.of_string "16"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_VALBLK" ->
    Unsigned.UInt32.of_string "8"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_CONVERT" ->
    Unsigned.UInt32.of_string "4"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKF_NOQUEUE" ->
    Unsigned.UInt32.of_string "1"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKM_EXMODE" ->
    Unsigned.UInt32.of_string "5"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKM_PWMODE" ->
    Unsigned.UInt32.of_string "4"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKM_PRMODE" ->
    Unsigned.UInt32.of_string "3"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKM_CWMODE" ->
    Unsigned.UInt32.of_string "2"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKM_CRMODE" ->
    Unsigned.UInt32.of_string "1"
  | Ctypes_static.Primitive Cstubs_internals.Uint32_t, "LKM_NLMODE" ->
    Unsigned.UInt32.of_string "0"
  | _, s -> failwith ("unmatched constant: "^ s)

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