Extend the builder interface to use the new instruction positioning code.

This adds support for instruction iterators, as well as rewriting the
builder code to use these new functions. This lets us eliminate the C
bindings for moving around the builder.

Patch by Erick Tryzelaar!


git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@48774 91177308-0d34-0410-b5e6-96231b3b80d8

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"

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

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;
 }