C and Objective Caml bindings for PATypeHolder.

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

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index a460be54e6c1215bb660ef1ae1d93cfcfdc46e09..0361001b6eba3d57ece76512800136eb0f8dfaae 100644 (file)
--- 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
 (* 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. *)
 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 ()
 
 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 ------------------------------------------------------------===*)
 
 
 (*===-- Values ------------------------------------------------------------===*)
 

diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 801da2614d5a8da71c424a5757220594d64e84ea..d2f6cb4ce7a35264c2d6db50aec5ddfd6125162a 100644 (file)
--- 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
 (* 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. *)
 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
 
 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"
 
 (*===-- 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 6bccd28aea1fe3719f0828dcd551197f4686b24e..4d721822f13a2c1e2b0b73c40c826d3034c015b1 100644 (file)
--- 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();
 }
 
   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 ------------------------------------------------------------===*/
 
 
 /*===-- VALUES ------------------------------------------------------------===*/
 

diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h
index d839e0c9cf5b18c903a9774d47b3aa5491d7adc8..ee1f69f6111d22ebf271e0095d3b63426fb330c0 100644 (file)
--- a/include/llvm-c/Core.h
+++ b/include/llvm-c/Core.h
@@ -47,6 +47,7 @@ extern "C" {
 /* Opaque types. */
 typedef struct LLVMOpaqueModule *LLVMModuleRef;
 typedef struct LLVMOpaqueType *LLVMTypeRef;
 /* Opaque types. */
 typedef struct LLVMOpaqueModule *LLVMModuleRef;
 typedef struct LLVMOpaqueType *LLVMTypeRef;

+typedef struct LLVMOpaqueTypeHandle *LLVMTypeHandleRef;

 typedef struct LLVMOpaqueValue *LLVMValueRef;
 typedef struct LLVMOpaqueBasicBlock *LLVMBasicBlockRef;
 typedef struct LLVMOpaqueBuilder *LLVMBuilderRef;
 typedef struct LLVMOpaqueValue *LLVMValueRef;
 typedef struct LLVMOpaqueBasicBlock *LLVMBasicBlockRef;
 typedef struct LLVMOpaqueBuilder *LLVMBuilderRef;


@@ -204,6 +205,12 @@ LLVMTypeRef LLVMVoidType();
 LLVMTypeRef LLVMLabelType();
 LLVMTypeRef LLVMOpaqueType();
 
 LLVMTypeRef LLVMLabelType();
 LLVMTypeRef LLVMOpaqueType();
 

+/* Operations on type handles */
+LLVMTypeHandleRef LLVMCreateTypeHandle(LLVMTypeRef PotentiallyAbstractTy);
+void LLVMRefineType(LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy);
+LLVMTypeRef LLVMResolveTypeHandle(LLVMTypeHandleRef TypeHandle);
+void LLVMDisposeTypeHandle(LLVMTypeHandleRef TypeHandle);
+

 
 /*===-- Values ------------------------------------------------------------===*/
 
 
 /*===-- Values ------------------------------------------------------------===*/
 


@@ -558,6 +565,16 @@ namespace llvm {
   inline LLVMBuilderRef wrap(LLVMBuilder *B) {
     return reinterpret_cast<LLVMBuilderRef>(B);
   }
   inline LLVMBuilderRef wrap(LLVMBuilder *B) {
     return reinterpret_cast<LLVMBuilderRef>(B);
   }

+  
+  /* Opaque type handle conversions.
+   */ 
+  inline PATypeHolder *unwrap(LLVMTypeHandleRef B) {
+    return reinterpret_cast<PATypeHolder*>(B);
+  }
+  
+  inline LLVMTypeHandleRef wrap(PATypeHolder *B) {
+    return reinterpret_cast<LLVMTypeHandleRef>(B);
+  }

 }
 
 #endif /* !defined(__cplusplus) */
 }
 
 #endif /* !defined(__cplusplus) */

diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp
index 10b226cc7c25c2cc3b702f0565a5f8a0eb770fd3..15a54b332ac92b3eb678a36c71e26a802be34299 100644 (file)
--- a/lib/VMCore/Core.cpp
+++ b/lib/VMCore/Core.cpp
@@ -177,6 +177,24 @@ LLVMTypeRef LLVMOpaqueType() {
   return wrap(llvm::OpaqueType::get());
 }
 
   return wrap(llvm::OpaqueType::get());
 }
 

+/* Operations on type handles */
+
+LLVMTypeHandleRef LLVMCreateTypeHandle(LLVMTypeRef PotentiallyAbstractTy) {
+  return wrap(new PATypeHolder(unwrap(PotentiallyAbstractTy)));
+}
+
+void LLVMDisposeTypeHandle(LLVMTypeHandleRef TypeHandle) {
+  delete unwrap(TypeHandle);
+}
+
+LLVMTypeRef LLVMResolveTypeHandle(LLVMTypeHandleRef TypeHandle) {
+  return wrap(unwrap(TypeHandle)->get());
+}
+
+void LLVMRefineType(LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy) {
+  unwrap<DerivedType>(AbstractTy)->refineAbstractTypeTo(unwrap(ConcreteTy));
+}
+

 
 /*===-- Operations on values ----------------------------------------------===*/
 
 
 /*===-- Operations on values ----------------------------------------------===*/
 

diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml
index 434536b79e4e6f50f7bec549507811a27409397b..0282241d0c9cc76b0c5bff4fc694b37c26c63f6e 100644 (file)
--- a/test/Bindings/Ocaml/vmcore.ml
+++ b/test/Bindings/Ocaml/vmcore.ml
@@ -131,7 +131,17 @@ let test_types () =
   group "delete";
   let ty = opaque_type () in
   insist (define_type_name "Ty13" ty m);
   group "delete";
   let ty = opaque_type () in
   insist (define_type_name "Ty13" ty m);

-  delete_type_name "Ty13" m
+  delete_type_name "Ty13" m;
+  
+  (* RUN: grep -v {RecursiveTy.*RecursiveTy} < %t.ll
+   *)
+  group "recursive";
+  let ty = opaque_type () in
+  let th = handle_to_type ty in
+  refine_type ty (pointer_type ty);
+  let ty = type_of_handle th in
+  insist (define_type_name "RecursiveTy" ty m);
+  insist (ty == element_type ty)

 
 
 (*===-- Constants ---------------------------------------------------------===*)
 
 
 (*===-- Constants ---------------------------------------------------------===*)