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 a8ecb3d8cf753f37b773b66e4cc937b74af652d6..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
@@ -165,6 +166,8 @@ external define_type_name : string -> lltype -> llmodule -> bool
                           = "llvm_add_type_name"
 external delete_type_name : string -> llmodule -> unit
                           = "llvm_delete_type_name"
+external type_by_name : llmodule -> string -> lltype option
+                      = "llvm_type_by_name"
 external dump_module : llmodule -> unit = "llvm_dump_module"
 
 (*===-- Types -------------------------------------------------------------===*)
@@ -240,10 +243,46 @@ 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"
 external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes"
+external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull"
 external undef : lltype -> llvalue = "LLVMGetUndef"
 external is_null : llvalue -> bool = "llvm_is_null"
 external is_undef : llvalue -> bool = "llvm_is_undef"
@@ -353,6 +392,9 @@ external const_extractvalue : llvalue -> int array -> llvalue
                             = "llvm_const_extractvalue"
 external const_insertvalue : llvalue -> llvalue -> int array -> llvalue
                            = "llvm_const_insertvalue"
+external const_inline_asm : lltype -> string -> string -> bool -> bool ->
+                            llvalue
+                          = "llvm_const_inline_asm"
 external block_address : llvalue -> llbasicblock -> llvalue = "LLVMBlockAddress"
 
 (*--... Operations on global variables, functions, and aliases (globals) ...--*)
@@ -438,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"