C and Objective Caml bindings for the various getParent methods of the IR.

Based on Erick Tryzelaar's patch.

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

bindings/ocaml/llvm/llvm.ml

@@ -270,6 +270,7 @@ external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue
                              = "LLVMConstShuffleVector"
 
 (*--... Operations on global variables, functions, and aliases (globals) ...--*)
+external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent"
 external is_declaration : llvalue -> bool = "llvm_is_declaration"
 external linkage : llvalue -> Linkage.t = "llvm_linkage"
 external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage"
@@ -306,8 +307,6 @@ external define_function : string -> lltype -> llmodule -> llvalue
 external lookup_function : string -> llmodule -> llvalue option
                          = "llvm_lookup_function"
 external delete_function : llvalue -> unit = "llvm_delete_function"
-external params : llvalue -> llvalue array = "llvm_params"
-external param : llvalue -> int -> llvalue = "llvm_param"
 external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic"
 external function_call_conv : llvalue -> int = "llvm_function_call_conv"
 external set_function_call_conv : int -> llvalue -> unit
@@ -317,16 +316,25 @@ external set_collector : string option -> llvalue -> unit = "llvm_set_collector"
 
 (* TODO: param attrs *)
 
+(*--... Operations on params ...............................................--*)
+external params : llvalue -> llvalue array = "llvm_params"
+external param : llvalue -> int -> llvalue = "llvm_param"
+external param_parent : llvalue -> llvalue = "LLVMGetParamParent"
+
 (*--... Operations on basic blocks .........................................--*)
+external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
+external value_is_block : llvalue -> bool = "llvm_value_is_block"
+external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
+external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent"
 external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks"
 external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock"
 external delete_block : llbasicblock -> unit = "llvm_delete_block"
 external append_block : string -> llvalue -> llbasicblock = "llvm_append_block"
 external insert_block : string -> llbasicblock -> llbasicblock
                       = "llvm_insert_block"
-external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
+
-external value_is_block : llvalue -> bool = "llvm_value_is_block"
+(*--... Operations on instructions .........................................--*)
-external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
+external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent"
 
 (*--... Operations on call sites ...........................................--*)
 external instruction_call_conv: llvalue -> int
@@ -341,13 +349,13 @@ external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
 
 
 (*===-- Instruction builders ----------------------------------------------===*)
-external builder: unit-> llbuilder
+external builder: unit-> llbuilder = "llvm_builder"
-                = "llvm_builder"
 external builder_before : llvalue -> llbuilder = "llvm_builder_before"
 external builder_at_end : llbasicblock -> llbuilder = "llvm_builder_at_end"
 external position_before : llvalue -> llbuilder -> unit = "llvm_position_before"
 external position_at_end : llbasicblock -> llbuilder -> unit
                          = "llvm_position_at_end"
+external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block"
 
 (*--... Terminators ........................................................--*)
 external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void"

bindings/ocaml/llvm/llvm.mli

@@ -676,6 +676,10 @@ external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue
 
 (** {7 Operations on global variables, functions, and aliases (globals)} *)
 
+(** [global_parent g] is the enclosing module of the global value [g].
+    See the method [llvm::GlobalValue::getParent]. *)
+external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent"
+
 (** [is_declaration g] returns [true] if the global value [g] is a declaration
     only. Returns [false] otherwise.
     See the method [llvm::GlobalValue::isDeclaration]. *)
@@ -808,14 +812,6 @@ external lookup_function : string -> llmodule -> llvalue option
     See the method [llvm::Function::eraseFromParent]. *)
 external delete_function : llvalue -> unit = "llvm_delete_function"
 
-(** [params f] returns the parameters of function [f].
-    See the method [llvm::Function::getArgumentList]. *)
-external params : llvalue -> llvalue array = "llvm_params"
-
-(** [param f n] returns the [n]th parameter of function [f].
-    See the method [llvm::Function::getArgumentList]. *)
-external param : llvalue -> int -> llvalue = "llvm_param"
-
 (** [is_intrinsic f] returns true if the function [f] is an intrinsic.
     See the method [llvm::Function::isIntrinsic]. *)
 external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic"
@@ -840,6 +836,21 @@ external collector : llvalue -> string option = "llvm_collector"
 external set_collector : string option -> llvalue -> unit = "llvm_set_collector"
 
 
+(** {7 Operations on params} *)
+
+(** [params f] returns the parameters of function [f].
+    See the method [llvm::Function::getArgumentList]. *)
+external params : llvalue -> llvalue array = "llvm_params"
+
+(** [param f n] returns the [n]th parameter of function [f].
+    See the method [llvm::Function::getArgumentList]. *)
+external param : llvalue -> int -> llvalue = "llvm_param"
+
+(** [param_parent p] returns the parent function that owns the parameter.
+    See the method [llvm::Argument::getParent]. *)
+external param_parent : llvalue -> llvalue = "LLVMGetParamParent"
+
+
 (** {7 Operations on basic blocks} *)
 
 (** [basic_blocks fn] returns the basic blocks of the function [f].
@@ -865,6 +876,10 @@ external append_block : string -> llvalue -> llbasicblock = "llvm_append_block"
 external insert_block : string -> llbasicblock -> llbasicblock
                       = "llvm_insert_block"
 
+(** [block_parent bb] returns the parent function that owns the basic block.
+    See the method [llvm::BasicBlock::getParent]. *)
+external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent"
+
 (** [value_of_block bb] losslessly casts [bb] to an [llvalue]. *)
 external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
 
@@ -877,6 +892,13 @@ external value_is_block : llvalue -> bool = "llvm_value_is_block"
 external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
 
 
+(** {7 Operations on instructions} *)
+
+(** [instr_parent i] is the enclosing basic block of the instruction [i].
+    See the method [llvm::Instruction::getParent]. *)
+external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent"
+
+
 (** {7 Operations on call sites} *)
 
 (** [instruction_call_conv ci] is the calling convention for the call or invoke
@@ -886,9 +908,10 @@ external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
 external instruction_call_conv: llvalue -> int
                               = "llvm_instruction_call_conv"
 
-(** [set_inst_call_conv cc ci] sets the calling convention for the call or
+(** [set_instruction_call_conv cc ci] sets the calling convention for the call
-    invoke instruction [ci] to the integer [cc], which can be one of the values
+    or invoke instruction [ci] to the integer [cc], which can be one of the
-    from the module {!CallConv}. See the method [llvm::CallInst::setCallingConv]
+    values from the module {!CallConv}.
+    See the method [llvm::CallInst::setCallingConv]
     and [llvm::InvokeInst::setCallingConv]. *)
 external set_instruction_call_conv: int -> llvalue -> unit
                                   = "llvm_set_instruction_call_conv"
@@ -909,8 +932,8 @@ external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
 
 (** {6 Instruction builders} *)
 
-(** [builder] creates an instruction builder with no position. It is invalid to
+(** [builder ()] creates an instruction builder with no position. It is invalid
-    use this builder until its position is set with {!position_before} or
+    to use this builder until its position is set with {!position_before} or
     {!position_at_end}. See the constructor for [llvm::LLVMBuilder]. *)
 external builder: unit-> llbuilder
                 = "llvm_builder"
@@ -932,6 +955,12 @@ external position_before : llvalue -> llbuilder -> unit = "llvm_position_before"
 external position_at_end : llbasicblock -> llbuilder -> unit
                          = "llvm_position_at_end"
 
+(** [insertion_block b] returns the basic block that the builder [b] is
+    positioned to insert into. Raises [Not_Found] if the instruction builder is
+    uninitialized.
+    See the method [llvm::LLVMBuilder::GetInsertBlock]. *)
+external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block"
+
 
 (** {7 Terminators} *)
 

bindings/ocaml/llvm/llvm_ocaml.c

@@ -761,6 +761,14 @@ CAMLprim value llvm_position_at_end(LLVMBasicBlockRef BB, value B) {
   return Val_unit;
 }
 
+/* llbuilder -> llbasicblock */
+CAMLprim LLVMBasicBlockRef llvm_insertion_block(LLVMBuilderRef B) {
+  LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B));
+  if (!InsertBlock)
+    raise_not_found();
+  return InsertBlock;
+}
+
 /*--... Terminators ........................................................--*/
 
 /* llbuilder -> llvalue */

include/llvm-c/Core.h

@@ -362,6 +362,7 @@ LLVMValueRef LLVMConstShuffleVector(LLVMValueRef VectorAConstant,
                                     LLVMValueRef MaskConstant);
 
 /* Operations on global variables, functions, and aliases (globals) */
+LLVMModuleRef LLVMGetGlobalParent(LLVMValueRef Global);
 int LLVMIsDeclaration(LLVMValueRef Global);
 LLVMLinkage LLVMGetLinkage(LLVMValueRef Global);
 void LLVMSetLinkage(LLVMValueRef Global, LLVMLinkage Linkage);
@@ -389,19 +390,23 @@ LLVMValueRef LLVMAddFunction(LLVMModuleRef M, const char *Name,
                              LLVMTypeRef FunctionTy);
 LLVMValueRef LLVMGetNamedFunction(LLVMModuleRef M, const char *Name);
 void LLVMDeleteFunction(LLVMValueRef Fn);
-unsigned LLVMCountParams(LLVMValueRef Fn);
-void LLVMGetParams(LLVMValueRef Fn, LLVMValueRef *Params);
-LLVMValueRef LLVMGetParam(LLVMValueRef Fn, unsigned Index);
 unsigned LLVMGetIntrinsicID(LLVMValueRef Fn);
 unsigned LLVMGetFunctionCallConv(LLVMValueRef Fn);
 void LLVMSetFunctionCallConv(LLVMValueRef Fn, unsigned CC);
 const char *LLVMGetCollector(LLVMValueRef Fn);
 void LLVMSetCollector(LLVMValueRef Fn, const char *Coll);
 
+/* Operations on parameters */
+unsigned LLVMCountParams(LLVMValueRef Fn);
+void LLVMGetParams(LLVMValueRef Fn, LLVMValueRef *Params);
+LLVMValueRef LLVMGetParam(LLVMValueRef Fn, unsigned Index);
+LLVMValueRef LLVMGetParamParent(LLVMValueRef Inst);
+
 /* Operations on basic blocks */
 LLVMValueRef LLVMBasicBlockAsValue(LLVMBasicBlockRef Bb);
 int LLVMValueIsBasicBlock(LLVMValueRef Val);
 LLVMBasicBlockRef LLVMValueAsBasicBlock(LLVMValueRef Val);
+LLVMValueRef LLVMGetBasicBlockParent(LLVMValueRef V);
 unsigned LLVMCountBasicBlocks(LLVMValueRef Fn);
 void LLVMGetBasicBlocks(LLVMValueRef Fn, LLVMBasicBlockRef *BasicBlocks);
 LLVMBasicBlockRef LLVMGetEntryBasicBlock(LLVMValueRef Fn);
@@ -410,6 +415,9 @@ LLVMBasicBlockRef LLVMInsertBasicBlock(LLVMBasicBlockRef InsertBeforeBB,
                                        const char *Name);
 void LLVMDeleteBasicBlock(LLVMBasicBlockRef BB);
 
+/* Operations on instructions */
+LLVMBasicBlockRef LLVMGetInstructionParent(LLVMValueRef Inst);
+
 /* Operations on call sites */
 void LLVMSetInstructionCallConv(LLVMValueRef Instr, unsigned CC);
 unsigned LLVMGetInstructionCallConv(LLVMValueRef Instr);
@@ -430,6 +438,7 @@ LLVMBasicBlockRef LLVMGetIncomingBlock(LLVMValueRef PhiNode, unsigned Index);
 LLVMBuilderRef LLVMCreateBuilder();
 void LLVMPositionBuilderBefore(LLVMBuilderRef Builder, LLVMValueRef Instr);
 void LLVMPositionBuilderAtEnd(LLVMBuilderRef Builder, LLVMBasicBlockRef Block);
+LLVMBasicBlockRef LLVMGetInsertBlock(LLVMBuilderRef Builder);
 void LLVMDisposeBuilder(LLVMBuilderRef Builder);
 
 /* Terminators */

lib/VMCore/Core.cpp

@@ -215,7 +215,7 @@ LLVMTypeRef LLVMOpaqueType() {
   return wrap(llvm::OpaqueType::get());
 }
 
-/* Operations on type handles */
+/*--.. Operations on type handles ..........................................--*/
 
 LLVMTypeHandleRef LLVMCreateTypeHandle(LLVMTypeRef PotentiallyAbstractTy) {
   return wrap(new PATypeHolder(unwrap(PotentiallyAbstractTy)));
@@ -546,6 +546,10 @@ LLVMValueRef LLVMConstShuffleVector(LLVMValueRef VectorAConstant,
 
 /*--.. Operations on global variables, functions, and aliases (globals) ....--*/
 
+LLVMModuleRef LLVMGetGlobalParent(LLVMValueRef Global) {
+  return wrap(unwrap<GlobalValue>(Global)->getParent());
+}
+
 int LLVMIsDeclaration(LLVMValueRef Global) {
   return unwrap<GlobalValue>(Global)->isDeclaration();
 }
@@ -646,26 +650,6 @@ void LLVMDeleteFunction(LLVMValueRef Fn) {
   unwrap<Function>(Fn)->eraseFromParent();
 }
 
-unsigned LLVMCountParams(LLVMValueRef FnRef) {
-  // This function is strictly redundant to
-  //   LLVMCountParamTypes(LLVMGetElementType(LLVMTypeOf(FnRef)))
-  return unwrap<Function>(FnRef)->getArgumentList().size();
-}
-
-LLVMValueRef LLVMGetParam(LLVMValueRef FnRef, unsigned index) {
-  Function::arg_iterator AI = unwrap<Function>(FnRef)->arg_begin();
-  while (index --> 0)
-    AI++;
-  return wrap(AI);
-}
-
-void LLVMGetParams(LLVMValueRef FnRef, LLVMValueRef *ParamRefs) {
-  Function *Fn = unwrap<Function>(FnRef);
-  for (Function::arg_iterator I = Fn->arg_begin(),
-                              E = Fn->arg_end(); I != E; I++)
-    *ParamRefs++ = wrap(I);
-}
-
 unsigned LLVMGetIntrinsicID(LLVMValueRef Fn) {
   if (Function *F = dyn_cast<Function>(unwrap(Fn)))
     return F->getIntrinsicID();
@@ -693,10 +677,36 @@ void LLVMSetCollector(LLVMValueRef Fn, const char *Coll) {
     F->clearCollector();
 }
 
+/*--.. Operations on parameters ............................................--*/
+
+unsigned LLVMCountParams(LLVMValueRef FnRef) {
+  // This function is strictly redundant to
+  //   LLVMCountParamTypes(LLVMGetElementType(LLVMTypeOf(FnRef)))
+  return unwrap<Function>(FnRef)->getArgumentList().size();
+}
+
+void LLVMGetParams(LLVMValueRef FnRef, LLVMValueRef *ParamRefs) {
+  Function *Fn = unwrap<Function>(FnRef);
+  for (Function::arg_iterator I = Fn->arg_begin(),
+                              E = Fn->arg_end(); I != E; I++)
+    *ParamRefs++ = wrap(I);
+}
+
+LLVMValueRef LLVMGetParam(LLVMValueRef FnRef, unsigned index) {
+  Function::arg_iterator AI = unwrap<Function>(FnRef)->arg_begin();
+  while (index --> 0)
+    AI++;
+  return wrap(AI);
+}
+
+LLVMValueRef LLVMGetParamParent(LLVMValueRef V) {
+  return wrap(unwrap<Argument>(V)->getParent());
+}
+
 /*--.. Operations on basic blocks ..........................................--*/
 
-LLVMValueRef LLVMBasicBlockAsValue(LLVMBasicBlockRef Bb) {
+LLVMValueRef LLVMBasicBlockAsValue(LLVMBasicBlockRef BB) {
-  return wrap(static_cast<Value*>(unwrap(Bb)));
+  return wrap(static_cast<Value*>(unwrap(BB)));
 }
 
 int LLVMValueIsBasicBlock(LLVMValueRef Val) {
@@ -707,6 +717,10 @@ LLVMBasicBlockRef LLVMValueAsBasicBlock(LLVMValueRef Val) {
   return wrap(unwrap<BasicBlock>(Val));
 }
 
+LLVMValueRef LLVMGetBasicBlockParent(LLVMValueRef V) {
+  return wrap(unwrap<BasicBlock>(V)->getParent());
+}
+
 unsigned LLVMCountBasicBlocks(LLVMValueRef FnRef) {
   return unwrap<Function>(FnRef)->getBasicBlockList().size();
 }
@@ -736,6 +750,12 @@ void LLVMDeleteBasicBlock(LLVMBasicBlockRef BBRef) {
   unwrap(BBRef)->eraseFromParent();
 }
 
+/*--.. Operations on instructions ..........................................--*/
+
+LLVMBasicBlockRef LLVMGetInstructionParent(LLVMValueRef Inst) {
+  return wrap(unwrap<Instruction>(Inst)->getParent());
+}
+
 /*--.. Call and invoke instructions ........................................--*/
 
 unsigned LLVMGetInstructionCallConv(LLVMValueRef Instr) {
@@ -795,6 +815,10 @@ void LLVMPositionBuilderAtEnd(LLVMBuilderRef Builder, LLVMBasicBlockRef Block) {
   unwrap(Builder)->SetInsertPoint(BB);
 }
 
+LLVMBasicBlockRef LLVMGetInsertBlock(LLVMBuilderRef Builder) {
+   return wrap(unwrap(Builder)->GetInsertBlock());
+}
+
 void LLVMDisposeBuilder(LLVMBuilderRef Builder) {
   delete unwrap(Builder);
 }

test/Bindings/Ocaml/vmcore.ml

@@ -478,17 +478,19 @@ let test_functions () =
   
   (* RUN: grep {declare i32 @Fn1\(i32, i64\)} < %t.ll
    *)
-  group "declare";
+  begin group "declare";
-  insist (None = lookup_function "Fn1" m);
+    insist (None = lookup_function "Fn1" m);
-  let fn = declare_function "Fn1" ty m in
+    let fn = declare_function "Fn1" ty m in
-  insist (pointer_type ty = type_of fn);
+    insist (pointer_type ty = type_of fn);
-  insist (is_declaration fn);
+    insist (is_declaration fn);
-  insist (0 = Array.length (basic_blocks fn));
+    insist (0 = Array.length (basic_blocks fn));
-  insist (pointer_type ty2 == type_of (declare_function "Fn1" ty2 m));
+    insist (pointer_type ty2 == type_of (declare_function "Fn1" ty2 m));
-  insist (fn == declare_function "Fn1" ty m);
+    insist (fn == declare_function "Fn1" ty m);
-  insist (None <> lookup_function "Fn1" m);
+    insist (None <> lookup_function "Fn1" m);
-  insist (match lookup_function "Fn1" m with Some x -> x = fn
+    insist (match lookup_function "Fn1" m with Some x -> x = fn
-                                           | None -> false);
+                                             | None -> false);
+    insist (m == global_parent fn)
+  end;
   
   (* RUN: grep -v {Fn2} < %t.ll
    *)
@@ -593,6 +595,27 @@ let test_basic_blocks () =
 let test_builder () =
   let (++) x f = f x; x in
   
+  begin group "parent";
+    insist (try
+              ignore (insertion_block (builder ()));
+              false
+            with Not_found ->
+              true);
+    
+    let fty = function_type void_type [| i32_type |] in
+    let fn = define_function "BuilderParent" fty m in
+    let bb = entry_block fn in
+    let b = builder_at_end bb in
+    let p = param fn 0 in
+    let sum = build_add p p "sum" b in
+    ignore (build_ret_void b);
+    
+    insist (fn = block_parent bb);
+    insist (fn = param_parent p);
+    insist (bb = instr_parent sum);
+    insist (bb = insertion_block b)
+  end;
+  
   group "ret void";
   begin
     (* RUN: grep {ret void} < %t.ll