6 files changed, 90 insertions, 1 deletions

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 @@ 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 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 @@ 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 6bccd28..4d72182 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 ------------------------------------------------------------===*/
 
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 @@ extern "C" {
 /* 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 LLVMVoidType();
 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 @@ namespace llvm {
   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 @@ LLVMTypeRef LLVMOpaqueType() {
   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 @@ let test_types () =
   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 ---------------------------------------------------------===*)