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 a460be5..0361001 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 @@
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 801da26..d2f6cb4 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 @@
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 6bccd28..4d72182 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -195,6 +195,38 @@
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 ------------------------------------------------------------===*/
diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h
index d839e0c..ee1f69f 100644
--- a/include/llvm-c/Core.h
+++ b/include/llvm-c/Core.h
@@ -47,6 +47,7 @@
/* 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;
@@ -204,6 +205,12 @@
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 ------------------------------------------------------------===*/
@@ -558,6 +565,16 @@
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) */
diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp
index 10b226c..15a54b3 100644
--- a/lib/VMCore/Core.cpp
+++ b/lib/VMCore/Core.cpp
@@ -177,6 +177,24 @@
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 ----------------------------------------------===*/
diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml
index 434536b..0282241 100644
--- a/test/Bindings/Ocaml/vmcore.ml
+++ b/test/Bindings/Ocaml/vmcore.ml
@@ -131,7 +131,17 @@
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 ---------------------------------------------------------===*)