Extend the builder interface to use the new instruction positioning code.
authorGordon Henriksen <gordonhenriksen@mac.com>
Tue, 25 Mar 2008 16:26:51 +0000 (16:26 +0000)
committerGordon Henriksen <gordonhenriksen@mac.com>
Tue, 25 Mar 2008 16:26:51 +0000 (16:26 +0000)
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
bindings/ocaml/llvm/llvm.mli
bindings/ocaml/llvm/llvm_ocaml.c

index 56bfa7b..85acc5e 100644 (file)
@@ -531,6 +531,55 @@ let fold_right_blocks f fn init =
 
 (*--... Operations on instructions .........................................--*)
 external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent"
 
 (*--... 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
 
 (*--... Operations on call sites ...........................................--*)
 external instruction_call_conv: llvalue -> int
@@ -545,14 +594,23 @@ external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
 
 
 (*===-- Instruction builders ----------------------------------------------===*)
 
 
 (*===-- 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"
 
 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"
 (*--... Terminators ........................................................--*)
 external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void"
 external build_ret : llvalue -> llbuilder -> llvalue = "llvm_build_ret"
index 8be5c65..5aedefb 100644 (file)
@@ -1077,6 +1077,42 @@ external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
     See the method [llvm::Instruction::getParent]. *)
 external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent"
 
     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} *)
 
 
 (** {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]. *)
 (** [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]. *)
 
 (** [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]. *)
 
 (** [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]. *)
 
 (** [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]. *)
 
 (** [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
 
 (** [insertion_block b] returns the basic block that the builder [b] is
     positioned to insert into. Raises [Not_Found] if the instruction builder is
index 1b76488..a4a940e 100644 (file)
@@ -714,6 +714,12 @@ CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
   return Val_bool(LLVMValueIsBasicBlock(Val));
 }
 
   return Val_bool(LLVMValueIsBasicBlock(Val));
 }
 
+/*--... Operations on instructions .........................................--*/
+
+DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
+                 LLVMGetInstructionParent)
+
+
 /*--... Operations on call sites ...........................................--*/
 
 /* llvalue -> int */
 /*--... Operations on call sites ...........................................--*/
 
 /* llvalue -> int */
@@ -789,29 +795,15 @@ CAMLprim value llvm_builder(value Unit) {
   return alloc_builder(LLVMCreateBuilder());
 }
 
   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;
 }
 
   return Val_unit;
 }