[OCaml] PR19859: Add functions to query and modify branches.

Patch by Gabriel Radanne <drupyog@zoho.com>.

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

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 0c434afb34a25d6dd7216f43429341ae2e5ffd53..9f27b2dc4905cbdfb299193a1ca9cec4c0f36cb5 100644 (file)
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -1026,6 +1026,63 @@ external set_tail_call : bool -> llvalue -> unit = "llvm_set_tail_call"
 external is_volatile : llvalue -> bool = "llvm_is_volatile"
 external set_volatile : bool -> llvalue -> unit = "llvm_set_volatile"
 
 external is_volatile : llvalue -> bool = "llvm_is_volatile"
 external set_volatile : bool -> llvalue -> unit = "llvm_set_volatile"
 

+(*--... Operations on terminators ..........................................--*)
+
+let is_terminator llv =
+  let open ValueKind in
+  let open Opcode in
+  match classify_value llv with
+    | Instruction (Br | IndirectBr | Invoke | Resume | Ret | Switch | Unreachable)
+      -> true
+    | _ -> false
+
+external successor : llvalue -> int -> llbasicblock = "llvm_successor"
+external set_successor : llvalue -> int -> llbasicblock -> unit
+                       = "llvm_set_successor"
+external num_successors : llvalue -> int = "llvm_num_successors"
+
+let successors llv =
+  if not (is_terminator llv) then
+    raise (Invalid_argument "Llvm.successors can only be used on terminators")
+  else
+    Array.init (num_successors llv) (successor llv)
+
+let iter_successors f llv =
+  if not (is_terminator llv) then
+    raise (Invalid_argument "Llvm.iter_successors can only be used on terminators")
+  else
+    for i = 0 to num_successors llv - 1 do
+      f (successor llv i)
+    done
+
+let fold_successors f llv z =
+  if not (is_terminator llv) then
+    raise (Invalid_argument "Llvm.fold_successors can only be used on terminators")
+  else
+    let n = num_successors llv in
+    let rec aux i acc =
+      if i >= n then acc
+      else begin
+        let llb = successor llv i in
+        aux (i+1) (f llb acc)
+      end
+    in aux 0 z
+
+
+(*--... Operations on branches .............................................--*)
+external condition : llvalue -> llvalue = "llvm_condition"
+external set_condition : llvalue -> llvalue -> unit
+                       = "llvm_set_condition"
+external is_conditional : llvalue -> bool = "llvm_is_conditional"
+
+let get_branch llv =
+  if classify_value llv <> ValueKind.Instruction Opcode.Br then
+    None
+  else if is_conditional llv then
+    Some (`Conditional (condition llv, successor llv 0, successor llv 1))
+  else
+    Some (`Unconditional (successor llv 0))
+

 (*--... Operations on phi nodes ............................................--*)
 external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
                       = "llvm_add_incoming"
 (*--... Operations on phi nodes ............................................--*)
 external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
                       = "llvm_add_incoming"

diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 10aa706b70ef9f949f18b6f24cfd8c1b2b2879b1..fb41a8134dfaf3d65bd51bbd61255f41d409120e 100644 (file)
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -1767,6 +1767,52 @@ val is_volatile : llvalue -> bool
     [llvm::StoreInst::setVolatile]. *)
 val set_volatile : bool -> llvalue -> unit
 
     [llvm::StoreInst::setVolatile]. *)
 val set_volatile : bool -> llvalue -> unit
 

+(** {7 Operations on terminators} *)
+
+(** [is_terminator v] returns true if the instruction [v] is a terminator. *)
+val is_terminator : llvalue -> bool
+
+(** [successor v i] returns the successor at index [i] for the value [v].
+    See the method [llvm::TerminatorInst::getSuccessor]. *)
+val successor : llvalue -> int -> llbasicblock
+
+(** [set_successor v i o] sets the successor of the value [v] at the index [i] to
+    the value [o].
+    See the method [llvm::TerminatorInst::setSuccessor]. *)
+val set_successor : llvalue -> int -> llbasicblock -> unit
+
+(** [num_successors v] returns the number of successors for the value [v].
+    See the method [llvm::TerminatorInst::getNumSuccessors]. *)
+val num_successors : llvalue -> int
+
+(** [successors v] returns the successors of [v]. *)
+val successors : llvalue -> llbasicblock array
+
+(** [iter_successors f v] applies function f to each successor [v] in order. Tail recursive. *)
+val iter_successors : (llbasicblock -> unit) -> llvalue -> unit
+
+(** [fold_successors f v init] is [f (... (f init vN) ...) v1] where [v1,...,vN] are the successors of [v]. Tail recursive. *)
+val fold_successors : (llbasicblock -> 'a -> 'a) -> llvalue -> 'a -> 'a
+
+(** {7 Operations on branches} *)
+
+(** [is_conditional v] returns true if the branch instruction [v] is conditional.
+    See the method [llvm::BranchInst::isConditional]. *)
+val is_conditional : llvalue -> bool
+
+(** [condition v] return the condition of the branch instruction [v].
+    See the method [llvm::BranchInst::getCondition]. *)
+val condition : llvalue -> llvalue
+
+(** [set_condition v c] sets the condition of the branch instruction [v] to the value [c].
+    See the method [llvm::BranchInst::setCondition]. *)
+val set_condition : llvalue -> llvalue -> unit
+
+(** [get_branch c] returns a description of the branch instruction [c]. *)
+val get_branch : llvalue ->
+  [ `Conditional of llvalue * llbasicblock * llbasicblock
+  | `Unconditional of llbasicblock ]
+    option

 
 (** {7 Operations on phi nodes} *)
 
 
 (** {7 Operations on phi nodes} *)
 

diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 02107223eb65aaa845ba49168ce1bac7990b0348..7eb88aa62e88517124782319c3d9f9c5f15da733 100644 (file)
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -1451,6 +1451,43 @@ CAMLprim value llvm_set_volatile(value IsVolatile,
   return Val_unit;
 }
 
   return Val_unit;
 }
 

+
+/*--.. Operations on terminators ...........................................--*/
+
+/* llvalue -> int -> llbasicblock */
+CAMLprim LLVMBasicBlockRef llvm_successor(LLVMValueRef V, value I) {
+  return LLVMGetSuccessor(V, Int_val(I));
+}
+
+/* llvalue -> int -> llvalue -> unit */
+CAMLprim value llvm_set_successor(LLVMValueRef U, value I, LLVMBasicBlockRef B) {
+  LLVMSetSuccessor(U, Int_val(I), B);
+  return Val_unit;
+}
+
+/* llvalue -> int */
+CAMLprim value llvm_num_successors(LLVMValueRef V) {
+  return Val_int(LLVMGetNumSuccessors(V));
+}
+
+/*--.. Operations on branch ................................................--*/
+
+/* llvalue -> llvalue */
+CAMLprim LLVMValueRef llvm_condition(LLVMValueRef V) {
+  return LLVMGetCondition(V);
+}
+
+/* llvalue -> llvalue -> unit */
+CAMLprim value llvm_set_condition(LLVMValueRef B, LLVMValueRef C) {
+  LLVMSetCondition(B, C);
+  return Val_unit;
+}
+
+/* llvalue -> bool */
+CAMLprim value llvm_is_conditional(LLVMValueRef V) {
+  return Val_bool(LLVMIsConditional(V));
+}
+

 /*--... Operations on phi nodes ............................................--*/
 
 /* (llvalue * llbasicblock) -> llvalue -> unit */
 /*--... Operations on phi nodes ............................................--*/
 
 /* (llvalue * llbasicblock) -> llvalue -> unit */

diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml
index 0d604983678e277fc1929da96728d72c6f2cce02..dcfeaea1e023f3c5026331bdf3de2adf21a63c04 100644 (file)
--- a/test/Bindings/Ocaml/vmcore.ml
+++ b/test/Bindings/Ocaml/vmcore.ml
@@ -1197,7 +1197,10 @@ let test_builder () =
      *)
     let bb02 = append_block context "Bb02" fn in
     let b = builder_at_end context bb02 in
      *)
     let bb02 = append_block context "Bb02" fn in
     let b = builder_at_end context bb02 in

-    ignore (build_br bb02 b)
+    let br = build_br bb02 b in
+    insist (successors br = [| bb02 |]) ;
+    insist (is_conditional br = false) ;
+    insist (get_branch br = Some (`Unconditional bb02)) ;

   end;
   
   group "cond_br"; begin
   end;
   
   group "cond_br"; begin


@@ -1206,7 +1209,12 @@ let test_builder () =
     let bb03 = append_block context "Bb03" fn in
     let b = builder_at_end context bb03 in
     let cond = build_trunc p1 i1_type "build_br" b in
     let bb03 = append_block context "Bb03" fn in
     let b = builder_at_end context bb03 in
     let cond = build_trunc p1 i1_type "build_br" b in

-    ignore (build_cond_br cond bb03 bb00 b)
+    let br = build_cond_br cond bb03 bb00 b in
+    insist (num_successors br = 2) ;
+    insist (successor br 0 = bb03) ;
+    insist (successor br 1 = bb00) ;
+    insist (is_conditional br = true) ;
+    insist (get_branch br = Some (`Conditional (cond, bb03, bb00))) ;

   end;
   
   group "switch"; begin
   end;
   
   group "switch"; begin


@@ -1222,6 +1230,8 @@ let test_builder () =
         ignore (add_case si (const_int i32_type 2) bb2);
         insist (switch_default_dest si = bb3);
     end;
         ignore (add_case si (const_int i32_type 2) bb2);
         insist (switch_default_dest si = bb3);
     end;

+    insist (num_successors si = 2) ;
+    insist (get_branch si = None) ;

   end;
 
   group "malloc/free"; begin
   end;
 
   group "malloc/free"; begin