[llvm-commits] [llvm] r97586 - in /llvm/trunk: bindings/ocaml/llvm/llvm.ml bindings/ocaml/llvm/llvm.mli bindings/ocaml/llvm/llvm_ocaml.c test/Bindings/Ocaml/vmcore.ml
Erick Tryzelaar
idadesub at users.sourceforge.net
Tue Mar 2 12:32:32 PST 2010
Author: erickt
Date: Tue Mar 2 14:32:32 2010
New Revision: 97586
URL: http://llvm.org/viewvc/llvm-project?rev=97586&view=rev
Log:
Add support for use to ocaml.
Modified:
llvm/trunk/bindings/ocaml/llvm/llvm.ml
llvm/trunk/bindings/ocaml/llvm/llvm.mli
llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
llvm/trunk/test/Bindings/Ocaml/vmcore.ml
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.ml?rev=97586&r1=97585&r2=97586&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.ml (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.ml Tue Mar 2 14:32:32 2010
@@ -13,6 +13,7 @@
type lltype
type lltypehandle
type llvalue
+type lluse
type llbasicblock
type llbuilder
type llmoduleprovider
@@ -242,6 +243,38 @@
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"
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.mli?rev=97586&r1=97585&r2=97586&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.mli (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.mli Tue Mar 2 14:32:32 2010
@@ -39,6 +39,9 @@
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 @@
= "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
Modified: llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c?rev=97586&r1=97585&r2=97586&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c Tue Mar 2 14:32:32 2010
@@ -707,6 +707,42 @@
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,
Modified: llvm/trunk/test/Bindings/Ocaml/vmcore.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/test/Bindings/Ocaml/vmcore.ml?rev=97586&r1=97585&r2=97586&view=diff
==============================================================================
--- llvm/trunk/test/Bindings/Ocaml/vmcore.ml (original)
+++ llvm/trunk/test/Bindings/Ocaml/vmcore.ml Tue Mar 2 14:32:32 2010
@@ -607,6 +607,33 @@
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 @@
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;
More information about the llvm-commits
mailing list