From 4733be38930ae81716bba9ae75a8281bcb180634 Mon Sep 17 00:00:00 2001 From: Gordon Henriksen Date: Sun, 23 Mar 2008 22:21:29 +0000 Subject: [PATCH] Objective Caml bindings for basic block, function, global, and arg iterators. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@48711 91177308-0d34-0410-b5e6-96231b3b80d8 --- bindings/ocaml/llvm/llvm.ml | 196 +++++++++++++++++++++++++++++++ bindings/ocaml/llvm/llvm.mli | 179 ++++++++++++++++++++++++++++ bindings/ocaml/llvm/llvm_ocaml.c | 78 ++++++++++-- include/llvm-c/Core.h | 12 +- lib/VMCore/Core.cpp | 40 ++++++- test/Bindings/Ocaml/vmcore.ml | 120 ++++++++++++++++++- 6 files changed, 605 insertions(+), 20 deletions(-) diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index ac05a4dc65c..56bfa7bdba1 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -102,6 +102,14 @@ exception IoError of string external register_exns : exn -> unit = "llvm_register_core_exns" let _ = register_exns (IoError "") +type ('a, 'b) llpos = +| At_end of 'a +| Before of 'b + +type ('a, 'b) llrev_pos = +| At_start of 'a +| After of 'b + (*===-- Modules -----------------------------------------------------------===*) @@ -298,6 +306,54 @@ external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer" external remove_initializer : llvalue -> unit = "llvm_remove_initializer" external is_thread_local : llvalue -> bool = "llvm_is_thread_local" external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local" +external global_begin : llmodule -> (llmodule, llvalue) llpos + = "llvm_global_begin" +external global_succ : llvalue -> (llmodule, llvalue) llpos + = "llvm_global_succ" +external global_end : llmodule -> (llmodule, llvalue) llrev_pos + = "llvm_global_end" +external global_pred : llvalue -> (llmodule, llvalue) llrev_pos + = "llvm_global_pred" + +let rec iter_global_range f i e = + if i = e then () else + match i with + | At_end _ -> raise (Invalid_argument "Invalid global variable range.") + | Before bb -> + f bb; + iter_global_range f (global_succ bb) e + +let iter_globals f m = + iter_global_range f (global_begin m) (At_end m) + +let rec fold_left_global_range f init i e = + if i = e then init else + match i with + | At_end _ -> raise (Invalid_argument "Invalid global variable range.") + | Before bb -> fold_left_global_range f (f init bb) (global_succ bb) e + +let fold_left_globals f init m = + fold_left_global_range f init (global_begin m) (At_end m) + +let rec rev_iter_global_range f i e = + if i = e then () else + match i with + | At_start _ -> raise (Invalid_argument "Invalid global variable range.") + | After bb -> + f bb; + rev_iter_global_range f (global_pred bb) e + +let rev_iter_globals f m = + rev_iter_global_range f (global_end m) (At_start m) + +let rec fold_right_global_range f i e init = + if i = e then init else + match i with + | At_start _ -> raise (Invalid_argument "Invalid global variable range.") + | After bb -> fold_right_global_range f (global_pred bb) e (f bb init) + +let fold_right_globals f m init = + fold_right_global_range f (global_end m) (At_start m) init (*--... Operations on functions ............................................--*) external declare_function : string -> lltype -> llmodule -> llvalue @@ -313,6 +369,54 @@ external set_function_call_conv : int -> llvalue -> unit = "llvm_set_function_call_conv" external collector : llvalue -> string option = "llvm_collector" external set_collector : string option -> llvalue -> unit = "llvm_set_collector" +external function_begin : llmodule -> (llmodule, llvalue) llpos + = "llvm_function_begin" +external function_succ : llvalue -> (llmodule, llvalue) llpos + = "llvm_function_succ" +external function_end : llmodule -> (llmodule, llvalue) llrev_pos + = "llvm_function_end" +external function_pred : llvalue -> (llmodule, llvalue) llrev_pos + = "llvm_function_pred" + +let rec iter_function_range f i e = + if i = e then () else + match i with + | At_end _ -> raise (Invalid_argument "Invalid function range.") + | Before fn -> + f fn; + iter_function_range f (function_succ fn) e + +let iter_functions f m = + iter_function_range f (function_begin m) (At_end m) + +let rec fold_left_function_range f init i e = + if i = e then init else + match i with + | At_end _ -> raise (Invalid_argument "Invalid function range.") + | Before fn -> fold_left_function_range f (f init fn) (function_succ fn) e + +let fold_left_functions f init m = + fold_left_function_range f init (function_begin m) (At_end m) + +let rec rev_iter_function_range f i e = + if i = e then () else + match i with + | At_start _ -> raise (Invalid_argument "Invalid function range.") + | After fn -> + f fn; + rev_iter_function_range f (function_pred fn) e + +let rev_iter_functions f m = + rev_iter_function_range f (function_end m) (At_start m) + +let rec fold_right_function_range f i e init = + if i = e then init else + match i with + | At_start _ -> raise (Invalid_argument "Invalid function range.") + | After fn -> fold_right_function_range f (function_pred fn) e (f fn init) + +let fold_right_functions f m init = + fold_right_function_range f (function_end m) (At_start m) init (* TODO: param attrs *) @@ -320,6 +424,50 @@ external set_collector : string option -> llvalue -> unit = "llvm_set_collector" external params : llvalue -> llvalue array = "llvm_params" external param : llvalue -> int -> llvalue = "llvm_param" external param_parent : llvalue -> llvalue = "LLVMGetParamParent" +external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin" +external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ" +external param_end : llvalue -> (llvalue, llvalue) llrev_pos = "llvm_param_end" +external param_pred : llvalue -> (llvalue, llvalue) llrev_pos ="llvm_param_pred" + +let rec iter_param_range f i e = + if i = e then () else + match i with + | At_end _ -> raise (Invalid_argument "Invalid parameter range.") + | Before p -> + f p; + iter_param_range f (param_succ p) e + +let iter_params f fn = + iter_param_range f (param_begin fn) (At_end fn) + +let rec fold_left_param_range f init i e = + if i = e then init else + match i with + | At_end _ -> raise (Invalid_argument "Invalid parameter range.") + | Before p -> fold_left_param_range f (f init p) (param_succ p) e + +let fold_left_params f init fn = + fold_left_param_range f init (param_begin fn) (At_end fn) + +let rec rev_iter_param_range f i e = + if i = e then () else + match i with + | At_start _ -> raise (Invalid_argument "Invalid parameter range.") + | After p -> + f p; + rev_iter_param_range f (param_pred p) e + +let rev_iter_params f fn = + rev_iter_param_range f (param_end fn) (At_start fn) + +let rec fold_right_param_range f init i e = + if i = e then init else + match i with + | At_start _ -> raise (Invalid_argument "Invalid parameter range.") + | After p -> fold_right_param_range f (f p init) (param_pred p) e + +let fold_right_params f fn init = + fold_right_param_range f init (param_end fn) (At_start fn) (*--... Operations on basic blocks .........................................--*) external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" @@ -332,6 +480,54 @@ external delete_block : llbasicblock -> unit = "llvm_delete_block" external append_block : string -> llvalue -> llbasicblock = "llvm_append_block" external insert_block : string -> llbasicblock -> llbasicblock = "llvm_insert_block" +external block_begin : llvalue -> (llvalue, llbasicblock) llpos + = "llvm_block_begin" +external block_succ : llbasicblock -> (llvalue, llbasicblock) llpos + = "llvm_block_succ" +external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos + = "llvm_block_end" +external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos + = "llvm_block_pred" + +let rec iter_block_range f i e = + if i = e then () else + match i with + | At_end _ -> raise (Invalid_argument "Invalid block range.") + | Before bb -> + f bb; + iter_block_range f (block_succ bb) e + +let iter_blocks f fn = + iter_block_range f (block_begin fn) (At_end fn) + +let rec fold_left_block_range f init i e = + if i = e then init else + match i with + | At_end _ -> raise (Invalid_argument "Invalid block range.") + | Before bb -> fold_left_block_range f (f init bb) (block_succ bb) e + +let fold_left_blocks f init fn = + fold_left_block_range f init (block_begin fn) (At_end fn) + +let rec rev_iter_block_range f i e = + if i = e then () else + match i with + | At_start _ -> raise (Invalid_argument "Invalid block range.") + | After bb -> + f bb; + rev_iter_block_range f (block_pred bb) e + +let rev_iter_blocks f fn = + rev_iter_block_range f (block_end fn) (At_start fn) + +let rec fold_right_block_range f init i e = + if i = e then init else + match i with + | At_start _ -> raise (Invalid_argument "Invalid block range.") + | After bb -> fold_right_block_range f (f bb init) (block_pred bb) e + +let fold_right_blocks f fn init = + fold_right_block_range f init (block_end fn) (At_start fn) (*--... Operations on instructions .........................................--*) external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 5996ecd1b94..398e83f618a 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -149,6 +149,23 @@ module Fcmp : sig end +(** {6 Iteration} *) + +(** [Before b] and [At_end a] specify positions from the start of the ['b] list + of [a]. [llpos] is used to specify positions in and for reverse iteration + through the various value lists maintained by the LLVM IR. *) +type ('a, 'b) llpos = +| At_end of 'a +| Before of 'b + +(** [After b] and [At_start a] specify positions from the end of the ['b] list + of [a]. [llrev_pos] is used for reverse iteration through the various value + lists maintained by the LLVM IR. *) +type ('a, 'b) llrev_pos = +| At_start of 'a +| After of 'b + + (** {6 Exceptions} *) exception IoError of string @@ -745,6 +762,48 @@ external lookup_global : string -> llmodule -> llvalue option See the method [llvm::GlobalVariable::eraseFromParent]. *) external delete_global : llvalue -> unit = "llvm_delete_global" +(** [global_begin m] returns the first position in the global variable list of + the module [m]. [global_begin] and [global_succ] can be used to iterate + over the global list in order. + See the method [llvm::Module::global_begin]. *) +external global_begin : llmodule -> (llmodule, llvalue) llpos + = "llvm_global_begin" + +(** [global_succ gv] returns the global variable list position succeeding + [Before gv]. + See the method [llvm::Module::global_iterator::operator++]. *) +external global_succ : llvalue -> (llmodule, llvalue) llpos + = "llvm_global_succ" + +(** [iter_globals f m] applies function [f] to each of the global variables of + module [m] in order. Tail recursive. *) +val iter_globals : (llvalue -> unit) -> llmodule -> unit + +(** [fold_left_globals f init m] is [f (... (f init g1) ...) gN] where + [g1,...,gN] are the global variables of module [m]. Tail recursive. *) +val fold_left_globals : ('a -> llvalue -> 'a) -> 'a -> llmodule -> 'a + +(** [global_end m] returns the last position in the global variable list of the + module [m]. [global_end] and [global_pred] can be used to iterate over the + global list in reverse. + See the method [llvm::Module::global_end]. *) +external global_end : llmodule -> (llmodule, llvalue) llrev_pos + = "llvm_global_end" + +(** [global_pred gv] returns the global variable list position preceding + [After gv]. + See the method [llvm::Module::global_iterator::operator--]. *) +external global_pred : llvalue -> (llmodule, llvalue) llrev_pos + = "llvm_global_pred" + +(** [rev_iter_globals f m] applies function [f] to each of the global variables + of module [m] in reverse order. Tail recursive. *) +val rev_iter_globals : (llvalue -> unit) -> llmodule -> unit + +(** [fold_right_globals f m init] is [f g1 (... (f gN init) ...)] where + [g1,...,gN] are the global variables of module [m]. Tail recursive. *) +val fold_right_globals : (llvalue -> 'a -> 'a) -> llmodule -> 'a -> 'a + (** [is_global_constant gv] returns [true] if the global variabile [gv] is a constant. Returns [false] otherwise. See the method [llvm::GlobalVariable::isConstant]. *) @@ -812,6 +871,47 @@ external lookup_function : string -> llmodule -> llvalue option See the method [llvm::Function::eraseFromParent]. *) external delete_function : llvalue -> unit = "llvm_delete_function" +(** [function_begin m] returns the first position in the function list of the + module [m]. [function_begin] and [function_succ] can be used to iterate over + the function list in order. + See the method [llvm::Module::begin]. *) +external function_begin : llmodule -> (llmodule, llvalue) llpos + = "llvm_function_begin" + +(** [function_succ gv] returns the function list position succeeding + [Before gv]. + See the method [llvm::Module::iterator::operator++]. *) +external function_succ : llvalue -> (llmodule, llvalue) llpos + = "llvm_function_succ" + +(** [iter_functions f m] applies function [f] to each of the functions of module + [m] in order. Tail recursive. *) +val iter_functions : (llvalue -> unit) -> llmodule -> unit + +(** [fold_left_function f init m] is [f (... (f init f1) ...) fN] where + [f1,...,fN] are the functions of module [m]. Tail recursive. *) +val fold_left_functions : ('a -> llvalue -> 'a) -> 'a -> llmodule -> 'a + +(** [function_end m] returns the last position in the function list of + the module [m]. [function_end] and [function_pred] can be used to iterate + over the function list in reverse. + See the method [llvm::Module::end]. *) +external function_end : llmodule -> (llmodule, llvalue) llrev_pos + = "llvm_function_end" + +(** [function_pred gv] returns the function list position preceding [After gv]. + See the method [llvm::Module::iterator::operator--]. *) +external function_pred : llvalue -> (llmodule, llvalue) llrev_pos + = "llvm_function_pred" + +(** [rev_iter_functions f fn] applies function [f] to each of the functions of + module [m] in reverse order. Tail recursive. *) +val rev_iter_functions : (llvalue -> unit) -> llmodule -> unit + +(** [fold_right_functions f m init] is [f (... (f init fN) ...) f1] where + [f1,...,fN] are the functions of module [m]. Tail recursive. *) +val fold_right_functions : (llvalue -> 'a -> 'a) -> llmodule -> 'a -> 'a + (** [is_intrinsic f] returns true if the function [f] is an intrinsic. See the method [llvm::Function::isIntrinsic]. *) external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic" @@ -850,6 +950,44 @@ external param : llvalue -> int -> llvalue = "llvm_param" See the method [llvm::Argument::getParent]. *) external param_parent : llvalue -> llvalue = "LLVMGetParamParent" +(** [param_begin f] returns the first position in the parameter list of the + function [f]. [param_begin] and [param_succ] can be used to iterate over + the parameter list in order. + See the method [llvm::Function::arg_begin]. *) +external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin" + +(** [param_succ bb] returns the parameter list position succeeding + [Before bb]. + See the method [llvm::Function::arg_iterator::operator++]. *) +external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ" + +(** [iter_params f fn] applies function [f] to each of the parameters + of function [fn] in order. Tail recursive. *) +val iter_params : (llvalue -> unit) -> llvalue -> unit + +(** [fold_left_params f init fn] is [f (... (f init b1) ...) bN] where + [b1,...,bN] are the parameters of function [fn]. Tail recursive. *) +val fold_left_params : ('a -> llvalue -> 'a) -> 'a -> llvalue -> 'a + +(** [param_end f] returns the last position in the parameter list of + the function [f]. [param_end] and [param_pred] can be used to iterate + over the parameter list in reverse. + See the method [llvm::Function::arg_end]. *) +external param_end : llvalue -> (llvalue, llvalue) llrev_pos = "llvm_param_end" + +(** [param_pred gv] returns the function list position preceding [After gv]. + See the method [llvm::Function::arg_iterator::operator--]. *) +external param_pred : llvalue -> (llvalue, llvalue) llrev_pos + = "llvm_param_pred" + +(** [rev_iter_params f fn] applies function [f] to each of the parameters + of function [fn] in reverse order. Tail recursive. *) +val rev_iter_params : (llvalue -> unit) -> llvalue -> unit + +(** [fold_right_params f fn init] is [f (... (f init bN) ...) b1] where + [b1,...,bN] are the parameters of function [fn]. Tail recursive. *) +val fold_right_params : (llvalue -> 'a -> 'a) -> llvalue -> 'a -> 'a + (** {7 Operations on basic blocks} *) @@ -880,6 +1018,47 @@ external insert_block : string -> llbasicblock -> llbasicblock See the method [llvm::BasicBlock::getParent]. *) external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent" +(** [block_begin f] returns the first position in the basic block list of the + function [f]. [block_begin] and [block_succ] can be used to iterate over + the basic block list in order. + See the method [llvm::Function::begin]. *) +external block_begin : llvalue -> (llvalue, llbasicblock) llpos + = "llvm_block_begin" + +(** [block_succ bb] returns the basic block list position succeeding + [Before bb]. + See the method [llvm::Function::iterator::operator++]. *) +external block_succ : llbasicblock -> (llvalue, llbasicblock) llpos + = "llvm_block_succ" + +(** [iter_blocks f fn] applies function [f] to each of the basic blocks + of function [fn] in order. Tail recursive. *) +val iter_blocks : (llbasicblock -> unit) -> llvalue -> unit + +(** [fold_left_blocks f init fn] is [f (... (f init b1) ...) bN] where + [b1,...,bN] are the basic blocks of function [fn]. Tail recursive. *) +val fold_left_blocks : ('a -> llbasicblock -> 'a) -> 'a -> llvalue -> 'a + +(** [block_end f] returns the last position in the basic block list of + the function [f]. [block_end] and [block_pred] can be used to iterate + over the basic block list in reverse. + See the method [llvm::Function::end]. *) +external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos + = "llvm_block_end" + +(** [block_pred gv] returns the function list position preceding [After gv]. + See the method [llvm::Function::iterator::operator--]. *) +external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos + = "llvm_block_pred" + +(** [rev_iter_blocks f fn] applies function [f] to each of the basic blocks + of function [fn] in reverse order. Tail recursive. *) +val rev_iter_blocks : (llbasicblock -> unit) -> llvalue -> unit + +(** [fold_right_blocks f fn init] is [f (... (f init bN) ...) b1] where + [b1,...,bN] are the basic blocks of function [fn]. Tail recursive. *) +val fold_right_blocks : (llbasicblock -> 'a -> 'a) -> llvalue -> 'a -> 'a + (** [value_of_block bb] losslessly casts [bb] to an [llvalue]. *) external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index c966091ccbb..9943af760b0 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -50,6 +50,47 @@ static void llvm_raise(value Prototype, char *Message) { #endif } +static value alloc_variant(int tag, void *Value) { + value Iter = alloc_small(1, tag); + Field(Iter, 0) = Val_op(Value); + return Iter; +} + +/* Macro to convert the C first/next/last/prev idiom to the Ocaml llpos/ + llrev_pos idiom. */ +#define DEFINE_ITERATORS(camlname, cname, pty, cty, pfun) \ + /* llmodule -> ('a, 'b) llpos */ \ + CAMLprim value llvm_##camlname##_begin(pty Mom) { \ + cty First = LLVMGetFirst##cname(Mom); \ + if (First) \ + return alloc_variant(1, First); \ + return alloc_variant(0, Mom); \ + } \ + \ + /* llvalue -> ('a, 'b) llpos */ \ + CAMLprim value llvm_##camlname##_succ(cty Kid) { \ + cty Next = LLVMGetNext##cname(Kid); \ + if (Next) \ + return alloc_variant(1, Next); \ + return alloc_variant(0, pfun(Kid)) ; \ + } \ + \ + /* llmodule -> ('a, 'b) llrev_pos */ \ + CAMLprim value llvm_##camlname##_end(pty Mom) { \ + cty Last = LLVMGetLast##cname(Mom); \ + if (Last) \ + return alloc_variant(1, Last); \ + return alloc_variant(0, Mom); \ + } \ + \ + /* llvalue -> ('a, 'b) llrev_pos */ \ + CAMLprim value llvm_##camlname##_pred(cty Kid) { \ + cty Prev = LLVMGetPrevious##cname(Kid); \ + if (Prev) \ + return alloc_variant(1, Prev); \ + return alloc_variant(0, pfun(Kid)); \ + } + /*===-- Modules -----------------------------------------------------------===*/ @@ -464,6 +505,9 @@ CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) { /*--... Operations on global variables .....................................--*/ +DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef, + LLVMGetGlobalParent) + /* lltype -> string -> llmodule -> llvalue */ CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name, LLVMModuleRef M) { @@ -541,6 +585,9 @@ CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) { /*--... Operations on functions ............................................--*/ +DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef, + LLVMGetGlobalParent) + /* string -> lltype -> llmodule -> llvalue */ CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty, LLVMModuleRef M) { @@ -579,18 +626,6 @@ CAMLprim value llvm_delete_function(LLVMValueRef Fn) { return Val_unit; } -/* llvalue -> int -> llvalue */ -CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) { - return LLVMGetParam(Fn, Int_val(Index)); -} - -/* llvalue -> int -> llvalue */ -CAMLprim value llvm_params(LLVMValueRef Fn, value Index) { - value Params = alloc(LLVMCountParams(Fn), 0); - LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params)); - return Params; -} - /* llvalue -> bool */ CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) { return Val_bool(LLVMGetIntrinsicID(Fn)); @@ -630,8 +665,27 @@ CAMLprim value llvm_set_collector(value GC, LLVMValueRef Fn) { return Val_unit; } +/*--... Operations on parameters ...........................................--*/ + +DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent) + +/* llvalue -> int -> llvalue */ +CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) { + return LLVMGetParam(Fn, Int_val(Index)); +} + +/* llvalue -> int -> llvalue */ +CAMLprim value llvm_params(LLVMValueRef Fn, value Index) { + value Params = alloc(LLVMCountParams(Fn), 0); + LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params)); + return Params; +} + /*--... Operations on basic blocks .........................................--*/ +DEFINE_ITERATORS( + block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent) + /* llvalue -> llbasicblock array */ CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) { value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0); diff --git a/include/llvm-c/Core.h b/include/llvm-c/Core.h index eb4bc207e8e..ef1e2f6ce2f 100644 --- a/include/llvm-c/Core.h +++ b/include/llvm-c/Core.h @@ -376,6 +376,10 @@ void LLVMSetAlignment(LLVMValueRef Global, unsigned Bytes); /* Operations on global variables */ LLVMValueRef LLVMAddGlobal(LLVMModuleRef M, LLVMTypeRef Ty, const char *Name); LLVMValueRef LLVMGetNamedGlobal(LLVMModuleRef M, const char *Name); +LLVMValueRef LLVMGetFirstGlobal(LLVMModuleRef M); +LLVMValueRef LLVMGetLastGlobal(LLVMModuleRef M); +LLVMValueRef LLVMGetNextGlobal(LLVMValueRef GlobalVar); +LLVMValueRef LLVMGetPreviousGlobal(LLVMValueRef GlobalVar); void LLVMDeleteGlobal(LLVMValueRef GlobalVar); int LLVMHasInitializer(LLVMValueRef GlobalVar); LLVMValueRef LLVMGetInitializer(LLVMValueRef GlobalVar); @@ -405,12 +409,16 @@ unsigned LLVMCountParams(LLVMValueRef Fn); void LLVMGetParams(LLVMValueRef Fn, LLVMValueRef *Params); LLVMValueRef LLVMGetParam(LLVMValueRef Fn, unsigned Index); LLVMValueRef LLVMGetParamParent(LLVMValueRef Inst); +LLVMValueRef LLVMGetFirstParam(LLVMValueRef Fn); +LLVMValueRef LLVMGetLastParam(LLVMValueRef Fn); +LLVMValueRef LLVMGetNextParam(LLVMValueRef Arg); +LLVMValueRef LLVMGetPreviousParam(LLVMValueRef Arg); /* Operations on basic blocks */ -LLVMValueRef LLVMBasicBlockAsValue(LLVMBasicBlockRef Bb); +LLVMValueRef LLVMBasicBlockAsValue(LLVMBasicBlockRef BB); int LLVMValueIsBasicBlock(LLVMValueRef Val); LLVMBasicBlockRef LLVMValueAsBasicBlock(LLVMValueRef Val); -LLVMValueRef LLVMGetBasicBlockParent(LLVMValueRef V); +LLVMValueRef LLVMGetBasicBlockParent(LLVMBasicBlockRef BB); unsigned LLVMCountBasicBlocks(LLVMValueRef Fn); void LLVMGetBasicBlocks(LLVMValueRef Fn, LLVMBasicBlockRef *BasicBlocks); LLVMBasicBlockRef LLVMGetFirstBasicBlock(LLVMValueRef Fn); diff --git a/lib/VMCore/Core.cpp b/lib/VMCore/Core.cpp index ac7738bf859..59b9b1ab69a 100644 --- a/lib/VMCore/Core.cpp +++ b/lib/VMCore/Core.cpp @@ -628,7 +628,7 @@ LLVMValueRef LLVMGetNextGlobal(LLVMValueRef GlobalVar) { LLVMValueRef LLVMGetPreviousGlobal(LLVMValueRef GlobalVar) { GlobalVariable *GV = unwrap(GlobalVar); Module::global_iterator I = GV; - if (I == GV->getParent()->global_end()) + if (I == GV->getParent()->global_begin()) return 0; return wrap(--I); } @@ -705,7 +705,7 @@ LLVMValueRef LLVMGetNextFunction(LLVMValueRef Fn) { LLVMValueRef LLVMGetPreviousFunction(LLVMValueRef Fn) { Function *Func = unwrap(Fn); Module::iterator I = Func; - if (I == Func->getParent()->end()) + if (I == Func->getParent()->begin()) return 0; return wrap(--I); } @@ -767,6 +767,38 @@ LLVMValueRef LLVMGetParamParent(LLVMValueRef V) { return wrap(unwrap(V)->getParent()); } +LLVMValueRef LLVMGetFirstParam(LLVMValueRef Fn) { + Function *Func = unwrap(Fn); + Function::arg_iterator I = Func->arg_begin(); + if (I == Func->arg_end()) + return 0; + return wrap(I); +} + +LLVMValueRef LLVMGetLastParam(LLVMValueRef Fn) { + Function *Func = unwrap(Fn); + Function::arg_iterator I = Func->arg_end(); + if (I == Func->arg_begin()) + return 0; + return wrap(--I); +} + +LLVMValueRef LLVMGetNextParam(LLVMValueRef Arg) { + Argument *A = unwrap(Arg); + Function::arg_iterator I = A; + if (++I == A->getParent()->arg_end()) + return 0; + return wrap(I); +} + +LLVMValueRef LLVMGetPreviousParam(LLVMValueRef Arg) { + Argument *A = unwrap(Arg); + Function::arg_iterator I = A; + if (I == A->getParent()->arg_begin()) + return 0; + return wrap(--I); +} + /*--.. Operations on basic blocks ..........................................--*/ LLVMValueRef LLVMBasicBlockAsValue(LLVMBasicBlockRef BB) { @@ -781,8 +813,8 @@ LLVMBasicBlockRef LLVMValueAsBasicBlock(LLVMValueRef Val) { return wrap(unwrap(Val)); } -LLVMValueRef LLVMGetBasicBlockParent(LLVMValueRef V) { - return wrap(unwrap(V)->getParent()); +LLVMValueRef LLVMGetBasicBlockParent(LLVMBasicBlockRef BB) { + return wrap(unwrap(BB)->getParent()); } unsigned LLVMCountBasicBlocks(LLVMValueRef FnRef) { diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index 73b5b286bef..3ff8cb9faaf 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -467,7 +467,33 @@ let test_global_variables () = let g = define_global "ConstGlobalVar" fourty_two32 m in insist (not (is_global_constant g)); set_global_constant true g; - insist (is_global_constant g) + insist (is_global_constant g); + + begin group "iteration"; + let m = create_module "temp" in + + insist (At_end m = global_begin m); + insist (At_start m = global_end m); + + let g1 = declare_global i32_type "One" m in + let g2 = declare_global i32_type "Two" m in + + insist (Before g1 = global_begin m); + insist (Before g2 = global_succ g1); + insist (At_end m = global_succ g2); + + insist (After g2 = global_end m); + insist (After g1 = global_pred g2); + insist (At_start m = global_pred g1); + + let lf s x = s ^ "->" ^ value_name x in + insist ("->One->Two" = fold_left_globals lf "" m); + + let rf x s = value_name x ^ "<-" ^ s in + insist ("One<-Two<-" = fold_right_globals rf m ""); + + dispose_module m + end (*===-- Functions ---------------------------------------------------------===*) @@ -540,6 +566,68 @@ let test_functions () = insist (None = collector fn); set_collector (Some "shadowstack") fn; ignore (build_unreachable (builder_at_end (entry_block fn))); + end; + + begin group "iteration"; + let m = create_module "temp" in + + insist (At_end m = function_begin m); + insist (At_start m = function_end m); + + let f1 = define_function "One" ty m in + let f2 = define_function "Two" ty m in + + insist (Before f1 = function_begin m); + insist (Before f2 = function_succ f1); + insist (At_end m = function_succ f2); + + insist (After f2 = function_end m); + insist (After f1 = function_pred f2); + insist (At_start m = function_pred f1); + + let lf s x = s ^ "->" ^ value_name x in + insist ("->One->Two" = fold_left_functions lf "" m); + + let rf x s = value_name x ^ "<-" ^ s in + insist ("One<-Two<-" = fold_right_functions rf m ""); + + dispose_module m + end + + +(*===-- Params ------------------------------------------------------------===*) + +let test_params () = + begin group "iteration"; + let m = create_module "temp" in + + let vf = define_function "void" (function_type void_type [| |]) m in + + insist (At_end vf = param_begin vf); + insist (At_start vf = param_end vf); + + let ty = function_type void_type [| i32_type; i32_type |] in + let f = define_function "f" ty m in + let p1 = param f 0 in + let p2 = param f 1 in + set_value_name "One" p1; + set_value_name "Two" p2; + + insist (Before p1 = param_begin f); + insist (Before p2 = param_succ p1); + insist (At_end f = param_succ p2); + + insist (After p2 = param_end f); + insist (After p1 = param_pred p2); + insist (At_start f = param_pred p1); + + let lf s x = s ^ "->" ^ value_name x in + insist ("->One->Two" = fold_left_params lf "" f); + + let rf x s = value_name x ^ "<-" ^ s in + insist ("One<-Two<-" = fold_right_params rf f ""); + + dispose_module m end @@ -587,7 +675,34 @@ let test_basic_blocks () = ignore (build_unreachable (builder_at_end bb)); insist (bb = block_of_value (value_of_block bb)); insist (value_is_block (value_of_block bb)); - insist (not (value_is_block (const_null i32_type))) + insist (not (value_is_block (const_null i32_type))); + + begin group "iteration"; + let m = create_module "temp" in + let f = declare_function "Temp" (function_type i32_type [| |]) m in + + insist (At_end f = block_begin f); + insist (At_start f = block_end f); + + let b1 = append_block "One" f in + let b2 = append_block "Two" f in + + insist (Before b1 = block_begin f); + insist (Before b2 = block_succ b1); + insist (At_end f = block_succ b2); + + insist (After b2 = block_end f); + insist (After b1 = block_pred b2); + insist (At_start f = block_pred b1); + + let lf s x = s ^ "->" ^ value_name (value_of_block x) in + insist ("->One->Two" = fold_left_blocks lf "" f); + + let rf x s = value_name (value_of_block x) ^ "<-" ^ s in + insist ("One<-Two<-" = fold_right_blocks rf f ""); + + dispose_module m + end (*===-- Builder -----------------------------------------------------------===*) @@ -907,6 +1022,7 @@ let _ = suite "global values" test_global_values; suite "global variables" test_global_variables; suite "functions" test_functions; + suite "params" test_params; suite "basic blocks" test_basic_blocks; suite "builder" test_builder; suite "module provider" test_module_provider; -- 2.34.1