X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=blobdiff_plain;f=bindings%2Focaml%2Fllvm%2Fllvm.mli;h=8be5c654e78c39ec68057e0528317524421edf4c;hp=2d0b9f070107ba68685f0c81a1542cc7cabfdef8;hb=92e73d7628436ef76b0e9bb7f8224f02128e9906;hpb=d78c0f5a7255e4347cbd82f7435c51401096652c diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 2d0b9f07010..8be5c654e78 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 forward 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 @@ -676,6 +693,10 @@ external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue (** {7 Operations on global variables, functions, and aliases (globals)} *) +(** [global_parent g] is the enclosing module of the global value [g]. + See the method [llvm::GlobalValue::getParent]. *) +external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent" + (** [is_declaration g] returns [true] if the global value [g] is a declaration only. Returns [false] otherwise. See the method [llvm::GlobalValue::isDeclaration]. *) @@ -741,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]. *) @@ -808,13 +871,46 @@ external lookup_function : string -> llmodule -> llvalue option See the method [llvm::Function::eraseFromParent]. *) external delete_function : llvalue -> unit = "llvm_delete_function" -(** [params f] returns the parameters of function [f]. - See the method [llvm::Function::getArgumentList]. *) -external params : llvalue -> llvalue array = "llvm_params" - -(** [param f n] returns the [n]th parameter of function [f]. - See the method [llvm::Function::getArgumentList]. *) -external param : llvalue -> int -> llvalue = "llvm_param" +(** [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]. *) @@ -840,6 +936,59 @@ external collector : llvalue -> string option = "llvm_collector" external set_collector : string option -> llvalue -> unit = "llvm_set_collector" +(** {7 Operations on params} *) + +(** [params f] returns the parameters of function [f]. + See the method [llvm::Function::getArgumentList]. *) +external params : llvalue -> llvalue array = "llvm_params" + +(** [param f n] returns the [n]th parameter of function [f]. + See the method [llvm::Function::getArgumentList]. *) +external param : llvalue -> int -> llvalue = "llvm_param" + +(** [param_parent p] returns the parent function that owns the parameter. + 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} *) (** [basic_blocks fn] returns the basic blocks of the function [f]. @@ -865,6 +1014,51 @@ external append_block : string -> llvalue -> llbasicblock = "llvm_append_block" external insert_block : string -> llbasicblock -> llbasicblock = "llvm_insert_block" +(** [block_parent bb] returns the parent function that owns the basic block. + 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" @@ -877,6 +1071,13 @@ external value_is_block : llvalue -> bool = "llvm_value_is_block" external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" +(** {7 Operations on instructions} *) + +(** [instr_parent i] is the enclosing basic block of the instruction [i]. + See the method [llvm::Instruction::getParent]. *) +external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" + + (** {7 Operations on call sites} *) (** [instruction_call_conv ci] is the calling convention for the call or invoke @@ -886,9 +1087,10 @@ external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" external instruction_call_conv: llvalue -> int = "llvm_instruction_call_conv" -(** [set_inst_call_conv cc ci] sets the calling convention for the call or - invoke instruction [ci] to the integer [cc], which can be one of the values - from the module {!CallConv}. See the method [llvm::CallInst::setCallingConv] +(** [set_instruction_call_conv cc ci] sets the calling convention for the call + or invoke instruction [ci] to the integer [cc], which can be one of the + values from the module {!CallConv}. + See the method [llvm::CallInst::setCallingConv] and [llvm::InvokeInst::setCallingConv]. *) external set_instruction_call_conv: int -> llvalue -> unit = "llvm_set_instruction_call_conv" @@ -909,8 +1111,8 @@ external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" (** {6 Instruction builders} *) -(** [builder] creates an instruction builder with no position. It is invalid to - use this builder until its position is set with {!position_before} or +(** [builder ()] creates an instruction builder with no position. It is invalid + to use this builder until its position is set with {!position_before} or {!position_at_end}. See the constructor for [llvm::LLVMBuilder]. *) external builder: unit-> llbuilder = "llvm_builder" @@ -932,6 +1134,12 @@ external position_before : llvalue -> llbuilder -> unit = "llvm_position_before" external position_at_end : llbasicblock -> llbuilder -> unit = "llvm_position_at_end" +(** [insertion_block b] returns the basic block that the builder [b] is + positioned to insert into. Raises [Not_Found] if the instruction builder is + uninitialized. + See the method [llvm::LLVMBuilder::GetInsertBlock]. *) +external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block" + (** {7 Terminators} *)