RPCS3/llvm
1
0
Fork 0
mirror of https://github.com/RPCS3/llvm.git synced 2024-11-23 19:59:48 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

C and Objective Caml bindings for PATypeHolder.

Browse Source 
git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@42713 91177308-0d34-0410-b5e6-96231b3b80d8
This commit is contained in:
Gordon Henriksen 2007-10-07 00:13:35 +00:00
parent c0491ac8b6
commit 1cf08fddc7
6 changed files with 90 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
bindings/ocaml/llvm/llvm.ml
View File

@ -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 ------------------------------------------------------------===*)

6
bindings/ocaml/llvm/llvm.mli
View File

@ -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"

32
bindings/ocaml/llvm/llvm_ocaml.c
View File

@ -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 ------------------------------------------------------------===*/

17
include/llvm-c/Core.h
View File

@ -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) */

18
lib/VMCore/Core.cpp
View File

@ -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 ----------------------------------------------===*/

12
test/Bindings/Ocaml/vmcore.ml
View File

@ -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 ---------------------------------------------------------===*)