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 eaca48d..031bd7c 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -130,6 +130,77 @@
| 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"
@@ -272,6 +343,7 @@
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"
@@ -289,6 +361,8 @@
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"
@@ -706,6 +780,7 @@
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 =
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 0f1e9a9..2e2db6e 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -179,6 +179,78 @@
| 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} *)
@@ -543,7 +615,7 @@
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
@@ -595,6 +667,10 @@
[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]. *)
@@ -1439,6 +1515,7 @@
[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
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 21519d4..cbc0544 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -427,6 +427,12 @@
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 */
@@ -512,6 +518,19 @@
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) {
@@ -1013,6 +1032,12 @@
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) {
diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h
index 10e9a80b..6a53259 100644
--- a/include/llvm-c/Core.h
+++ b/include/llvm-c/Core.h
@@ -789,6 +789,7 @@
LLVMValueRef LLVMGetNextInstruction(LLVMValueRef Inst);
LLVMValueRef LLVMGetPreviousInstruction(LLVMValueRef Inst);
void LLVMInstructionEraseFromParent(LLVMValueRef Inst);
+LLVMOpcode LLVMGetInstructionOpcode(LLVMValueRef Inst);
LLVMIntPredicate LLVMGetICmpPredicate(LLVMValueRef Inst);
/* Operations on call sites */
diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp
index 77d2e74..a505e4b 100644
--- a/lib/VMCore/Core.cpp
+++ b/lib/VMCore/Core.cpp
@@ -1591,6 +1591,12 @@
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) {