From 404a1942e43ca967700cc2608eb97b863add2677 Mon Sep 17 00:00:00 2001 From: Gordon Henriksen Date: Wed, 19 Dec 2007 22:54:12 +0000 Subject: Using modules to group enumerations in Ocaml bindings. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@45229 91177308-0d34-0410-b5e6-96231b3b80d8 --- bindings/ocaml/llvm/llvm.ml | 186 +++++++++++++++++++++------------------ bindings/ocaml/llvm/llvm.mli | 143 ++++++++++++++++-------------- bindings/ocaml/llvm/llvm_ocaml.c | 18 ++-- 3 files changed, 184 insertions(+), 163 deletions(-) (limited to 'bindings') diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 58d9d5013e..c2c4e46ce7 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -17,37 +17,43 @@ type llbuilder type llmoduleprovider type llmemorybuffer -type type_kind = - Void_type -| Float_type -| Double_type -| X86fp80_type -| Fp128_type -| Ppc_fp128_type -| Label_type -| Integer_type -| Function_type -| Struct_type -| Array_type -| Pointer_type -| Opaque_type -| Vector_type - -type linkage = - External_linkage -| Link_once_linkage -| Weak_linkage -| Appending_linkage -| Internal_linkage -| Dllimport_linkage -| Dllexport_linkage -| External_weak_linkage -| Ghost_linkage - -type visibility = - Default_visibility -| Hidden_visibility -| Protected_visibility +module TypeKind = struct + type t = + | Void + | Float + | Double + | X86fp80 + | Fp128 + | Ppc_fp128 + | Label + | Integer + | Function + | Struct + | Array + | Pointer + | Opaque + | Vector +end + +module Linkage = struct + type t = + | External + | Link_once + | Weak + | Appending + | Internal + | Dllimport + | Dllexport + | External_weak + | Ghost +end + +module Visibility = struct + type t = + | Default + | Hidden + | Protected +end let ccc = 0 let fastcc = 8 @@ -55,35 +61,39 @@ let coldcc = 9 let x86_stdcallcc = 64 let x86_fastcallcc = 65 -type int_predicate = - Icmp_eq -| Icmp_ne -| Icmp_ugt -| Icmp_uge -| Icmp_ult -| Icmp_ule -| Icmp_sgt -| Icmp_sge -| Icmp_slt -| Icmp_sle - -type real_predicate = - Fcmp_false -| Fcmp_oeq -| Fcmp_ogt -| Fcmp_oge -| Fcmp_olt -| Fcmp_ole -| Fcmp_one -| Fcmp_ord -| Fcmp_uno -| Fcmp_ueq -| Fcmp_ugt -| Fcmp_uge -| Fcmp_ult -| Fcmp_ule -| Fcmp_une -| Fcmp_true +module Icmp = struct + type t = + | Eq + | Ne + | Ugt + | Uge + | Ult + | Ule + | Sgt + | Sge + | Slt + | Sle +end + +module Fcmp = struct + type t = + | False + | Oeq + | Ogt + | Oge + | Olt + | Ole + | One + | Ord + | Uno + | Ueq + | Ugt + | Uge + | Ult + | Ule + | Une + | True +end exception IoError of string @@ -103,7 +113,7 @@ external delete_type_name : string -> llmodule -> unit (*===-- Types -------------------------------------------------------------===*) -external classify_type : lltype -> type_kind = "llvm_classify_type" +external classify_type : lltype -> TypeKind.t = "llvm_classify_type" (*--... Operations on integer types ........................................--*) external _i1_type : unit -> lltype = "llvm_i1_type" @@ -220,9 +230,9 @@ external const_frem : llvalue -> llvalue -> llvalue = "LLVMConstFRem" external const_and : llvalue -> llvalue -> llvalue = "LLVMConstAnd" external const_or : llvalue -> llvalue -> llvalue = "LLVMConstOr" external const_xor : llvalue -> llvalue -> llvalue = "LLVMConstXor" -external const_icmp : int_predicate -> llvalue -> llvalue -> llvalue +external const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue = "llvm_const_icmp" -external const_fcmp : real_predicate -> llvalue -> llvalue -> llvalue +external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue = "llvm_const_fcmp" external const_shl : llvalue -> llvalue -> llvalue = "LLVMConstShl" external const_lshr : llvalue -> llvalue -> llvalue = "LLVMConstLShr" @@ -251,12 +261,12 @@ external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue (*--... Operations on global variables, functions, and aliases (globals) ...--*) external is_declaration : llvalue -> bool = "llvm_is_declaration" -external linkage : llvalue -> linkage = "llvm_linkage" -external set_linkage : linkage -> llvalue -> unit = "llvm_set_linkage" +external linkage : llvalue -> Linkage.t = "llvm_linkage" +external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage" external section : llvalue -> string = "llvm_section" external set_section : string -> llvalue -> unit = "llvm_set_section" -external visibility : llvalue -> visibility = "llvm_visibility" -external set_visibility : visibility -> llvalue -> unit = "llvm_set_visibility" +external visibility : llvalue -> Visibility.t = "llvm_visibility" +external set_visibility : Visibility.t -> llvalue -> unit = "llvm_set_visibility" external alignment : llvalue -> int = "llvm_alignment" external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" external is_global_constant : llvalue -> bool = "llvm_is_global_constant" @@ -415,9 +425,9 @@ external build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue = "llvm_build_bitcast" (*--... Comparisons ........................................................--*) -external build_icmp : int_predicate -> llvalue -> llvalue -> string -> +external build_icmp : Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_icmp" -external build_fcmp : real_predicate -> llvalue -> llvalue -> string -> +external build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_fcmp" (*--... Miscellaneous instructions .........................................--*) @@ -471,28 +481,28 @@ let concat2 sep arr = let rec string_of_lltype ty = (* FIXME: stop infinite recursion! :) *) match classify_type ty with - Integer_type -> "i" ^ string_of_int (integer_bitwidth ty) - | Pointer_type -> (string_of_lltype (element_type ty)) ^ "*" - | Struct_type -> + TypeKind.Integer -> "i" ^ string_of_int (integer_bitwidth ty) + | TypeKind.Pointer -> (string_of_lltype (element_type ty)) ^ "*" + | TypeKind.Struct -> let s = "{ " ^ (concat2 ", " ( Array.map string_of_lltype (element_types ty) )) ^ " }" in if is_packed ty then "<" ^ s ^ ">" else s - | Array_type -> "[" ^ (string_of_int (array_length ty)) ^ - " x " ^ (string_of_lltype (element_type ty)) ^ "]" - | Vector_type -> "<" ^ (string_of_int (vector_size ty)) ^ - " x " ^ (string_of_lltype (element_type ty)) ^ ">" - | Opaque_type -> "opaque" - | Function_type -> string_of_lltype (return_type ty) ^ - " (" ^ (concat2 ", " ( - Array.map string_of_lltype (param_types ty) - )) ^ ")" - | Label_type -> "label" - | Ppc_fp128_type -> "ppc_fp128" - | Fp128_type -> "fp128" - | X86fp80_type -> "x86_fp80" - | Double_type -> "double" - | Float_type -> "float" - | Void_type -> "void" + | TypeKind.Array -> "[" ^ (string_of_int (array_length ty)) ^ + " x " ^ (string_of_lltype (element_type ty)) ^ "]" + | TypeKind.Vector -> "<" ^ (string_of_int (vector_size ty)) ^ + " x " ^ (string_of_lltype (element_type ty)) ^ ">" + | TypeKind.Opaque -> "opaque" + | TypeKind.Function -> string_of_lltype (return_type ty) ^ + " (" ^ (concat2 ", " ( + Array.map string_of_lltype (param_types ty) + )) ^ ")" + | TypeKind.Label -> "label" + | TypeKind.Ppc_fp128 -> "ppc_fp128" + | TypeKind.Fp128 -> "fp128" + | TypeKind.X86fp80 -> "x86_fp80" + | TypeKind.Double -> "double" + | TypeKind.Float -> "float" + | TypeKind.Void -> "void" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 546ab4579f..4f3bee7fab 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -50,41 +50,47 @@ type llmemorybuffer (** The kind of an [lltype], the result of [classify_type ty]. See the [llvm::Type::TypeID] enumeration. **) -type type_kind = - Void_type -| Float_type -| Double_type -| X86fp80_type -| Fp128_type -| Ppc_fp128_type -| Label_type -| Integer_type -| Function_type -| Struct_type -| Array_type -| Pointer_type -| Opaque_type -| Vector_type +module TypeKind : sig + type t = + Void + | Float + | Double + | X86fp80 + | Fp128 + | Ppc_fp128 + | Label + | Integer + | Function + | Struct + | Array + | Pointer + | Opaque + | Vector +end (** The linkage of a global value, accessed with [linkage gv] and [set_linkage l gv]. See [llvm::GlobalValue::LinkageTypes]. **) -type linkage = - External_linkage -| Link_once_linkage -| Weak_linkage -| Appending_linkage -| Internal_linkage -| Dllimport_linkage -| Dllexport_linkage -| External_weak_linkage -| Ghost_linkage +module Linkage : sig + type t = + External + | Link_once + | Weak + | Appending + | Internal + | Dllimport + | Dllexport + | External_weak + | Ghost +end (** The linker visibility of a global value, accessed with [visibility gv] and [set_visibility v gv]. See [llvm::GlobalValue::VisibilityTypes]. **) -type visibility = - Default_visibility -| Hidden_visibility -| Protected_visibility +module Visibility : sig + type t = + Default + | Hidden + | Protected +end (* The following calling convention values may be accessed with [function_call_conv f] and [set_function_call_conv conv f]. Calling @@ -102,37 +108,41 @@ val x86_fastcallcc : int (** [x86_fastcallcc] is the familiar fastcall calling (** The predicate for an integer comparison ([icmp]) instruction. See the [llvm::ICmpInst::Predicate] enumeration. **) -type int_predicate = - Icmp_eq -| Icmp_ne -| Icmp_ugt -| Icmp_uge -| Icmp_ult -| Icmp_ule -| Icmp_sgt -| Icmp_sge -| Icmp_slt -| Icmp_sle +module Icmp : sig + type t = + | Eq + | Ne + | Ugt + | Uge + | Ult + | Ule + | Sgt + | Sge + | Slt + | Sle +end (** The predicate for a floating-point comparison ([fcmp]) instruction. See the [llvm::FCmpInst::Predicate] enumeration. **) -type real_predicate = - Fcmp_false -| Fcmp_oeq -| Fcmp_ogt -| Fcmp_oge -| Fcmp_olt -| Fcmp_ole -| Fcmp_one -| Fcmp_ord -| Fcmp_uno -| Fcmp_ueq -| Fcmp_ugt -| Fcmp_uge -| Fcmp_ult -| Fcmp_ule -| Fcmp_une -| Fcmp_true +module Fcmp : sig + type t = + | False + | Oeq + | Ogt + | Oge + | Olt + | Ole + | One + | Ord + | Uno + | Ueq + | Ugt + | Uge + | Ult + | Ule + | Une + | True +end exception IoError of string @@ -167,7 +177,7 @@ external delete_type_name : string -> llmodule -> unit (** [classify_type ty] returns the [type_kind] corresponding to the type [ty]. See the method [llvm::Type::getTypeID]. **) -external classify_type : lltype -> type_kind = "llvm_classify_type" +external classify_type : lltype -> TypeKind.t = "llvm_classify_type" (** [string_of_lltype ty] returns a string describing the type [ty]. **) val string_of_lltype : lltype -> string @@ -504,13 +514,13 @@ external const_xor : llvalue -> llvalue -> llvalue = "LLVMConstXor" (** [const_icmp pred c1 c2] returns the constant comparison of two integer constants, [c1 pred c2]. See the method [llvm::ConstantExpr::getICmp]. **) -external const_icmp : int_predicate -> llvalue -> llvalue -> llvalue +external const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue = "llvm_const_icmp" (** [const_fcmp pred c1 c2] returns the constant comparison of two floating point constants, [c1 pred c2]. See the method [llvm::ConstantExpr::getFCmp]. **) -external const_fcmp : real_predicate -> llvalue -> llvalue -> llvalue +external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue = "llvm_const_fcmp" (** [const_shl c1 c2] returns the constant integer [c1] left-shifted by the @@ -631,11 +641,11 @@ external is_declaration : llvalue -> bool = "llvm_is_declaration" (** [linkage g] returns the linkage of the global value [g]. See the method [llvm::GlobalValue::getLinkage]. **) -external linkage : llvalue -> linkage = "llvm_linkage" +external linkage : llvalue -> Linkage.t = "llvm_linkage" (** [set_linkage l g] sets the linkage of the global value [g] to [l]. See the method [llvm::GlobalValue::setLinkage]. **) -external set_linkage : linkage -> llvalue -> unit = "llvm_set_linkage" +external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage" (** [section g] returns the linker section of the global value [g]. See the method [llvm::GlobalValue::getSection]. **) @@ -647,11 +657,12 @@ external set_section : string -> llvalue -> unit = "llvm_set_section" (** [visibility g] returns the linker visibility of the global value [g]. See the method [llvm::GlobalValue::getVisibility]. **) -external visibility : llvalue -> visibility = "llvm_visibility" +external visibility : llvalue -> Visibility.t = "llvm_visibility" (** [set_visibility v g] sets the linker visibility of the global value [g] to [v]. See the method [llvm::GlobalValue::setVisibility]. **) -external set_visibility : visibility -> llvalue -> unit = "llvm_set_visibility" +external set_visibility : Visibility.t -> llvalue -> unit + = "llvm_set_visibility" (** [alignment g] returns the required alignment of the global value [g]. See the method [llvm::GlobalValue::getAlignment]. **) @@ -1177,14 +1188,14 @@ external build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue [%name = icmp %pred %x, %y] instruction at the position specified by the instruction builder [b]. See the method [llvm::LLVMBuilder::CreateICmp]. **) -external build_icmp : int_predicate -> llvalue -> llvalue -> string -> +external build_icmp : Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_icmp" (** [build_fcmp pred x y name b] creates a [%name = fcmp %pred %x, %y] instruction at the position specified by the instruction builder [b]. See the method [llvm::LLVMBuilder::CreateFCmp]. **) -external build_fcmp : real_predicate -> llvalue -> llvalue -> string -> +external build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_fcmp" (*--... Miscellaneous instructions .........................................--*) diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 5cd9526f56..506b5294de 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -77,7 +77,7 @@ CAMLprim value llvm_delete_type_name(value Name, LLVMModuleRef M) { /*===-- Types -------------------------------------------------------------===*/ -/* lltype -> type_kind */ +/* lltype -> TypeKind.t */ CAMLprim value llvm_classify_type(LLVMTypeRef Ty) { return Val_int(LLVMGetTypeKind(Ty)); } @@ -361,14 +361,14 @@ CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) { /*--... Constant expressions ...............................................--*/ -/* int_predicate -> llvalue -> llvalue -> llvalue */ +/* Icmp.t -> llvalue -> llvalue -> llvalue */ CAMLprim LLVMValueRef llvm_const_icmp(value Pred, LLVMValueRef LHSConstant, LLVMValueRef RHSConstant) { return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant); } -/* real_predicate -> llvalue -> llvalue -> llvalue */ +/* Fcmp.t -> llvalue -> llvalue -> llvalue */ CAMLprim LLVMValueRef llvm_const_fcmp(value Pred, LLVMValueRef LHSConstant, LLVMValueRef RHSConstant) { @@ -388,12 +388,12 @@ CAMLprim value llvm_is_declaration(LLVMValueRef Global) { return Val_bool(LLVMIsDeclaration(Global)); } -/* llvalue -> linkage */ +/* llvalue -> Linkage.t */ CAMLprim value llvm_linkage(LLVMValueRef Global) { return Val_int(LLVMGetLinkage(Global)); } -/* linkage -> llvalue -> unit */ +/* Linkage.t -> llvalue -> unit */ CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) { LLVMSetLinkage(Global, Int_val(Linkage)); return Val_unit; @@ -410,12 +410,12 @@ CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) { return Val_unit; } -/* llvalue -> visibility */ +/* llvalue -> Visibility.t */ CAMLprim value llvm_visibility(LLVMValueRef Global) { return Val_int(LLVMGetVisibility(Global)); } -/* visibility -> llvalue -> unit */ +/* Visibility.t -> llvalue -> unit */ CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) { LLVMSetVisibility(Global, Int_val(Viz)); return Val_unit; @@ -1006,7 +1006,7 @@ CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty, /*--... Comparisons ........................................................--*/ -/* int_predicate -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ +/* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ CAMLprim LLVMValueRef llvm_build_icmp(value Pred, LLVMValueRef LHS, LLVMValueRef RHS, value Name, value B) { @@ -1014,7 +1014,7 @@ CAMLprim LLVMValueRef llvm_build_icmp(value Pred, String_val(Name)); } -/* real_predicate -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ +/* Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ CAMLprim LLVMValueRef llvm_build_fcmp(value Pred, LLVMValueRef LHS, LLVMValueRef RHS, value Name, value B) { -- cgit v1.2.3