ocaml bindings: add getopcode for constant and instruction, and int64_of_const.

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

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index eaca48d8496ff90d361588ac0e90856f7d3fe33e..031bd7cd471973fc0c7838bc418209af29f9a1e6 100644 (file)
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -130,6 +130,77 @@ module Fcmp = struct
   | True
 end
 
   | True
 end
 

+module Opcode  = struct
+  type t =
+  | Invalid (* not an instruction *)
+  (* Terminator Instructions *)
+  | Ret
+  | Br
+  | Switch
+  | IndirectBr
+  | Invoke
+  | Invalid2
+  | Unreachable
+  (* Standard Binary Operators *)
+  | Add
+  | FAdd
+  | Sub
+  | FSub
+  | Mul
+  | FMul
+  | UDiv
+  | SDiv
+  | FDiv
+  | URem
+  | SRem
+  | FRem
+  (* Logical Operators *)
+  | Shl
+  | LShr
+  | AShr
+  | And
+  | Or
+  | Xor
+  (* Memory Operators *)
+  | Alloca
+  | Load
+  | Store
+  | GetElementPtr
+  (* Cast Operators *)
+  | Trunc
+  | ZExt
+  | SExt
+  | FPToUI
+  | FPToSI
+  | UIToFP
+  | SIToFP
+  | FPTrunc
+  | FPExt
+  | PtrToInt
+  | IntToPtr
+  | BitCast
+  (* Other Operators *)
+  | ICmp
+  | FCmp
+  | PHI
+  | Call
+  | Select
+  | UserOp1
+  | UserOp2
+  | VAArg
+  | ExtractElement
+  | InsertElement
+  | ShuffleVector
+  | ExtractValue
+  | InsertValue
+  | Fence
+  | AtomicCmpXchg
+  | AtomicRMW
+  | Resume
+  | LandingPad
+  | Unwind
+end
+

 exception IoError of string
 
 external register_exns : exn -> unit = "llvm_register_core_exns"
 exception IoError of string
 
 external register_exns : exn -> unit = "llvm_register_core_exns"


@@ -272,6 +343,7 @@ external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull"
 external undef : lltype -> llvalue = "LLVMGetUndef"
 external is_null : llvalue -> bool = "llvm_is_null"
 external is_undef : llvalue -> bool = "llvm_is_undef"
 external undef : lltype -> llvalue = "LLVMGetUndef"
 external is_null : llvalue -> bool = "llvm_is_null"
 external is_undef : llvalue -> bool = "llvm_is_undef"

+external constexpr_opcode : llvalue -> Opcode.t = "llvm_constexpr_get_opcode"

 
 (*--... Operations on instructions .........................................--*)
 external has_metadata : llvalue -> bool = "llvm_has_metadata"
 
 (*--... Operations on instructions .........................................--*)
 external has_metadata : llvalue -> bool = "llvm_has_metadata"


@@ -289,6 +361,8 @@ external get_named_metadata : llmodule -> string -> llvalue array = "llvm_get_na
 external const_int : lltype -> int -> llvalue = "llvm_const_int"
 external const_of_int64 : lltype -> Int64.t -> bool -> llvalue
                         = "llvm_const_of_int64"
 external const_int : lltype -> int -> llvalue = "llvm_const_int"
 external const_of_int64 : lltype -> Int64.t -> bool -> llvalue
                         = "llvm_const_of_int64"

+external int64_of_const : llvalue -> Int64.t option
+                        = "llvm_int64_of_const"

 external const_int_of_string : lltype -> string -> int -> llvalue
                              = "llvm_const_int_of_string"
 external const_float : lltype -> float -> llvalue = "llvm_const_float"
 external const_int_of_string : lltype -> string -> int -> llvalue
                              = "llvm_const_int_of_string"
 external const_float : lltype -> float -> llvalue = "llvm_const_float"


@@ -706,6 +780,7 @@ external instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos
 external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos
                      = "llvm_instr_pred"
 
 external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos
                      = "llvm_instr_pred"
 

+external instr_opcode : llvalue -> Opcode.t = "llvm_instr_get_opcode"

 external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate"
 
 let rec iter_instrs_range f i e =
 external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate"
 
 let rec iter_instrs_range f i e =

diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 0f1e9a901707c198b70a9245d89c8655194e7ba6..2e2db6e531014de1f8dd74e1c36d6b1531767527 100644 (file)
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -179,6 +179,78 @@ module Fcmp : sig
   | True
 end
 
   | True
 end
 

+(** The opcodes for LLVM instructions and constant expressions. *)
+module Opcode : sig
+  type t =
+  | Invalid (* not an instruction *)
+  (* Terminator Instructions *)
+  | Ret
+  | Br
+  | Switch
+  | IndirectBr
+  | Invoke
+  | Invalid2
+  | Unreachable
+  (* Standard Binary Operators *)
+  | Add
+  | FAdd
+  | Sub
+  | FSub
+  | Mul
+  | FMul
+  | UDiv
+  | SDiv
+  | FDiv
+  | URem
+  | SRem
+  | FRem
+  (* Logical Operators *)
+  | Shl
+  | LShr
+  | AShr
+  | And
+  | Or
+  | Xor
+  (* Memory Operators *)
+  | Alloca
+  | Load
+  | Store
+  | GetElementPtr
+  (* Cast Operators *)
+  | Trunc
+  | ZExt
+  | SExt
+  | FPToUI
+  | FPToSI
+  | UIToFP
+  | SIToFP
+  | FPTrunc
+  | FPExt
+  | PtrToInt
+  | IntToPtr
+  | BitCast
+  (* Other Operators *)
+  | ICmp
+  | FCmp
+  | PHI
+  | Call
+  | Select
+  | UserOp1
+  | UserOp2
+  | VAArg
+  | ExtractElement
+  | InsertElement
+  | ShuffleVector
+  | ExtractValue
+  | InsertValue
+  | Fence
+  | AtomicCmpXchg
+  | AtomicRMW
+  | Resume
+  | LandingPad
+  | Unwind
+end
+

 
 (** {6 Iteration} *)
 
 
 (** {6 Iteration} *)
 


@@ -543,7 +615,7 @@ val is_null : llvalue -> bool
     otherwise. Similar to [llvm::isa<UndefValue>]. *)
 val is_undef : llvalue -> bool
 
     otherwise. Similar to [llvm::isa<UndefValue>]. *)
 val is_undef : llvalue -> bool
 

-
+val constexpr_opcode : llvalue -> Opcode.t

 (** {7 Operations on instructions} *)
 
 (** [has_metadata i] returns whether or not the instruction [i] has any
 (** {7 Operations on instructions} *)
 
 (** [has_metadata i] returns whether or not the instruction [i] has any


@@ -595,6 +667,10 @@ val const_int : lltype -> int -> llvalue
     [i]. See the method [llvm::ConstantInt::get]. *)
 val const_of_int64 : lltype -> Int64.t -> bool -> llvalue
 
     [i]. See the method [llvm::ConstantInt::get]. *)
 val const_of_int64 : lltype -> Int64.t -> bool -> llvalue
 

+(** [int64_of_const c] returns the int64 value of the [c] constant integer.
+ * None is returned if this is not an integer constant, or bitwidth exceeds 64.
+ * See the method [llvm::ConstantInt::getSExtValue].*)
+val int64_of_const : llvalue -> Int64.t option

 
 (** [const_int_of_string ty s r] returns the integer constant of type [ty] and
  * value [s], with the radix [r]. See the method [llvm::ConstantInt::get]. *)
 
 (** [const_int_of_string ty s r] returns the integer constant of type [ty] and
  * value [s], with the radix [r]. See the method [llvm::ConstantInt::get]. *)


@@ -1439,6 +1515,7 @@ val instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos
     [f1,...,fN] are the instructions of basic block [bb]. Tail recursive. *)
 val fold_right_instrs: (llvalue -> 'a -> 'a) -> llbasicblock -> 'a -> 'a
 
     [f1,...,fN] are the instructions of basic block [bb]. Tail recursive. *)
 val fold_right_instrs: (llvalue -> 'a -> 'a) -> llbasicblock -> 'a -> 'a
 

+val instr_opcode : llvalue -> Opcode.t

 
 val icmp_predicate : llvalue -> Icmp.t option
 
 
 val icmp_predicate : llvalue -> Icmp.t option
 

diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 21519d474dfccfd682311b25fca01701e34efaa7..cbc05448fa75c99baffc5836944e48b96045ff35 100644 (file)
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -427,6 +427,12 @@ CAMLprim value llvm_is_undef(LLVMValueRef Val) {
   return Val_bool(LLVMIsUndef(Val));
 }
 
   return Val_bool(LLVMIsUndef(Val));
 }
 

+/* llvalue -> Opcode.t */
+CAMLprim value llvm_constexpr_get_opcode(LLVMValueRef Val) {
+  return LLVMIsAConstantExpr(Val) ?
+      Val_int(LLVMGetConstOpcode(Val)) : Val_int(0);
+}
+

 /*--... Operations on instructions .........................................--*/
 
 /* llvalue -> bool */
 /*--... Operations on instructions .........................................--*/
 
 /* llvalue -> bool */


@@ -512,6 +518,19 @@ CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N,
   return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt));
 }
 
   return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt));
 }
 

+/* llvalue -> Int64.t */
+CAMLprim value llvm_int64_of_const(LLVMValueRef Const)
+{
+  CAMLparam0();
+  if (LLVMIsAConstantInt(Const) &&
+      LLVMGetIntTypeWidth(LLVMTypeOf(Const)) <= 64) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = caml_copy_int64(LLVMConstIntGetSExtValue(Const));
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+

 /* lltype -> string -> int -> llvalue */
 CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S,
                                                value Radix) {
 /* lltype -> string -> int -> llvalue */
 CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S,
                                                value Radix) {


@@ -1013,6 +1032,12 @@ CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
 DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
                  LLVMGetInstructionParent)
 
 DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
                  LLVMGetInstructionParent)
 

+/* llvalue -> Opcode.t */
+CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) {
+  LLVMOpcode o = LLVMGetInstructionOpcode(Inst);
+  assert (o <= LLVMUnwind );
+  return Val_int(o);
+}

 
 /* llvalue -> ICmp.t */
 CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {
 
 /* llvalue -> ICmp.t */
 CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {

diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h
index 10e9a80bcb52bdb5cc4ca9dba4d4c9c0a94443f7..6a5325924557093b73d5ee303cee9977481c179c 100644 (file)
--- a/include/llvm-c/Core.h
+++ b/include/llvm-c/Core.h
@@ -789,6 +789,7 @@ LLVMBasicBlockRef LLVMGetInstructionParent(LLVMValueRef Inst);
 LLVMValueRef LLVMGetNextInstruction(LLVMValueRef Inst);
 LLVMValueRef LLVMGetPreviousInstruction(LLVMValueRef Inst);
 void LLVMInstructionEraseFromParent(LLVMValueRef Inst);
 LLVMValueRef LLVMGetNextInstruction(LLVMValueRef Inst);
 LLVMValueRef LLVMGetPreviousInstruction(LLVMValueRef Inst);
 void LLVMInstructionEraseFromParent(LLVMValueRef Inst);

+LLVMOpcode   LLVMGetInstructionOpcode(LLVMValueRef Inst);

 LLVMIntPredicate LLVMGetICmpPredicate(LLVMValueRef Inst);
 
 /* Operations on call sites */
 LLVMIntPredicate LLVMGetICmpPredicate(LLVMValueRef Inst);
 
 /* Operations on call sites */

diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp
index 77d2e74cd223428d8305a948393bda9e2609141b..a505e4b4f5e5dafc4ddbd51ef3fc6bc5308b1f51 100644 (file)
--- a/lib/VMCore/Core.cpp
+++ b/lib/VMCore/Core.cpp
@@ -1591,6 +1591,12 @@ LLVMIntPredicate LLVMGetICmpPredicate(LLVMValueRef Inst) {
   return (LLVMIntPredicate)0;
 }
 
   return (LLVMIntPredicate)0;
 }
 

+LLVMOpcode LLVMGetInstructionOpcode(LLVMValueRef Inst) {
+  if (Instruction *C = dyn_cast<Instruction>(unwrap(Inst)))
+    return map_to_llvmopcode(C->getOpcode());
+  return (LLVMOpcode)0;
+}
+

 /*--.. Call and invoke instructions ........................................--*/
 
 unsigned LLVMGetInstructionCallConv(LLVMValueRef Instr) {
 /*--.. Call and invoke instructions ........................................--*/
 
 unsigned LLVMGetInstructionCallConv(LLVMValueRef Instr) {