ocaml bindings: introduce classify_value

git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@141991 91177308-0d34-0410-b5e6-96231b3b80d8

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"

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.

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);
 }

include/llvm-c/Core.h

@@ -449,8 +449,11 @@ LLVMTypeRef LLVMX86MMXType(void);
   macro(Argument)                           \
   macro(BasicBlock)                         \
   macro(InlineAsm)                          \
+  macro(MDNode)                             \
+  macro(MDString)                           \
   macro(User)                               \
     macro(Constant)                         \
+      macro(BlockAddress)                   \
       macro(ConstantAggregateZero)          \
       macro(ConstantArray)                  \
       macro(ConstantExpr)                   \
@@ -470,14 +473,15 @@ LLVMTypeRef LLVMX86MMXType(void);
         macro(IntrinsicInst)                \
           macro(DbgInfoIntrinsic)           \
             macro(DbgDeclareInst)           \
+          macro(EHExceptionInst)            \
           macro(EHSelectorInst)             \
           macro(MemIntrinsic)               \
             macro(MemCpyInst)               \
             macro(MemMoveInst)              \
             macro(MemSetInst)               \
       macro(CmpInst)                        \
-      macro(FCmpInst)                       \
-      macro(ICmpInst)                       \
+        macro(FCmpInst)                     \
+        macro(ICmpInst)                     \
       macro(ExtractElementInst)             \
       macro(GetElementPtrInst)              \
       macro(InsertElementInst)              \
@@ -489,6 +493,7 @@ LLVMTypeRef LLVMX86MMXType(void);
       macro(StoreInst)                      \
       macro(TerminatorInst)                 \
         macro(BranchInst)                   \
+        macro(IndirectBrInst)               \
         macro(InvokeInst)                   \
         macro(ReturnInst)                   \
         macro(SwitchInst)                   \