type llcontext
type llmodule
type lltype
-type lltypehandle
type llvalue
type lluse
type llbasicblock
| Struct
| Array
| Pointer
- | Opaque
| Vector
| Metadata
end
| True
end
+module Opcode = struct
+ type t =
+ | Invalid (* not an instruction *)
+ (* Terminator Instructions *)
+ | Ret
+ | Br
+ | Switch
+ | IndirectBr
+ | Invoke
+ | Invalid2
+ | Unreachable
+ (* Standard Binary Operators *)
+ | Add
+ | FAdd
+ | Sub
+ | FSub
+ | Mul
+ | FMul
+ | UDiv
+ | SDiv
+ | FDiv
+ | URem
+ | SRem
+ | FRem
+ (* Logical Operators *)
+ | Shl
+ | LShr
+ | AShr
+ | And
+ | Or
+ | Xor
+ (* Memory Operators *)
+ | Alloca
+ | Load
+ | Store
+ | GetElementPtr
+ (* Cast Operators *)
+ | Trunc
+ | ZExt
+ | SExt
+ | FPToUI
+ | FPToSI
+ | UIToFP
+ | SIToFP
+ | FPTrunc
+ | FPExt
+ | PtrToInt
+ | IntToPtr
+ | BitCast
+ (* Other Operators *)
+ | ICmp
+ | FCmp
+ | PHI
+ | Call
+ | Select
+ | UserOp1
+ | UserOp2
+ | VAArg
+ | ExtractElement
+ | InsertElement
+ | ShuffleVector
+ | ExtractValue
+ | InsertValue
+ | Fence
+ | AtomicCmpXchg
+ | AtomicRMW
+ | Resume
+ | LandingPad
+ | Unwind
+end
+
+module ValueKind = struct
+ type t =
+ | NullValue
+ | Argument
+ | BasicBlock
+ | InlineAsm
+ | MDNode
+ | MDString
+ | BlockAddress
+ | ConstantAggregateZero
+ | ConstantArray
+ | ConstantExpr
+ | ConstantFP
+ | ConstantInt
+ | ConstantPointerNull
+ | ConstantStruct
+ | ConstantVector
+ | Function
+ | GlobalAlias
+ | GlobalVariable
+ | UndefValue
+ | Instruction of Opcode.t
+end
+
exception IoError of string
external register_exns : exn -> unit = "llvm_register_core_exns"
= "llvm_data_layout"
external set_data_layout: string -> llmodule -> unit
= "llvm_set_data_layout"
-external define_type_name : string -> lltype -> llmodule -> bool
- = "llvm_add_type_name"
-external delete_type_name : string -> llmodule -> unit
- = "llvm_delete_type_name"
-external type_by_name : llmodule -> string -> lltype option
- = "llvm_type_by_name"
external dump_module : llmodule -> unit = "llvm_dump_module"
external set_module_inline_asm : llmodule -> string -> unit
= "llvm_set_module_inline_asm"
(*===-- Types -------------------------------------------------------------===*)
external classify_type : lltype -> TypeKind.t = "llvm_classify_type"
external type_context : lltype -> llcontext = "llvm_type_context"
+external type_is_sized : lltype -> bool = "llvm_type_is_sized"
(*--... Operations on integer types ........................................--*)
external i1_type : llcontext -> lltype = "llvm_i1_type"
external struct_type : llcontext -> lltype array -> lltype = "llvm_struct_type"
external packed_struct_type : llcontext -> lltype array -> lltype
= "llvm_packed_struct_type"
+external struct_name : lltype -> string option = "llvm_struct_name"
+external named_struct_type : llcontext -> string -> lltype =
+ "llvm_named_struct_type"
+external struct_set_body : lltype -> lltype array -> bool -> unit =
+ "llvm_struct_set_body"
external struct_element_types : lltype -> lltype array
= "llvm_struct_element_types"
external is_packed : lltype -> bool = "llvm_is_packed"
+external is_opaque : lltype -> bool = "llvm_is_opaque"
(*--... Operations on pointer, vector, and array types .....................--*)
external array_type : lltype -> int -> lltype = "llvm_array_type"
external vector_size : lltype -> int = "llvm_vector_size"
(*--... Operations on other types ..........................................--*)
-external opaque_type : llcontext -> lltype = "llvm_opaque_type"
external void_type : llcontext -> lltype = "llvm_void_type"
external label_type : llcontext -> lltype = "llvm_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"
-
-
+external classify_value : llvalue -> ValueKind.t = "llvm_classify_value"
(*===-- Values ------------------------------------------------------------===*)
external type_of : llvalue -> lltype = "llvm_type_of"
external value_name : llvalue -> string = "llvm_value_name"
external undef : lltype -> llvalue = "LLVMGetUndef"
external is_null : llvalue -> bool = "llvm_is_null"
external is_undef : llvalue -> bool = "llvm_is_undef"
+external constexpr_opcode : llvalue -> Opcode.t = "llvm_constexpr_get_opcode"
(*--... Operations on instructions .........................................--*)
external has_metadata : llvalue -> bool = "llvm_has_metadata"
(*--... Operations on metadata .......,.....................................--*)
external mdstring : llcontext -> string -> llvalue = "llvm_mdstring"
external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode"
+external get_mdstring : llvalue -> string option = "llvm_get_mdstring"
+external get_named_metadata : llmodule -> string -> llvalue array = "llvm_get_namedmd"
(*--... Operations on scalar constants .....................................--*)
external const_int : lltype -> int -> llvalue = "llvm_const_int"
external const_of_int64 : lltype -> Int64.t -> bool -> llvalue
= "llvm_const_of_int64"
+external int64_of_const : llvalue -> Int64.t option
+ = "llvm_int64_of_const"
external const_int_of_string : lltype -> string -> int -> llvalue
= "llvm_const_int_of_string"
external const_float : lltype -> float -> llvalue = "llvm_const_float"
external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array"
external const_struct : llcontext -> llvalue array -> llvalue
= "llvm_const_struct"
+external const_named_struct : lltype -> llvalue array -> llvalue
+ = "llvm_const_named_struct"
external const_packed_struct : llcontext -> llvalue array -> llvalue
= "llvm_const_packed_struct"
external const_vector : llvalue array -> llvalue = "llvm_const_vector"
external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos
= "llvm_instr_pred"
+external instr_opcode : llvalue -> Opcode.t = "llvm_instr_get_opcode"
+external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate"
+
let rec iter_instrs_range f i e =
if i = e then () else
match i with
external build_invoke : llvalue -> llvalue array -> llbasicblock ->
llbasicblock -> string -> llbuilder -> llvalue
= "llvm_build_invoke_bc" "llvm_build_invoke_nat"
-external build_unwind : llbuilder -> llvalue = "llvm_build_unwind"
+external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
+ llvalue = "llvm_build_landingpad"
+external set_cleanup : llvalue -> bool -> unit = "llvm_set_cleanup"
external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable"
(*--... Arithmetic .........................................................--*)
(* FIXME: stop infinite recursion! :) *)
match classify_type ty with
TypeKind.Integer -> "i" ^ string_of_int (integer_bitwidth ty)
- | TypeKind.Pointer -> (string_of_lltype (element_type ty)) ^ "*"
+ | TypeKind.Pointer ->
+ (let ety = element_type ty in
+ match classify_type ety with
+ | TypeKind.Struct ->
+ (match struct_name ety with
+ | None -> (string_of_lltype ety)
+ | Some s -> s) ^ "*"
+ | _ -> (string_of_lltype (element_type ty)) ^ "*")
| TypeKind.Struct ->
let s = "{ " ^ (concat2 ", " (
Array.map string_of_lltype (struct_element_types ty)
" x " ^ (string_of_lltype (element_type ty)) ^ "]"
| TypeKind.Vector -> "<" ^ (string_of_int (vector_size ty)) ^
" x " ^ (string_of_lltype (element_type ty)) ^ ">"
- | TypeKind.Opaque -> "opaque"
| TypeKind.Function -> string_of_lltype (return_type ty) ^
" (" ^ (concat2 ", " (
Array.map string_of_lltype (param_types ty)