https://gitlab.com/tezos/tezos
Tip revision: 618c537c2495d5b90c2b26c93e23f8b5f5ef6a94 authored by Julien Coolen on 12 April 2023, 12:37:57 UTC
commit ok
commit ok
Tip revision: 618c537
api_types_desc.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2022 TriliTech <contact@trili.tech> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
(** This functor is used by Ctypes to generate Wasmer C API type bindings. *)
module Types (S : Ctypes.TYPE) = struct
open S
module type Named = sig
val name : string
end
module type Named_struct = sig
include Named
type s
type t = s Ctypes.structure
val t : t typ
end
(** This functor corresponds to the [WASM_DECLARE_OWN] macro in [wasm.h]. *)
module Declare_own (Desc : Named) : Named_struct = struct
include Desc
type s
type t = s Ctypes.structure
let t : t typ =
let name = "wasm_" ^ Desc.name ^ "_t" in
typedef (structure name) name
end
module type Named_type = sig
include Named
type t
val t : t typ
end
module type Vec = sig
type s
include Named_type with type t = s Ctypes.structure
type item
val item : item typ
val size : (Unsigned.size_t, t) field
val data : (item Ctypes.ptr, t) field
end
(** This functor corresponds to the [WASM_DECLARE_VEC] macro in [wasm.h]. *)
module Declare_vec (Item : Named_type) : Vec with type item = Item.t = struct
let name = Item.name ^ "_vec"
type s
type t = s Ctypes.structure
let t : t typ =
let name = "wasm_" ^ name ^ "_t" in
typedef (structure name) name
type item = Item.t
let item = Item.t
let size = field t "size" size_t
let data = field t "data" (ptr Item.t)
let () = seal t
end
(** Generate a pointer type from another type. *)
module Ptr (Item : Named_type) : Named_type with type t = Item.t Ctypes.ptr =
struct
include Item
type t = Item.t Ctypes.ptr
let t = ptr Item.t
end
module Declare_type (Desc : Named) : sig
include Named_struct
module Vec : Vec with type item = t Ctypes.ptr
end = struct
module Self = Declare_own (Desc)
module Vec = Declare_vec (Ptr (Self))
include Self
end
module Wasmer = struct
(** [wasmer_compiler_t] *)
module Compiler = struct
type s
type t = CRANELIFT | LLVM | SINGLEPASS
let t : t typ =
enum
"wasmer_compiler_t"
[
(CRANELIFT, constant "CRANELIFT" int64_t);
(LLVM, constant "LLVM" int64_t);
(SINGLEPASS, constant "SINGLEPASS" int64_t);
]
end
(** [wasmer_features_t] *)
module Features = struct
type s
type t = s Ctypes.structure
let t : t typ =
let name = "wasmer_features_t" in
typedef (structure name) name
end
end
(** [wasm_config_t] *)
module Config = Declare_own (struct
let name = "config"
end)
(** [wasm_engine_t] *)
module Engine = Declare_own (struct
let name = "engine"
end)
(** [wasm_store_t] *)
module Store = Declare_own (struct
let name = "store"
end)
(** [wasm_module_t] *)
module Module = Declare_own (struct
let name = "module"
end)
(** [wasm_byte_t] *)
module Byte = struct
type t = Unsigned.uint8
let t = uint8_t
let name = "byte"
end
(** [wasm_byte_vec_t] *)
module Byte_vec = Declare_vec (Byte)
(** [wasm_name_t] *)
module Name = Byte_vec
(** [wasm_message_t] *)
module Message = Name
module Ref_repr = struct
type s
type t = s Ctypes.structure
let t : t Ctypes.typ = Ctypes.structure "wasm_ref_t"
end
(** [wasm_ref_t] *)
module Ref = struct
let name = "ref"
type t = Ref_repr.s Ctypes.structure
let t : t typ = S.lift_typ Ref_repr.t
end
(** [wasm_valkind_t] *)
module Valkind = struct
type t = Unsigned.uint8
let i32 = constant "WASM_I32" uint8_t
let i64 = constant "WASM_I64" uint8_t
let f32 = constant "WASM_F32" uint8_t
let f64 = constant "WASM_F64" uint8_t
let anyref = constant "WASM_ANYREF" uint8_t
let funcref = constant "WASM_FUNCREF" uint8_t
let t : t typ = uint8_t
end
(* The actual [Val.t] is an abstract representation of values.
Unfortunately, it can't be properly represented using Ctypes' stubs
functionality because it contains an anonymous union field.
However, the default Ctypes functionality works fine here. The down side is
that this is not sufficiently type checked, hence we must be careful with
declarations below.
Ultimately the [Val.t] is still the type to be used. The types described
by this module are lifted within the [Val] module.
*)
module Val_repr = struct
open Ctypes
module Of = struct
type s
type t = s union
let t : t typ = union ""
let i32 = field t "i32" int32_t
let i64 = field t "i64" int64_t
let f32 = field t "f32" float
let f64 = field t "f64" double
let ref = field t "ref" (ptr Ref_repr.t)
let () = seal t
end
type s
type t = s structure
let t : t typ = structure "wasm_val_t"
let kind = field t "kind" uint8_t
let of_ = field t "of" Of.t
let () = seal t
end
(** [wasm_val_t] *)
module Val = struct
let name = "val"
type t = Val_repr.s Ctypes.structure
let t : t typ = S.lift_typ Val_repr.t
end
(** [wasm_val_vec_t] *)
module Val_vec = Declare_vec (Val)
(** [wasm_trap_t] *)
module Trap = Declare_own (struct
let name = "trap"
end)
(** [wasm_valtype_t] *)
module Valtype = Declare_type (struct
let name = "valtype"
end)
module Func_callback = struct
let fn = ptr Val_vec.t @-> ptr Val_vec.t @-> returning (ptr Trap.t)
let m =
Foreign.dynamic_funptr ~runtime_lock:true ~thread_registration:true fn
let t = static_funptr fn
end
(** [wasm_func_t] *)
module Func = Declare_own (struct
let name = "func"
end)
(** [wasm_memory_t] *)
module Memory = Declare_own (struct
let name = "memory"
end)
(** [wasm_extern_t] *)
module Extern = Declare_type (struct
let name = "extern"
end)
(** [wasm_instance_t] *)
module Instance = Declare_own (struct
let name = "instance"
end)
(** [wasm_functype_t] *)
module Functype = Declare_own (struct
let name = "functype"
end)
(** [wasm_globaltype_t] *)
module Globaltype = Declare_own (struct
let name = "globaltype"
end)
(** [wasm_tabletype_t] *)
module Tabletype = Declare_own (struct
let name = "tabletype"
end)
(** [wasm_memorytype_t] *)
module Memorytype = Declare_own (struct
let name = "memorytype"
end)
(** [wasm_limits_t] *)
module Limits = struct
open Ctypes
type s
type t = s structure
let t : t typ = structure "wasm_limits_t"
let min = field t "min" uint32_t
let max = field t "max" uint32_t
let () = seal t
let max_default = constant "wasm_limits_max_default" S.uint32_t
end
(** [wasm_externkind_t] *)
module Externkind = struct
type t = Unsigned.uint8
let func = constant "WASM_EXTERN_FUNC" uint8_t
let global = constant "WASM_EXTERN_GLOBAL" uint8_t
let table = constant "WASM_EXTERN_TABLE" uint8_t
let memory = constant "WASM_EXTERN_MEMORY" uint8_t
let t : t typ = uint8_t
end
(** [wasm_externtype_t] *)
module Externtype = Declare_own (struct
let name = "externtype"
end)
(** [wasm_exporttype_t] *)
module Exporttype = Declare_type (struct
let name = "exporttype"
end)
(** [wasm_importtype_t] *)
module Importtype = Declare_type (struct
let name = "importtype"
end)
end