Add support for use to ocaml.

[oota-llvm.git] / bindings / ocaml / llvm / llvm.ml

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 92bfef51d0318d6b15aa7a426aef81ab4a0cf98e..7b906d26843e7695488f3543d972d0715211eea6 100644 (file)
--- 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,41 @@ 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"
+
 (*--... Operations on constants of (mostly) any type .......................--*)
 external is_constant : llvalue -> bool = "llvm_is_constant"
 external const_null : lltype -> llvalue = "LLVMConstNull"
@@ -444,6 +480,10 @@ let rec fold_right_global_range f i e init =
 let fold_right_globals f m init =
   fold_right_global_range f (global_end m) (At_start m) init
 
+(*--... Operations on aliases ..............................................--*)
+external add_alias : llmodule -> lltype -> llvalue -> string -> llvalue
+                   = "llvm_add_alias"
+
 (*--... Operations on functions ............................................--*)
 external declare_function : string -> lltype -> llmodule -> llvalue
                           = "llvm_declare_function"