From 1cf08fddc7413076dedad58dbb8d8d67e69a490f Mon Sep 17 00:00:00 2001 From: Gordon Henriksen Date: Sun, 7 Oct 2007 00:13:35 +0000 Subject: [PATCH] C and Objective Caml bindings for PATypeHolder. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@42713 91177308-0d34-0410-b5e6-96231b3b80d8 --- bindings/ocaml/llvm/llvm.ml | 6 ++++++ bindings/ocaml/llvm/llvm.mli | 6 ++++++ bindings/ocaml/llvm/llvm_ocaml.c | 32 ++++++++++++++++++++++++++++++++ include/llvm-c/Core.h | 17 +++++++++++++++++ lib/VMCore/Core.cpp | 18 ++++++++++++++++++ test/Bindings/Ocaml/vmcore.ml | 12 +++++++++++- 6 files changed, 90 insertions(+), 1 deletion(-) diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index a460be54e6c..0361001b6eb 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 801da2614d5..d2f6cb4ce7a 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 6bccd28aea1..4d721822f13 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 d839e0c9cf5..ee1f69f6111 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(B); } + + /* Opaque type handle conversions. + */ + inline PATypeHolder *unwrap(LLVMTypeHandleRef B) { + return reinterpret_cast(B); + } + + inline LLVMTypeHandleRef wrap(PATypeHolder *B) { + return reinterpret_cast(B); + } } #endif /* !defined(__cplusplus) */ diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp index 10b226cc7c2..15a54b332ac 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(AbstractTy)->refineAbstractTypeTo(unwrap(ConcreteTy)); +} + /*===-- Operations on values ----------------------------------------------===*/ diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index 434536b79e4..0282241d0c9 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 ---------------------------------------------------------===*) -- 2.34.1