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 -----------------------------------------------------------===*)
= "LLVMConstShuffleVector"
(*--... Operations on global variables, functions, and aliases (globals) ...--*)
+external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent"
external is_declaration : llvalue -> bool = "llvm_is_declaration"
external linkage : llvalue -> Linkage.t = "llvm_linkage"
external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage"
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
external lookup_function : string -> llmodule -> llvalue option
= "llvm_lookup_function"
external delete_function : llvalue -> unit = "llvm_delete_function"
-external params : llvalue -> llvalue array = "llvm_params"
-external param : llvalue -> int -> llvalue = "llvm_param"
external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic"
external function_call_conv : llvalue -> int = "llvm_function_call_conv"
external set_function_call_conv : int -> llvalue -> unit
= "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 *)
+(*--... Operations on params ...............................................--*)
+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 value_is_block : llvalue -> bool = "llvm_value_is_block"
+external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
+external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent"
external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks"
external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock"
external delete_block : llbasicblock -> unit = "llvm_delete_block"
external append_block : string -> llvalue -> llbasicblock = "llvm_append_block"
external insert_block : string -> llbasicblock -> llbasicblock
= "llvm_insert_block"
-external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
-external value_is_block : llvalue -> bool = "llvm_value_is_block"
-external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
+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"
(*--... Operations on call sites ...........................................--*)
external instruction_call_conv: llvalue -> int
(*===-- Instruction builders ----------------------------------------------===*)
-external builder: unit-> llbuilder
- = "llvm_builder"
+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 insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block"
(*--... Terminators ........................................................--*)
external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void"
end
+(*===-- Pass Manager ------------------------------------------------------===*)
+
+module PassManager = struct
+ type 'a t
+ type any = [ `Module | `Function ]
+ external create : unit -> [ `Module ] t = "llvm_passmanager_create"
+ external create_function : llmoduleprovider -> [ `Function ] t
+ = "LLVMCreateFunctionPassManager"
+ external run_module : llmodule -> [ `Module ] t -> bool
+ = "llvm_passmanager_run_module"
+ external initialize : [ `Function ] t -> bool = "llvm_passmanager_initialize"
+ external run_function : llvalue -> [ `Function ] t -> bool
+ = "llvm_passmanager_run_function"
+ external finalize : [ `Function ] t -> bool = "llvm_passmanager_finalize"
+ external dispose : [< any ] t -> unit = "llvm_passmanager_dispose"
+end
+
+
(*===-- Non-Externs -------------------------------------------------------===*)
(* These functions are built using the externals, so must be declared late. *)