C and Objective Caml bindings for PATypeHolder.

git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@42713 91177308-0d34-0410-b5e6-96231b3b80d8

3 files changed, 44 insertions, 0 deletions

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index a460be54e6..0361001b6e 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -16,6 +16,7 @@
 (* These abstract types correlate directly to the LLVM VMCore classes. *)
 type llmodule
 type lltype
+type lltypehandle
 type llvalue
 type llbasicblock (* These are actually values, but
                      benefit from type checking. *)
@@ -176,6 +177,11 @@ external _label_type : unit -> lltype = "llvm_label_type"
 let void_type = _void_type ()
 let label_type = _label_type ()
 
+(*--... Operations on type handles .........................................--*)
+external handle_to_type : lltype -> lltypehandle = "llvm_handle_to_type"
+external type_of_handle : lltypehandle -> lltype = "llvm_type_of_handle"
+external refine_type : lltype -> lltype -> unit = "llvm_refine_type"
+
 
 (*===-- Values ------------------------------------------------------------===*)
 
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 801da2614d..d2f6cb4ce7 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -16,6 +16,7 @@
 (* These abstract types correlate directly to the LLVM VMCore classes. *)
 type llmodule
 type lltype
+type lltypehandle
 type llvalue
 type llbasicblock (* These are actually values, but
                      benefit from type checking. *)
@@ -160,6 +161,11 @@ external opaque_type : unit -> lltype = "llvm_opaque_type"
 val void_type : lltype
 val label_type : lltype
 
+(*--... Operations on type handles .........................................--*)
+external handle_to_type : lltype -> lltypehandle = "llvm_handle_to_type"
+external type_of_handle : lltypehandle -> lltype = "llvm_type_of_handle"
+external refine_type : lltype -> lltype -> unit = "llvm_refine_type"
+
 
 (*===-- Values ------------------------------------------------------------===*)
 external type_of : llvalue -> lltype = "llvm_type_of"
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 6bccd28aea..4d721822f1 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -195,6 +195,38 @@ CAMLprim LLVMTypeRef llvm_opaque_type(value Unit) {
   return LLVMOpaqueType();
 }
 
+/*--... Operations on type handles .........................................--*/
+
+#define Typehandle_val(v)  (*(LLVMTypeHandleRef *)(Data_custom_val(v)))
+
+void llvm_finalize_handle(value TH) {
+  LLVMDisposeTypeHandle(Typehandle_val(TH));
+}
+
+static struct custom_operations typehandle_ops = {
+  (char *) "LLVMTypeHandle",
+  llvm_finalize_handle,
+  custom_compare_default,
+  custom_hash_default,
+  custom_serialize_default,
+  custom_deserialize_default
+};
+
+CAMLprim value llvm_handle_to_type(LLVMTypeRef PATy) {
+  value TH = alloc_custom(&typehandle_ops, sizeof(LLVMBuilderRef), 0, 1);
+  Typehandle_val(TH) = LLVMCreateTypeHandle(PATy);
+  return TH;
+}
+
+CAMLprim LLVMTypeRef llvm_type_of_handle(value TH) {
+  return LLVMResolveTypeHandle(Typehandle_val(TH));
+}
+
+CAMLprim value llvm_refine_type(LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy){
+  LLVMRefineAbstractType(AbstractTy, ConcreteTy);
+  return Val_unit;
+}
+
 
 /*===-- VALUES ------------------------------------------------------------===*/