OCaml bindings: add some missing functions and testcases.

The C bindings exposed some APIs that weren't covered by the OCaml bindings

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

6 files changed, 261 insertions, 3 deletions

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 2f4b4ae87c..40b0138636 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -261,6 +261,7 @@ external set_data_layout: string -> llmodule -> unit
 external dump_module : llmodule -> unit = "llvm_dump_module"
 external set_module_inline_asm : llmodule -> string -> unit
                                = "llvm_set_module_inline_asm"
+external module_context : llmodule -> llcontext = "LLVMGetModuleContext"
 
 (*===-- Types -------------------------------------------------------------===*)
 external classify_type : lltype -> TypeKind.t = "llvm_classify_type"
@@ -321,6 +322,7 @@ external vector_size : lltype -> int = "llvm_vector_size"
 (*--... Operations on other types ..........................................--*)
 external void_type : llcontext -> lltype = "llvm_void_type"
 external label_type : llcontext -> lltype = "llvm_label_type"
+external type_by_name : llmodule -> string -> lltype option = "llvm_type_by_name"
 
 external classify_value : llvalue -> ValueKind.t = "llvm_classify_value"
 (*===-- Values ------------------------------------------------------------===*)
@@ -812,6 +814,8 @@ external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos
                    = "llvm_block_end"
 external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos
                     = "llvm_block_pred"
+external block_terminator : llbasicblock -> llvalue option =
+    "llvm_block_terminator"
 
 let rec iter_block_range f i e =
   if i = e then () else
@@ -936,6 +940,7 @@ external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
                       = "llvm_add_incoming"
 external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
 
+external delete_instruction : llvalue -> unit = "llvm_delete_instruction"
 
 (*===-- Instruction builders ----------------------------------------------===*)
 external builder : llcontext -> llbuilder = "llvm_builder"
@@ -978,8 +983,15 @@ external build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder ->
                          llvalue = "llvm_build_cond_br"
 external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue
                       = "llvm_build_switch"
+external build_malloc : lltype -> string -> llbuilder -> llvalue =
+    "llvm_build_malloc"
+external build_array_malloc : lltype -> llvalue -> string -> llbuilder ->
+    llvalue = "llvm_build_array_malloc"
+external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free"
 external add_case : llvalue -> llvalue -> llbasicblock -> unit
                   = "llvm_add_case"
+external switch_default_dest : llvalue -> llbasicblock =
+    "LLVMGetSwitchDefaultDest"
 external build_indirect_br : llvalue -> int -> llbuilder -> llvalue
                            = "llvm_build_indirect_br"
 external add_destination : llvalue -> llbasicblock -> unit
@@ -990,6 +1002,8 @@ external build_invoke : llvalue -> llvalue array -> llbasicblock ->
 external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
                             llvalue = "llvm_build_landingpad"
 external set_cleanup : llvalue -> bool -> unit = "llvm_set_cleanup"
+external add_clause : llvalue -> llvalue -> unit = "llvm_add_clause"
+external build_resume : llvalue -> llbuilder -> llvalue = "llvm_build_resume"
 external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable"
 
 (*--... Arithmetic .........................................................--*)
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index a90a72b771..33bbc74deb 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -363,7 +363,9 @@ val dump_module : llmodule -> unit
     the method [llvm::Module::setModuleInlineAsm]. *)
 val set_module_inline_asm : llmodule -> string -> unit
 
-
+(** [module_context m] returns the context of the specified module.
+ * See the method [llvm::Module::getContext] *)
+val module_context : llmodule -> llcontext
 
 (** {6 Types} *)
 
@@ -552,6 +554,11 @@ val void_type : llcontext -> lltype
     [llvm::Type::LabelTy]. *)
 val label_type : llcontext -> lltype
 
+(** [type_by_name m name] returns the specified type from the current module
+ * if it exists.
+ * See the method [llvm::Module::getTypeByName] *)
+val type_by_name : llmodule -> string -> lltype option
+
 (* {6 Values} *)
 
 (** [type_of v] returns the type of the value [v].
@@ -1508,6 +1515,7 @@ val block_end : llvalue -> (llvalue, llbasicblock) llrev_pos
     See the method [llvm::Function::iterator::operator--]. *)
 val block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos
 
+val block_terminator : llbasicblock -> llvalue option
 
 (** [rev_iter_blocks f fn] applies function [f] to each of the basic blocks
     of function [fn] in reverse order. Tail recursive. *)
@@ -1625,7 +1633,9 @@ val add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
     See the method [llvm::PHINode::getIncomingValue]. *)
 val incoming : llvalue -> (llvalue * llbasicblock) list
 
-
+(** [delete_instruction i] deletes the instruction [i].
+ * See the method [llvm::Instruction::eraseFromParent]. *)
+val delete_instruction : llvalue -> unit
 
 (** {6 Instruction builders} *)
 
@@ -1739,12 +1749,30 @@ val build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder ->
     See the method [llvm::LLVMBuilder::CreateSwitch]. *)
 val build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue
 
+(** [build_malloc ty name b] creates an [malloc]
+    instruction at the position specified by the instruction builder [b].
+    See the method [llvm::CallInst::CreateMalloc]. *)
+val build_malloc : lltype -> string -> llbuilder -> llvalue
+
+(** [build_array_malloc ty val name b] creates an [array malloc]
+    instruction at the position specified by the instruction builder [b].
+    See the method [llvm::CallInst::CreateArrayMalloc]. *)
+val build_array_malloc : lltype -> llvalue -> string -> llbuilder -> llvalue
+
+(** [build_free p b] creates a [free]
+    instruction at the position specified by the instruction builder [b].
+    See the method [llvm::LLVMBuilder::CreateFree]. *)
+val build_free : llvalue -> llbuilder -> llvalue
 
 (** [add_case sw onval bb] causes switch instruction [sw] to branch to [bb]
     when its input matches the constant [onval].
     See the method [llvm::SwitchInst::addCase]. **)
 val add_case : llvalue -> llvalue -> llbasicblock -> unit
 
+(** [switch_default_dest sw] returns the default destination of the [switch]
+ * instruction.
+ * See the method [llvm:;SwitchInst::getDefaultDest]. **)
+val switch_default_dest : llvalue -> llbasicblock
 
 (** [build_indirect_br addr count b] creates a
     [indirectbr %addr]
@@ -1778,6 +1806,15 @@ val build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
     See the method [llvm::LandingPadInst::setCleanup]. *)
 val set_cleanup : llvalue -> bool -> unit
 
+(** [add_clause lp clause] adds the clause to the [landingpad]instruction.
+    See the method [llvm::LandingPadInst::addClause]. *)
+val add_clause : llvalue -> llvalue -> unit
+
+(* [build_resume exn b] builds a [resume exn] instruction
+ * at the position specified by the instruction builder [b].
+ * See the method [llvm::LLVMBuilder::CreateResume] *)
+val build_resume : llvalue -> llbuilder -> llvalue
+
 (** [build_unreachable b] creates an
     [unreachable]
     instruction at the position specified by the instruction builder [b].
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 5090bf83d1..86cc4bd014 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -387,6 +387,18 @@ CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
   return LLVMLabelTypeInContext(Context);
 }
 
+CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
+{
+  CAMLparam1(Name);
+  LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
+  if (Ty) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) Ty;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
 /*===-- VALUES ------------------------------------------------------------===*/
 
 /* llvalue -> lltype */
@@ -1098,6 +1110,19 @@ CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
 DEFINE_ITERATORS(
   block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
 
+/* llbasicblock -> llvalue option */
+CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
+{
+  CAMLparam0();
+  LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
+  if (Term) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) Term;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
 /* llvalue -> llbasicblock array */
 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
   value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
@@ -1232,6 +1257,11 @@ CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
   CAMLreturn(Tl);
 }
 
+/* llvalue -> unit */
+CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
+  LLVMInstructionEraseFromParent(Instruction);
+  return Val_unit;
+}
 
 /*===-- Instruction builders ----------------------------------------------===*/
 
@@ -1359,6 +1389,27 @@ CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
   return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
 }
 
+/* lltype -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
+                                        value B)
+{
+  return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
+}
+
+/* lltype -> llvalue -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
+                                              LLVMValueRef Val,
+                                              value Name, value B)
+{
+  return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
+}
+
+/* llvalue -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
+{
+  return LLVMBuildFree(Builder_val(B), P);
+}
+
 /* llvalue -> llvalue -> llbasicblock -> unit */
 CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
                              LLVMBasicBlockRef Dest) {
@@ -1399,6 +1450,7 @@ CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
                                Args[4], Args[5]);
 }
 
+/* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
                                             value NumClauses,  value Name,
                                             value B) {
@@ -1406,12 +1458,27 @@ CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
                                String_val(Name));
 }
 
+/* llvalue -> llvalue -> unit */
+CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal)
+{
+    LLVMAddClause(LandingPadInst, ClauseVal);
+    return Val_unit;
+}
+
+
+/* llvalue -> bool -> unit */
 CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
 {
     LLVMSetCleanup(LandingPadInst, Bool_val(flag));
     return Val_unit;
 }
 
+/* llvalue -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B)
+{
+    return LLVMBuildResume(Builder_val(B), Exn);
+}
+
 /* llbuilder -> llvalue */
 CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
   return LLVMBuildUnreachable(Builder_val(B));
diff --git a/bindings/ocaml/transforms/scalar/llvm_scalar_opts.ml b/bindings/ocaml/transforms/scalar/llvm_scalar_opts.ml
index 276e1182d0..93ab1de258 100644
--- a/bindings/ocaml/transforms/scalar/llvm_scalar_opts.ml
+++ b/bindings/ocaml/transforms/scalar/llvm_scalar_opts.ml
@@ -20,6 +20,15 @@ external add_aggressive_dce : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
 external
 add_scalar_repl_aggregation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
                             = "llvm_add_scalar_repl_aggregation"
+
+external
+add_scalar_repl_aggregation_ssa : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+                            = "llvm_add_scalar_repl_aggregation_ssa"
+
+external
+add_scalar_repl_aggregation_with_threshold : int -> [<Llvm.PassManager.any] Llvm.PassManager.t
+                                             -> unit
+                            = "llvm_add_scalar_repl_aggregation_with_threshold"
 external add_ind_var_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t
                                       -> unit
                                     = "llvm_add_ind_var_simplification"
@@ -67,6 +76,36 @@ external add_memcpy_opt : [<Llvm.PassManager.any] Llvm.PassManager.t
 external add_loop_deletion : [<Llvm.PassManager.any] Llvm.PassManager.t
                              -> unit
                            = "llvm_add_loop_deletion"
+
+external add_loop_idiom : [<Llvm.PassManager.any] Llvm.PassManager.t
+                             -> unit
+                           = "llvm_add_loop_idiom"
+
 external
 add_lib_call_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
                             = "llvm_add_lib_call_simplification"
+
+external
+add_verifier : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_verifier"
+
+external
+add_correlated_value_propagation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_correlated_value_propagation"
+
+external
+add_early_cse : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_early_cse"
+
+external
+add_lower_expect_intrinsic : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_lower_expect_intrinsic"
+
+external
+add_type_based_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_type_based_alias_analysis"
+
+external
+add_basic_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_basic_alias_analysis"
+
diff --git a/bindings/ocaml/transforms/scalar/llvm_scalar_opts.mli b/bindings/ocaml/transforms/scalar/llvm_scalar_opts.mli
index d7162c769e..121b376128 100644
--- a/bindings/ocaml/transforms/scalar/llvm_scalar_opts.mli
+++ b/bindings/ocaml/transforms/scalar/llvm_scalar_opts.mli
@@ -35,6 +35,17 @@ external
 add_scalar_repl_aggregation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
                             = "llvm_add_scalar_repl_aggregation"
 
+(** See the [llvm::createScalarReplAggregatesPassSSA] function. *)
+external
+add_scalar_repl_aggregation_ssa : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+                            = "llvm_add_scalar_repl_aggregation_ssa"
+
+(** See the [llvm::createScalarReplAggregatesWithThreshold] function. *)
+external
+add_scalar_repl_aggregation_with_threshold : int -> [<Llvm.PassManager.any] Llvm.PassManager.t
+                                             -> unit
+                            = "llvm_add_scalar_repl_aggregation_with_threshold"
+
 (** See the [llvm::createIndVarSimplifyPass] function. *)
 external add_ind_var_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t
                                       -> unit
@@ -112,7 +123,42 @@ external add_loop_deletion : [<Llvm.PassManager.any] Llvm.PassManager.t
                              -> unit
                            = "llvm_add_loop_deletion"
 
+external add_loop_idiom : [<Llvm.PassManager.any] Llvm.PassManager.t
+                             -> unit
+                           = "llvm_add_loop_idiom"
+
 (** See the [llvm::createSimplifyLibCallsPass] function. *)
 external
 add_lib_call_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
                             = "llvm_add_lib_call_simplification"
+
+(** See the [llvm::createVerifierPass] function. *)
+external
+add_verifier : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_verifier"
+
+(** See the [llvm::createCorrelatedValuePropagationPass] function. *)
+external
+add_correlated_value_propagation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_correlated_value_propagation"
+
+(** See the [llvm::createEarlyCSE] function. *)
+external
+add_early_cse : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_early_cse"
+
+(** See the [llvm::createLowerExpectIntrinsicPass] function. *)
+external
+add_lower_expect_intrinsic : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_lower_expect_intrinsic"
+
+(** See the [llvm::createTypeBasedAliasAnalysisPass] function. *)
+external
+add_type_based_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_type_based_alias_analysis"
+
+(** See the [llvm::createBasicAliasAnalysisPass] function. *)
+external
+add_basic_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
+        = "llvm_add_basic_alias_analysis"
+
diff --git a/bindings/ocaml/transforms/scalar/scalar_opts_ocaml.c b/bindings/ocaml/transforms/scalar/scalar_opts_ocaml.c
index df44807859..2db645624a 100644
--- a/bindings/ocaml/transforms/scalar/scalar_opts_ocaml.c
+++ b/bindings/ocaml/transforms/scalar/scalar_opts_ocaml.c
@@ -50,6 +50,19 @@ CAMLprim value llvm_add_scalar_repl_aggregation(LLVMPassManagerRef PM) {
 }
 
 /* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
+CAMLprim value llvm_add_scalar_repl_aggregation_ssa(LLVMPassManagerRef PM) {
+  LLVMAddScalarReplAggregatesPassSSA(PM);
+  return Val_unit;
+}
+
+/* [<Llvm.PassManager.any] Llvm.PassManager.t -> int -> unit */
+CAMLprim value llvm_add_scalar_repl_aggregation_with_threshold(value threshold,
+							       LLVMPassManagerRef PM) {
+  LLVMAddScalarReplAggregatesPassWithThreshold(PM, Int_val(threshold));
+  return Val_unit;
+}
+
+/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
 CAMLprim value llvm_add_ind_var_simplification(LLVMPassManagerRef PM) {
   LLVMAddIndVarSimplifyPass(PM);
   return Val_unit;
@@ -69,7 +82,7 @@ CAMLprim value llvm_add_licm(LLVMPassManagerRef PM) {
 
 /* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
 CAMLprim value llvm_add_loop_unswitch(LLVMPassManagerRef PM) {
-  LLVMAddLoopUnrollPass(PM);
+  LLVMAddLoopUnswitchPass(PM);
   return Val_unit;
 }
 
@@ -140,7 +153,49 @@ CAMLprim value llvm_add_loop_deletion(LLVMPassManagerRef PM) {
 }
 
 /* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
+CAMLprim value llvm_add_loop_idiom(LLVMPassManagerRef PM) {
+  LLVMAddLoopIdiomPass(PM);
+  return Val_unit;
+}
+
+/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
 CAMLprim value llvm_add_lib_call_simplification(LLVMPassManagerRef PM) {
   LLVMAddSimplifyLibCallsPass(PM);
   return Val_unit;
 }
+
+/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
+CAMLprim value llvm_add_verifier(LLVMPassManagerRef PM) {
+  LLVMAddVerifierPass(PM);
+  return Val_unit;
+}
+
+/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
+CAMLprim value llvm_add_correlated_value_propagation(LLVMPassManagerRef PM) {
+  LLVMAddCorrelatedValuePropagationPass(PM);
+  return Val_unit;
+}
+
+/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
+CAMLprim value llvm_add_early_cse(LLVMPassManagerRef PM) {
+  LLVMAddEarlyCSEPass(PM);
+  return Val_unit;
+}
+
+/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
+CAMLprim value llvm_add_lower_expect_intrinsic(LLVMPassManagerRef PM) {
+  LLVMAddLowerExpectIntrinsicPass(PM);
+  return Val_unit;
+}
+
+/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
+CAMLprim value llvm_add_type_based_alias_analysis(LLVMPassManagerRef PM) {
+  LLVMAddTypeBasedAliasAnalysisPass(PM);
+  return Val_unit;
+}
+
+/* [<Llvm.PassManager.any] Llvm.PassManager.t -> unit */
+CAMLprim value llvm_add_basic_alias_analysis(LLVMPassManagerRef PM) {
+  LLVMAddBasicAliasAnalysisPass(PM);
+  return Val_unit;
+}