C and Objective Caml bindings for PHINode::addIncoming etc.

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

3 files changed, 67 insertions, 6 deletions

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 779066bddc..e19228afac 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -314,6 +314,11 @@ external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
 external value_is_block : llvalue -> bool = "llvm_value_is_block"
 external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
 
+(*--... Operations on phi nodes ............................................--*)
+external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
+                      = "llvm_add_incoming"
+external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
+
 
 (*===-- Instruction builders ----------------------------------------------===*)
 external builder_before : llvalue -> llbuilder = "llvm_builder_before"
@@ -422,7 +427,8 @@ external build_fcmp : real_predicate -> llvalue -> llvalue -> string ->
                       llbuilder -> llvalue = "llvm_build_fcmp"
 
 (*--... Miscellaneous instructions .........................................--*)
-external build_phi : lltype -> string -> llbuilder -> llvalue = "llvm_build_phi"
+external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder ->
+                     llvalue = "llvm_build_phi"
 external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue
                     = "llvm_build_call"
 external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder ->
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 5e55b200b1..abb90f24c8 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -295,6 +295,11 @@ external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
 external value_is_block : llvalue -> bool = "llvm_value_is_block"
 external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
 
+(*--... Operations on phi nodes ............................................--*)
+external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
+                      = "llvm_add_incoming"
+external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
+
 
 (*===-- Instruction builders ----------------------------------------------===*)
 external builder_before : llvalue -> llbuilder = "llvm_builder_before"
@@ -403,7 +408,8 @@ external build_fcmp : real_predicate -> llvalue -> llvalue -> string ->
                       llbuilder -> llvalue = "llvm_build_fcmp"
 
 (*--... Miscellaneous instructions .........................................--*)
-external build_phi : lltype -> string -> llbuilder -> llvalue = "llvm_build_phi"
+external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder ->
+                     llvalue = "llvm_build_phi"
 external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue
                     = "llvm_build_call"
 external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder ->
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 98354fc84c..ddf577adb2 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -21,6 +21,7 @@
 #include "caml/mlvalues.h"
 #include "caml/memory.h"
 #include "llvm/Config/config.h"
+#include <assert.h>
 
 
 /*===-- Modules -----------------------------------------------------------===*/
@@ -572,6 +573,39 @@ CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
   return Val_bool(LLVMValueIsBasicBlock(Val));
 }
 
+/*--... Operations on phi nodes ............................................--*/
+
+/* (llvalue * llbasicblock) -> llvalue -> unit */
+CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) {
+  LLVMAddIncoming(PhiNode,
+                  (LLVMValueRef*) &Field(Incoming, 0),
+                  (LLVMBasicBlockRef*) &Field(Incoming, 1),
+                  1);
+  return Val_unit;
+}
+
+/* llvalue -> (llvalue * llbasicblock) list */
+CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
+  unsigned I;
+  CAMLparam0();
+  CAMLlocal3(Hd, Tl, Tmp);
+  
+  /* Build a tuple list of them. */
+  Tl = Val_int(0);
+  for (I = LLVMCountIncoming(PhiNode); I != 0; ) {
+    Hd = alloc(2, 0);
+    Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I));
+    Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I));
+    
+    Tmp = alloc(2, 0);
+    Store_field(Tmp, 0, Hd);
+    Store_field(Tmp, 1, Tl);
+    Tl = Tmp;
+  }
+  
+  CAMLreturn(Tl);
+}
+
 
 /*===-- Instruction builders ----------------------------------------------===*/
 
@@ -933,10 +967,25 @@ CAMLprim LLVMValueRef llvm_build_fcmp(value Pred,
 
 /*--... Miscellaneous instructions .........................................--*/
 
-/* lltype -> string -> llbuilder -> llvalue */
-CAMLprim LLVMValueRef llvm_build_phi(LLVMTypeRef Ty,
-                                     value Name, value B) {
-  return LLVMBuildPhi(Builder_val(B), Ty, String_val(Name));
+/* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */
+CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) {
+  value Hd, Tl;
+  LLVMValueRef FirstValue, PhiNode;
+  
+  assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!");
+  
+  Hd = Field(Incoming, 0);
+  FirstValue = (LLVMValueRef) Field(Hd, 0);
+  PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue),
+                         String_val(Name));
+
+  for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) {
+    value Hd = Field(Tl, 0);
+    LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0),
+                    (LLVMBasicBlockRef*) &Field(Hd, 1), 1);
+  }
+  
+  return PhiNode;
 }
 
 /* llvalue -> llvalue array -> string -> llbuilder -> llvalue */