* This file was developed by Gordon Henriksen and is distributed under the
* University of Illinois Open Source License. See LICENSE.TXT for details.
*
- *===----------------------------------------------------------------------===
- *
- * This interface provides an ocaml API for the LLVM intermediate
- * representation, the classes in the VMCore library.
- *
*===----------------------------------------------------------------------===*)
-(* These abstract types correlate directly to the LLVM VMCore classes. *)
type llmodule
type lltype
+type lltypehandle
type llvalue
-type llbasicblock (* These are actually values, but
- benefit from type checking. *)
+type llbasicblock
type llbuilder
+type llmoduleprovider
type type_kind =
Void_type
(*===-- Modules -----------------------------------------------------------===*)
-(* Creates a module with the supplied module ID. Modules are not garbage
- collected; it is mandatory to call dispose_module to free memory. *)
external create_module : string -> llmodule = "llvm_create_module"
-
-(* Disposes a module. All references to subordinate objects are invalidated;
- referencing them will invoke undefined behavior. *)
external dispose_module : llmodule -> unit = "llvm_dispose_module"
-
-(* Adds a named type to the module's symbol table. Returns true if successful.
- If such a name already exists, then no entry is added and returns false. *)
external define_type_name : string -> lltype -> llmodule -> bool
= "llvm_add_type_name"
-
external delete_type_name : string -> llmodule -> unit
= "llvm_delete_type_name"
(*===-- Types -------------------------------------------------------------===*)
external classify_type : lltype -> type_kind = "llvm_classify_type"
-external refine_abstract_type : lltype -> lltype -> unit
- = "llvm_refine_abstract_type"
(*--... Operations on integer types ........................................--*)
external _i1_type : unit -> lltype = "llvm_i1_type"
let i32_type = _i32_type ()
let i64_type = _i64_type ()
-external make_integer_type : int -> lltype = "llvm_make_integer_type"
+external integer_type : int -> lltype = "llvm_integer_type"
external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth"
(*--... Operations on real types ...........................................--*)
let ppc_fp128_type = _ppc_fp128_type ()
(*--... Operations on function types .......................................--*)
-(* FIXME: handle parameter attributes *)
-external make_function_type : lltype -> lltype array -> bool -> lltype
- = "llvm_make_function_type"
+external function_type : lltype -> lltype array -> lltype = "llvm_function_type"
+external var_arg_function_type : lltype -> lltype array -> lltype
+ = "llvm_var_arg_function_type"
external is_var_arg : lltype -> bool = "llvm_is_var_arg"
-external return_type : lltype -> lltype = "llvm_return_type"
+external return_type : lltype -> lltype = "LLVMGetReturnType"
external param_types : lltype -> lltype array = "llvm_param_types"
(*--... Operations on struct types .........................................--*)
-external make_struct_type : lltype array -> bool -> lltype
- = "llvm_make_struct_type"
+external struct_type : lltype array -> lltype = "llvm_struct_type"
+external packed_struct_type : lltype array -> lltype = "llvm_packed_struct_type"
external element_types : lltype -> lltype array = "llvm_element_types"
external is_packed : lltype -> bool = "llvm_is_packed"
(*--... Operations on pointer, vector, and array types .....................--*)
-external make_array_type : lltype -> int -> lltype = "llvm_make_array_type"
-external make_pointer_type : lltype -> lltype = "llvm_make_pointer_type"
-external make_vector_type : lltype -> int -> lltype = "llvm_make_vector_type"
+external array_type : lltype -> int -> lltype = "llvm_array_type"
+external pointer_type : lltype -> lltype = "LLVMPointerType"
+external vector_type : lltype -> int -> lltype = "llvm_vector_type"
-external element_type : lltype -> lltype = "llvm_element_type"
+external element_type : lltype -> lltype = "LLVMGetElementType"
external array_length : lltype -> int = "llvm_array_length"
external vector_size : lltype -> int = "llvm_vector_size"
(*--... Operations on other types ..........................................--*)
-external make_opaque_type : unit -> lltype = "llvm_make_opaque_type"
+external opaque_type : unit -> lltype = "llvm_opaque_type"
external _void_type : unit -> lltype = "llvm_void_type"
external _label_type : unit -> lltype = "llvm_label_type"
let void_type = _void_type ()
let label_type = _label_type ()
+(*--... Operations on type handles .........................................--*)
+external handle_to_type : lltype -> lltypehandle = "llvm_handle_to_type"
+external type_of_handle : lltypehandle -> lltype = "llvm_type_of_handle"
+external refine_type : lltype -> lltype -> unit = "llvm_refine_type"
+
(*===-- Values ------------------------------------------------------------===*)
external set_visibility : visibility -> llvalue -> unit = "llvm_set_visibility"
external alignment : llvalue -> int = "llvm_alignment"
external set_alignment : int -> llvalue -> unit = "llvm_set_alignment"
+external is_global_constant : llvalue -> bool = "llvm_is_global_constant"
+external set_global_constant : bool -> llvalue -> unit
+ = "llvm_set_global_constant"
(*--... Operations on global variables .....................................--*)
external declare_global : lltype -> string -> llmodule -> llvalue
= "llvm_declare_global"
external define_global : string -> llvalue -> llmodule -> llvalue
= "llvm_define_global"
+external lookup_global : string -> llmodule -> llvalue option
+ = "llvm_lookup_global"
external delete_global : llvalue -> unit = "llvm_delete_global"
+external has_initializer : llvalue -> bool = "llvm_has_initializer"
external global_initializer : llvalue -> llvalue = "LLVMGetInitializer"
external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer"
external remove_initializer : llvalue -> unit = "llvm_remove_initializer"
= "llvm_declare_function"
external define_function : string -> lltype -> llmodule -> llvalue
= "llvm_define_function"
+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 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"
(* TODO: param attrs *)
external value_is_block : llvalue -> bool = "llvm_value_is_block"
external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
+(*--... Operations on phi nodes ............................................--*)
+external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
+ = "llvm_add_incoming"
+external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
+
(*===-- Instruction builders ----------------------------------------------===*)
external builder_before : llvalue -> llbuilder = "llvm_builder_before"
llbuilder -> llvalue = "llvm_build_fcmp"
(*--... Miscellaneous instructions .........................................--*)
-external build_phi : lltype -> string -> llbuilder -> llvalue = "llvm_build_phi"
+external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder ->
+ llvalue = "llvm_build_phi"
external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue
= "llvm_build_call"
external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder ->
llbuilder -> llvalue = "llvm_build_shufflevector"
+(*===-- Module providers --------------------------------------------------===*)
+external create_module_provider : llmodule -> llmoduleprovider
+ = "LLVMCreateModuleProviderForExistingModule"
+external dispose_module_provider : llmoduleprovider -> unit
+ = "llvm_dispose_module_provider"
+
+
(*===-- Non-Externs -------------------------------------------------------===*)
(* These functions are built using the externals, so must be declared late. *)
!s
let rec string_of_lltype ty =
+ (* FIXME: stop infinite recursion! :) *)
match classify_type ty with
Integer_type -> "i" ^ string_of_int (integer_bitwidth ty)
| Pointer_type -> (string_of_lltype (element_type ty)) ^ "*"