From: Erick Tryzelaar <idadesub@users.sourceforge.net>
Date: Tue, 2 Mar 2010 20:32:32 +0000 (+0000)
Subject: Add support for use to ocaml.
X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=commitdiff_plain;h=705443ffd3f67018c1ec387014262566502a9ee3

Add support for use to ocaml.

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

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 0af8f48fa3b..7b906d26843 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -13,6 +13,7 @@ type llmodule
 type lltype
 type lltypehandle
 type llvalue
+type lluse
 type llbasicblock
 type llbuilder
 type llmoduleprovider
@@ -242,6 +243,38 @@ external dump_value : llvalue -> unit = "llvm_dump_value"
 external replace_all_uses_with : llvalue -> llvalue -> unit
                                = "LLVMReplaceAllUsesWith"
 
+(*--... Operations on uses .................................................--*)
+external use_begin : llvalue -> lluse option = "llvm_use_begin"
+external use_succ : lluse -> lluse option = "llvm_use_succ"
+external user : lluse -> llvalue = "llvm_user"
+external used_value : lluse -> llvalue = "llvm_used_value"
+
+let iter_uses f v =
+  let rec aux = function
+    | None -> ()
+    | Some u ->
+        f u;
+        aux (use_succ u)
+  in
+  aux (use_begin v)
+
+let fold_left_uses f init v =
+  let rec aux init u =
+    match u with
+    | None -> init
+    | Some u -> aux (f init u) (use_succ u)
+  in
+  aux init (use_begin v)
+
+let fold_right_uses f v init =
+  let rec aux u init =
+    match u with
+    | None -> init
+    | Some u -> f u (aux (use_succ u) init)
+  in
+  aux (use_begin v) init
+
+
 (*--... Operations on users ................................................--*)
 external operand : llvalue -> int -> llvalue = "llvm_operand"
 
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 674ec9e9c07..cf06d5a9840 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -39,6 +39,9 @@ type lltypehandle
     This type covers a wide range of subclasses. *)
 type llvalue
 
+(** Used to store users and usees of values. See the [llvm::Use] class. *)
+type lluse
+
 (** A basic block in LLVM IR. See the [llvm::BasicBlock] class. *)
 type llbasicblock
 
@@ -513,6 +516,38 @@ external replace_all_uses_with : llvalue -> llvalue -> unit
                                = "LLVMReplaceAllUsesWith"
 
 
+(* {6 Uses} *)
+
+(** [use_begin v] returns the first position in the use list for the value [v].
+    [use_begin] and [use_succ] can e used to iterate over the use list in order.
+    See the method [llvm::Value::use_begin]. *)
+external use_begin : llvalue -> lluse option = "llvm_use_begin"
+
+(** [use_succ u] returns the use list position succeeding [u].
+    See the method [llvm::use_value_iterator::operator++]. *)
+external use_succ : lluse -> lluse option = "llvm_use_succ"
+
+(** [user u] returns the user of the use [u].
+    See the method [llvm::Use::getUser]. *)
+external user : lluse -> llvalue = "llvm_user"
+
+(** [used_value u] returns the usee of the use [u].
+    See the method [llvm::Use::getUsedValue]. *)
+external used_value : lluse -> llvalue = "llvm_used_value"
+
+(** [iter_uses f v] applies function [f] to each of the users of the value [v]
+    in order. Tail recursive. *)
+val iter_uses : (lluse -> unit) -> llvalue -> unit
+
+(** [fold_left_uses f init v] is [f (... (f init u1) ...) uN] where
+    [u1,...,uN] are the users of the value [v]. Tail recursive. *)
+val fold_left_uses : ('a -> lluse -> 'a) -> 'a -> llvalue -> 'a
+
+(** [fold_right_uses f v init] is [f u1 (... (f uN init) ...)] where
+    [u1,...,uN] are the users of the value [v]. Not tail recursive. *)
+val fold_right_uses : (lluse -> 'a -> 'a) -> llvalue -> 'a -> 'a
+
+
 (* {6 Users} *)
 
 (** [operand v i] returns the operand at index [i] for the value [v]. See the
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index cdd137e51bc..4bcc764a83b 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -707,6 +707,42 @@ CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) {
   return Val_unit;
 }
 
+/*--... Operations on uses .................................................--*/
+
+/* llvalue -> lluse option */
+CAMLprim value llvm_use_begin(LLVMValueRef Val) {
+  CAMLparam0();
+  LLVMUseRef First;
+  if ((First = LLVMGetFirstUse(Val))) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) First;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
+/* lluse -> lluse option */
+CAMLprim value llvm_use_succ(LLVMUseRef U) {
+  CAMLparam0();
+  LLVMUseRef Next;
+  if ((Next = LLVMGetNextUse(U))) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = (value) Next;
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
+/* lluse -> llvalue */
+CAMLprim LLVMValueRef llvm_user(LLVMUseRef UR) {
+  return LLVMGetUser(UR);
+}
+
+/* lluse -> llvalue */
+CAMLprim LLVMValueRef llvm_used_value(LLVMUseRef UR) {
+  return LLVMGetUsedValue(UR);
+}
+
 /*--... Operations on global variables .....................................--*/
 
 DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef,
diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml
index cbd52e46bba..d87e162b9c6 100644
--- a/test/Bindings/Ocaml/vmcore.ml
+++ b/test/Bindings/Ocaml/vmcore.ml
@@ -607,6 +607,33 @@ let test_global_variables () =
   end
 
 
+(*===-- Uses --------------------------------------------------------------===*)
+
+let test_uses () =
+  let ty = function_type i32_type [| i32_type; i32_type |] in
+  let fn = define_function "use_function" ty m in
+  let b = builder_at_end context (entry_block fn) in
+
+  let p1 = param fn 0 in
+  let p2 = param fn 1 in
+  let v1 = build_add p1 p2 "v1" b in
+  let v2 = build_add p1 v1 "v2" b in
+  let _ = build_add v1 v2 "v3" b in
+
+  let lf s u = value_name (user u) ^ "->" ^ s in
+  insist ("v2->v3->" = fold_left_uses lf "" v1);
+  let rf u s = value_name (user u) ^ "<-" ^ s in
+  insist ("v3<-v2<-" = fold_right_uses rf v1 "");
+
+  let lf s u = value_name (used_value u) ^ "->" ^ s in
+  insist ("v1->v1->" = fold_left_uses lf "" v1);
+
+  let rf u s = value_name (used_value u) ^ "<-" ^ s in
+  insist ("v1<-v1<-" = fold_right_uses rf v1 "");
+
+  ignore (build_unreachable b)
+
+
 (*===-- Users -------------------------------------------------------------===*)
 
 let test_users () =
@@ -1291,6 +1318,7 @@ let _ =
   suite "constants"        test_constants;
   suite "global values"    test_global_values;
   suite "global variables" test_global_variables;
+  suite "uses"             test_uses;
   suite "users"            test_users;
   suite "aliases"          test_aliases;
   suite "functions"        test_functions;