[llvm-commits] [llvm] r42713 - in /llvm/trunk: bindings/ocaml/llvm/llvm.ml bindings/ocaml/llvm/llvm.mli bindings/ocaml/llvm/llvm_ocaml.c include/llvm-c/Core.h lib/VMCore/Core.cpp test/Bindings/Ocaml/vmcore.ml

Gordon Henriksen gordonhenriksen at mac.com
Sat Oct 6 17:13:35 PDT 2007


Author: gordon
Date: Sat Oct  6 19:13:35 2007
New Revision: 42713

URL: http://llvm.org/viewvc/llvm-project?rev=42713&view=rev
Log:
C and Objective Caml bindings for PATypeHolder.

Modified:
    llvm/trunk/bindings/ocaml/llvm/llvm.ml
    llvm/trunk/bindings/ocaml/llvm/llvm.mli
    llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
    llvm/trunk/include/llvm-c/Core.h
    llvm/trunk/lib/VMCore/Core.cpp
    llvm/trunk/test/Bindings/Ocaml/vmcore.ml

Modified: llvm/trunk/bindings/ocaml/llvm/llvm.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.ml?rev=42713&r1=42712&r2=42713&view=diff

==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.ml (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.ml Sat Oct  6 19:13:35 2007
@@ -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 ------------------------------------------------------------===*)
 

Modified: llvm/trunk/bindings/ocaml/llvm/llvm.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.mli?rev=42713&r1=42712&r2=42713&view=diff

==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.mli (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.mli Sat Oct  6 19:13:35 2007
@@ -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"

Modified: llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c?rev=42713&r1=42712&r2=42713&view=diff

==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c Sat Oct  6 19:13:35 2007
@@ -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 ------------------------------------------------------------===*/
 

Modified: llvm/trunk/include/llvm-c/Core.h
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/include/llvm-c/Core.h?rev=42713&r1=42712&r2=42713&view=diff

==============================================================================
--- llvm/trunk/include/llvm-c/Core.h (original)
+++ llvm/trunk/include/llvm-c/Core.h Sat Oct  6 19:13:35 2007
@@ -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) */

Modified: llvm/trunk/lib/VMCore/Core.cpp
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/lib/VMCore/Core.cpp?rev=42713&r1=42712&r2=42713&view=diff

==============================================================================
--- llvm/trunk/lib/VMCore/Core.cpp (original)
+++ llvm/trunk/lib/VMCore/Core.cpp Sat Oct  6 19:13:35 2007
@@ -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 ----------------------------------------------===*/
 

Modified: llvm/trunk/test/Bindings/Ocaml/vmcore.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/vmcore.ml?rev=42713&r1=42712&r2=42713&view=diff

==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/vmcore.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/vmcore.ml Sat Oct  6 19:13:35 2007
@@ -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 ---------------------------------------------------------===*)





More information about the llvm-commits mailing list