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 -----------------------------------------------------------===*)
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
= "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 *)
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"
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"
+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
(*===-- 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"
projects / oota-llvm.git / blobdiff