diff options
author | Torok Edwin <edwintorok@gmail.com> | 2011-10-14 20:37:56 +0000 |
---|---|---|
committer | Torok Edwin <edwintorok@gmail.com> | 2011-10-14 20:37:56 +0000 |
commit | 3dd16741864302af14b31b7f75375c09d8544a35 (patch) | |
tree | c80cc3a242d87e61d7cbc607118600240e5138a0 /bindings | |
parent | 6563c879964c3bcf5c77d40da8d4c807adf605aa (diff) | |
download | external_llvm-3dd16741864302af14b31b7f75375c09d8544a35.zip external_llvm-3dd16741864302af14b31b7f75375c09d8544a35.tar.gz external_llvm-3dd16741864302af14b31b7f75375c09d8544a35.tar.bz2 |
ocaml bindings: introduce classify_value
git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@141991 91177308-0d34-0410-b5e6-96231b3b80d8
Diffstat (limited to 'bindings')
-rw-r--r-- | bindings/ocaml/llvm/llvm.ml | 25 | ||||
-rw-r--r-- | bindings/ocaml/llvm/llvm.mli | 27 | ||||
-rw-r--r-- | bindings/ocaml/llvm/llvm_ocaml.c | 68 |
3 files changed, 119 insertions, 1 deletions
diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 031bd7c..4ae2eb6 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -201,6 +201,30 @@ module Opcode = struct | Unwind end +module ValueKind = struct + type t = + | NullValue + | Argument + | BasicBlock + | InlineAsm + | MDNode + | MDString + | BlockAddress + | ConstantAggregateZero + | ConstantArray + | ConstantExpr + | ConstantFP + | ConstantInt + | ConstantPointerNull + | ConstantStruct + | ConstantVector + | Function + | GlobalAlias + | GlobalVariable + | UndefValue + | Instruction of Opcode.t +end + exception IoError of string external register_exns : exn -> unit = "llvm_register_core_exns" @@ -290,6 +314,7 @@ external vector_size : lltype -> int = "llvm_vector_size" external void_type : llcontext -> lltype = "llvm_void_type" external label_type : llcontext -> lltype = "llvm_label_type" +external classify_value : llvalue -> ValueKind.t = "llvm_classify_value" (*===-- Values ------------------------------------------------------------===*) external type_of : llvalue -> lltype = "llvm_type_of" external value_name : llvalue -> string = "llvm_value_name" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 2e2db6e..2cfafdc 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -251,6 +251,31 @@ module Opcode : sig | Unwind end +(** The kind of an [llvalue], the result of [classify_value v]. + * See the various [LLVMIsA*] functions. *) +module ValueKind : sig + type t = + | NullValue + | Argument + | BasicBlock + | InlineAsm + | MDNode + | MDString + | BlockAddress + | ConstantAggregateZero + | ConstantArray + | ConstantExpr + | ConstantFP + | ConstantInt + | ConstantPointerNull + | ConstantStruct + | ConstantVector + | Function + | GlobalAlias + | GlobalVariable + | UndefValue + | Instruction of Opcode.t +end (** {6 Iteration} *) @@ -518,6 +543,8 @@ val label_type : llcontext -> lltype See the method [llvm::Value::getType]. *) val type_of : llvalue -> lltype +val classify_value : llvalue -> ValueKind.t + (** [value_name v] returns the name of the value [v]. For global values, this is the symbol name. For instructions and basic blocks, it is the SSA register name. It is meaningless for constants. diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index cbc0544..ec2d949 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -375,6 +375,69 @@ CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) { return LLVMTypeOf(Val); } +/* keep in sync with ValueKind.t */ +enum ValueKind { + NullValue=0, + Argument, + BasicBlock, + InlineAsm, + MDNode, + MDString, + BlockAddress, + ConstantAggregateZero, + ConstantArray, + ConstantExpr, + ConstantFP, + ConstantInt, + ConstantPointerNull, + ConstantStruct, + ConstantVector, + Function, + GlobalAlias, + GlobalVariable, + UndefValue, + Instruction +}; + +/* llvalue -> ValueKind.t */ +#define DEFINE_CASE(Val, Kind) \ + do {if (LLVMIsA##Kind(Val)) CAMLreturn(Val_int(Kind));} while(0) + +CAMLprim value llvm_classify_value(LLVMValueRef Val) { + CAMLparam0(); + if (!Val) + CAMLreturn(Val_int(NullValue)); + if (LLVMIsAConstant(Val)) { + DEFINE_CASE(Val, BlockAddress); + DEFINE_CASE(Val, ConstantAggregateZero); + DEFINE_CASE(Val, ConstantArray); + DEFINE_CASE(Val, ConstantExpr); + DEFINE_CASE(Val, ConstantFP); + DEFINE_CASE(Val, ConstantInt); + DEFINE_CASE(Val, ConstantPointerNull); + DEFINE_CASE(Val, ConstantStruct); + DEFINE_CASE(Val, ConstantVector); + } + if (LLVMIsAInstruction(Val)) { + CAMLlocal1(result); + result = caml_alloc_small(1, 0); + Store_field(result, 0, Val_int(LLVMGetInstructionOpcode(Val))); + CAMLreturn(result); + } + if (LLVMIsAGlobalValue(Val)) { + DEFINE_CASE(Val, Function); + DEFINE_CASE(Val, GlobalAlias); + DEFINE_CASE(Val, GlobalVariable); + } + DEFINE_CASE(Val, Argument); + DEFINE_CASE(Val, BasicBlock); + DEFINE_CASE(Val, InlineAsm); + DEFINE_CASE(Val, MDNode); + DEFINE_CASE(Val, MDString); + DEFINE_CASE(Val, UndefValue); + failwith("Unknown Value class"); +} + /* llvalue -> string */ CAMLprim value llvm_value_name(LLVMValueRef Val) { return copy_string(LLVMGetValueName(Val)); @@ -1034,7 +1097,10 @@ DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef, /* llvalue -> Opcode.t */ CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) { - LLVMOpcode o = LLVMGetInstructionOpcode(Inst); + LLVMOpcode o; + if (!LLVMIsAInstruction(Inst)) + failwith("Not an instruction"); + o = LLVMGetInstructionOpcode(Inst); assert (o <= LLVMUnwind ); return Val_int(o); } |