diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index 56bfa7bdba1..85acc5e5787 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -531,6 +531,55 @@ let fold_right_blocks f fn init = (*--... Operations on instructions .........................................--*) external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" +external instr_begin : llbasicblock -> (llbasicblock, llvalue) llpos + = "llvm_instr_begin" +external instr_succ : llvalue -> (llbasicblock, llvalue) llpos + = "llvm_instr_succ" +external instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos + = "llvm_instr_end" +external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos + = "llvm_instr_pred" + +let rec iter_instrs_range f i e = + if i = e then () else + match i with + | At_end _ -> raise (Invalid_argument "Invalid instruction range.") + | Before i -> + f i; + iter_instrs_range f (instr_succ i) e + +let iter_instrs f bb = + iter_instrs_range f (instr_begin bb) (At_end bb) + +let rec fold_left_instrs_range f init i e = + if i = e then init else + match i with + | At_end _ -> raise (Invalid_argument "Invalid instruction range.") + | Before i -> fold_left_instrs_range f (f init i) (instr_succ i) e + +let fold_left_instrs f init bb = + fold_left_instrs_range f init (instr_begin bb) (At_end bb) + +let rec rev_iter_instrs_range f i e = + if i = e then () else + match i with + | At_start _ -> raise (Invalid_argument "Invalid instruction range.") + | After i -> + f i; + rev_iter_instrs_range f (instr_pred i) e + +let rev_iter_instrs f bb = + rev_iter_instrs_range f (instr_end bb) (At_start bb) + +let rec fold_right_instr_range f i e init = + if i = e then init else + match i with + | At_start _ -> raise (Invalid_argument "Invalid instruction range.") + | After i -> fold_right_instr_range f (instr_pred i) e (f i init) + +let fold_right_instrs f bb init = + fold_right_instr_range f (instr_end bb) (At_start bb) init + (*--... Operations on call sites ...........................................--*) external instruction_call_conv: llvalue -> int @@ -545,14 +594,23 @@ external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" (*===-- Instruction builders ----------------------------------------------===*) -external builder: unit-> llbuilder = "llvm_builder" -external builder_before : llvalue -> llbuilder = "llvm_builder_before" -external builder_at_end : llbasicblock -> llbuilder = "llvm_builder_at_end" -external position_before : llvalue -> llbuilder -> unit = "llvm_position_before" -external position_at_end : llbasicblock -> llbuilder -> unit - = "llvm_position_at_end" +external builder : unit -> llbuilder = "llvm_builder" +external position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit + = "llvm_position_builder" external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block" +let builder_at ip = + let b = builder () in + position_builder ip b; + b + +let builder_before i = builder_at (Before i) +let builder_at_end bb = builder_at (At_end bb) + +let position_before i = position_builder (Before i) +let position_at_end bb = position_builder (At_end bb) + + (*--... Terminators ........................................................--*) external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void" external build_ret : llvalue -> llbuilder -> llvalue = "llvm_build_ret" diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli index 8be5c654e78..5aedefb9257 100644 --- a/bindings/ocaml/llvm/llvm.mli +++ b/bindings/ocaml/llvm/llvm.mli @@ -1077,6 +1077,42 @@ external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" See the method [llvm::Instruction::getParent]. *) external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" +(** [instr_begin bb] returns the first position in the instruction list of the + basic block [bb]. [instr_begin] and [instr_succ] can be used to iterate over + the instruction list in order. + See the method [llvm::BasicBlock::begin]. *) +external instr_begin : llbasicblock -> (llbasicblock, llvalue) llpos + = "llvm_instr_begin" + +(** [instr_succ i] returns the instruction list position succeeding [Before i]. + See the method [llvm::BasicBlock::iterator::operator++]. *) +external instr_succ : llvalue -> (llbasicblock, llvalue) llpos + = "llvm_instr_succ" + +(** [iter_instrs f bb] applies function [f] to each of the instructions of basic + block [bb] in order. Tail recursive. *) +val iter_instrs: (llvalue -> unit) -> llbasicblock -> unit + +(** [fold_left_instrs f init bb] is [f (... (f init g1) ...) gN] where + [g1,...,gN] are the instructions of basic block [bb]. Tail recursive. *) +val fold_left_instrs: ('a -> llvalue -> 'a) -> 'a -> llbasicblock -> 'a + +(** [instr_end bb] returns the last position in the instruction list of the + basic block [bb]. [instr_end] and [instr_pred] can be used to iterate over + the instruction list in reverse. + See the method [llvm::BasicBlock::end]. *) +external instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos + = "llvm_instr_end" + +(** [instr_pred i] returns the instruction list position preceding [After i]. + See the method [llvm::BasicBlock::iterator::operator--]. *) +external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos + = "llvm_instr_pred" + +(** [fold_right_instrs f bb init] is [f (... (f init fN) ...) f1] where + [f1,...,fN] are the instructions of basic block [bb]. Tail recursive. *) +val fold_right_instrs: (llvalue -> 'a -> 'a) -> llbasicblock -> 'a -> 'a + (** {7 Operations on call sites} *) @@ -1114,25 +1150,33 @@ external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" (** [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" +external builder : unit -> llbuilder = "llvm_builder" + +(** [builder_at ip] creates an instruction builder positioned at [ip]. + See the constructor for [llvm::LLVMBuilder]. *) +val builder_at : (llbasicblock, llvalue) llpos -> llbuilder (** [builder_before ins] creates an instruction builder positioned before the instruction [isn]. See the constructor for [llvm::LLVMBuilder]. *) -external builder_before : llvalue -> llbuilder = "llvm_builder_before" +val builder_before : llvalue -> llbuilder (** [builder_at_end bb] creates an instruction builder positioned at the end of the basic block [bb]. See the constructor for [llvm::LLVMBuilder]. *) -external builder_at_end : llbasicblock -> llbuilder = "llvm_builder_at_end" +val builder_at_end : llbasicblock -> llbuilder + +(** [position_builder ip bb] moves the instruction builder [bb] to the position + [ip]. + See the constructor for [llvm::LLVMBuilder]. *) +external position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit + = "llvm_position_builder" (** [position_before ins b] moves the instruction builder [b] to before the instruction [isn]. See the method [llvm::LLVMBuilder::SetInsertPoint]. *) -external position_before : llvalue -> llbuilder -> unit = "llvm_position_before" +val position_before : llvalue -> llbuilder -> unit (** [position_at_end bb b] moves the instruction builder [b] to the end of the basic block [bb]. See the method [llvm::LLVMBuilder::SetInsertPoint]. *) -external position_at_end : llbasicblock -> llbuilder -> unit - = "llvm_position_at_end" +val position_at_end : llbasicblock -> llbuilder -> unit (** [insertion_block b] returns the basic block that the builder [b] is positioned to insert into. Raises [Not_Found] if the instruction builder is diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c index 1b76488cd10..a4a940e55ad 100644 --- a/bindings/ocaml/llvm/llvm_ocaml.c +++ b/bindings/ocaml/llvm/llvm_ocaml.c @@ -714,6 +714,12 @@ CAMLprim value llvm_value_is_block(LLVMValueRef Val) { return Val_bool(LLVMValueIsBasicBlock(Val)); } +/*--... Operations on instructions .........................................--*/ + +DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef, + LLVMGetInstructionParent) + + /*--... Operations on call sites ...........................................--*/ /* llvalue -> int */ @@ -789,29 +795,15 @@ CAMLprim value llvm_builder(value Unit) { return alloc_builder(LLVMCreateBuilder()); } -/* llvalue -> llbuilder */ -CAMLprim value llvm_builder_before(LLVMValueRef Inst) { - LLVMBuilderRef B = LLVMCreateBuilder(); - LLVMPositionBuilderBefore(B, Inst); - return alloc_builder(B); -} - -/* llbasicblock -> llbuilder */ -CAMLprim value llvm_builder_at_end(LLVMBasicBlockRef BB) { - LLVMBuilderRef B = LLVMCreateBuilder(); - LLVMPositionBuilderAtEnd(B, BB); - return alloc_builder(B); -} - -/* llvalue -> llbuilder -> unit */ -CAMLprim value llvm_position_before(LLVMValueRef Inst, value B) { - LLVMPositionBuilderBefore(Builder_val(B), Inst); - return Val_unit; -} - -/* llbasicblock -> llbuilder -> unit */ -CAMLprim value llvm_position_at_end(LLVMBasicBlockRef BB, value B) { - LLVMPositionBuilderAtEnd(Builder_val(B), BB); +/* (llbasicblock, llvalue) llpos -> llbuilder -> unit */ +CAMLprim value llvm_position_builder(value Pos, value B) { + if (Tag_val(Pos) == 0) { + LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0)); + LLVMPositionBuilderAtEnd(Builder_val(B), BB); + } else { + LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0)); + LLVMPositionBuilderBefore(Builder_val(B), I); + } return Val_unit; }