| 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"
(*===-- 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 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 void_type : llcontext -> lltype = "llvm_void_type"
external label_type : llcontext -> lltype = "llvm_label_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"
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 =
(* 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)