llvm.ml revision 404a1942e43ca967700cc2608eb97b863add2677
1(*===-- tools/ml/llvm.ml - LLVM Ocaml Interface ---------------------------===* 2 * 3 * The LLVM Compiler Infrastructure 4 * 5 * This file was developed by Gordon Henriksen and is distributed under the 6 * University of Illinois Open Source License. See LICENSE.TXT for details. 7 * 8 *===----------------------------------------------------------------------===*) 9 10 11type llmodule 12type lltype 13type lltypehandle 14type llvalue 15type llbasicblock 16type llbuilder 17type llmoduleprovider 18type llmemorybuffer 19 20module TypeKind = struct 21 type t = 22 | Void 23 | Float 24 | Double 25 | X86fp80 26 | Fp128 27 | Ppc_fp128 28 | Label 29 | Integer 30 | Function 31 | Struct 32 | Array 33 | Pointer 34 | Opaque 35 | Vector 36end 37 38module Linkage = struct 39 type t = 40 | External 41 | Link_once 42 | Weak 43 | Appending 44 | Internal 45 | Dllimport 46 | Dllexport 47 | External_weak 48 | Ghost 49end 50 51module Visibility = struct 52 type t = 53 | Default 54 | Hidden 55 | Protected 56end 57 58let ccc = 0 59let fastcc = 8 60let coldcc = 9 61let x86_stdcallcc = 64 62let x86_fastcallcc = 65 63 64module Icmp = struct 65 type t = 66 | Eq 67 | Ne 68 | Ugt 69 | Uge 70 | Ult 71 | Ule 72 | Sgt 73 | Sge 74 | Slt 75 | Sle 76end 77 78module Fcmp = struct 79 type t = 80 | False 81 | Oeq 82 | Ogt 83 | Oge 84 | Olt 85 | Ole 86 | One 87 | Ord 88 | Uno 89 | Ueq 90 | Ugt 91 | Uge 92 | Ult 93 | Ule 94 | Une 95 | True 96end 97 98exception IoError of string 99 100external register_exns : exn -> unit = "llvm_register_core_exns" 101let _ = register_exns (IoError "") 102 103 104(*===-- Modules -----------------------------------------------------------===*) 105 106external create_module : string -> llmodule = "llvm_create_module" 107external dispose_module : llmodule -> unit = "llvm_dispose_module" 108external define_type_name : string -> lltype -> llmodule -> bool 109 = "llvm_add_type_name" 110external delete_type_name : string -> llmodule -> unit 111 = "llvm_delete_type_name" 112 113 114(*===-- Types -------------------------------------------------------------===*) 115 116external classify_type : lltype -> TypeKind.t = "llvm_classify_type" 117 118(*--... Operations on integer types ........................................--*) 119external _i1_type : unit -> lltype = "llvm_i1_type" 120external _i8_type : unit -> lltype = "llvm_i8_type" 121external _i16_type : unit -> lltype = "llvm_i16_type" 122external _i32_type : unit -> lltype = "llvm_i32_type" 123external _i64_type : unit -> lltype = "llvm_i64_type" 124 125let i1_type = _i1_type () 126let i8_type = _i8_type () 127let i16_type = _i16_type () 128let i32_type = _i32_type () 129let i64_type = _i64_type () 130 131external integer_type : int -> lltype = "llvm_integer_type" 132external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth" 133 134(*--... Operations on real types ...........................................--*) 135external _float_type : unit -> lltype = "llvm_float_type" 136external _double_type : unit -> lltype = "llvm_double_type" 137external _x86fp80_type : unit -> lltype = "llvm_x86fp80_type" 138external _fp128_type : unit -> lltype = "llvm_fp128_type" 139external _ppc_fp128_type : unit -> lltype = "llvm_ppc_fp128_type" 140 141let float_type = _float_type () 142let double_type = _double_type () 143let x86fp80_type = _x86fp80_type () 144let fp128_type = _fp128_type () 145let ppc_fp128_type = _ppc_fp128_type () 146 147(*--... Operations on function types .......................................--*) 148external function_type : lltype -> lltype array -> lltype = "llvm_function_type" 149external var_arg_function_type : lltype -> lltype array -> lltype 150 = "llvm_var_arg_function_type" 151external is_var_arg : lltype -> bool = "llvm_is_var_arg" 152external return_type : lltype -> lltype = "LLVMGetReturnType" 153external param_types : lltype -> lltype array = "llvm_param_types" 154 155(*--... Operations on struct types .........................................--*) 156external struct_type : lltype array -> lltype = "llvm_struct_type" 157external packed_struct_type : lltype array -> lltype = "llvm_packed_struct_type" 158external element_types : lltype -> lltype array = "llvm_element_types" 159external is_packed : lltype -> bool = "llvm_is_packed" 160 161(*--... Operations on pointer, vector, and array types .....................--*) 162external array_type : lltype -> int -> lltype = "llvm_array_type" 163external pointer_type : lltype -> lltype = "llvm_pointer_type" 164external qualified_pointer_type : lltype -> int -> lltype 165 = "llvm_qualified_pointer_type" 166external vector_type : lltype -> int -> lltype = "llvm_vector_type" 167 168external element_type : lltype -> lltype = "LLVMGetElementType" 169external array_length : lltype -> int = "llvm_array_length" 170external address_space : lltype -> int = "llvm_address_space" 171external vector_size : lltype -> int = "llvm_vector_size" 172 173(*--... Operations on other types ..........................................--*) 174external opaque_type : unit -> lltype = "llvm_opaque_type" 175external _void_type : unit -> lltype = "llvm_void_type" 176external _label_type : unit -> lltype = "llvm_label_type" 177 178let void_type = _void_type () 179let label_type = _label_type () 180 181(*--... Operations on type handles .........................................--*) 182external handle_to_type : lltype -> lltypehandle = "llvm_handle_to_type" 183external type_of_handle : lltypehandle -> lltype = "llvm_type_of_handle" 184external refine_type : lltype -> lltype -> unit = "llvm_refine_type" 185 186 187(*===-- Values ------------------------------------------------------------===*) 188 189external type_of : llvalue -> lltype = "llvm_type_of" 190external value_name : llvalue -> string = "llvm_value_name" 191external set_value_name : string -> llvalue -> unit = "llvm_set_value_name" 192external dump_value : llvalue -> unit = "llvm_dump_value" 193 194(*--... Operations on constants of (mostly) any type .......................--*) 195external is_constant : llvalue -> bool = "llvm_is_constant" 196external const_null : lltype -> llvalue = "LLVMConstNull" 197external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes" 198external undef : lltype -> llvalue = "LLVMGetUndef" 199external is_null : llvalue -> bool = "llvm_is_null" 200external is_undef : llvalue -> bool = "llvm_is_undef" 201 202(*--... Operations on scalar constants .....................................--*) 203external const_int : lltype -> int -> llvalue = "llvm_const_int" 204external const_of_int64 : lltype -> Int64.t -> bool -> llvalue 205 = "llvm_const_of_int64" 206external const_float : lltype -> float -> llvalue = "llvm_const_float" 207 208(*--... Operations on composite constants ..................................--*) 209external const_string : string -> llvalue = "llvm_const_string" 210external const_stringz : string -> llvalue = "llvm_const_stringz" 211external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array" 212external const_struct : llvalue array -> llvalue = "llvm_const_struct" 213external const_packed_struct : llvalue array -> llvalue 214 = "llvm_const_packed_struct" 215external const_vector : llvalue array -> llvalue = "llvm_const_vector" 216 217(*--... Constant expressions ...............................................--*) 218external size_of : lltype -> llvalue = "LLVMSizeOf" 219external const_neg : llvalue -> llvalue = "LLVMConstNeg" 220external const_not : llvalue -> llvalue = "LLVMConstNot" 221external const_add : llvalue -> llvalue -> llvalue = "LLVMConstAdd" 222external const_sub : llvalue -> llvalue -> llvalue = "LLVMConstSub" 223external const_mul : llvalue -> llvalue -> llvalue = "LLVMConstMul" 224external const_udiv : llvalue -> llvalue -> llvalue = "LLVMConstUDiv" 225external const_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstSDiv" 226external const_fdiv : llvalue -> llvalue -> llvalue = "LLVMConstFDiv" 227external const_urem : llvalue -> llvalue -> llvalue = "LLVMConstURem" 228external const_srem : llvalue -> llvalue -> llvalue = "LLVMConstSRem" 229external const_frem : llvalue -> llvalue -> llvalue = "LLVMConstFRem" 230external const_and : llvalue -> llvalue -> llvalue = "LLVMConstAnd" 231external const_or : llvalue -> llvalue -> llvalue = "LLVMConstOr" 232external const_xor : llvalue -> llvalue -> llvalue = "LLVMConstXor" 233external const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue 234 = "llvm_const_icmp" 235external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue 236 = "llvm_const_fcmp" 237external const_shl : llvalue -> llvalue -> llvalue = "LLVMConstShl" 238external const_lshr : llvalue -> llvalue -> llvalue = "LLVMConstLShr" 239external const_ashr : llvalue -> llvalue -> llvalue = "LLVMConstAShr" 240external const_gep : llvalue -> llvalue array -> llvalue = "llvm_const_gep" 241external const_trunc : llvalue -> lltype -> llvalue = "LLVMConstTrunc" 242external const_sext : llvalue -> lltype -> llvalue = "LLVMConstSExt" 243external const_zext : llvalue -> lltype -> llvalue = "LLVMConstZExt" 244external const_fptrunc : llvalue -> lltype -> llvalue = "LLVMConstFPTrunc" 245external const_fpext : llvalue -> lltype -> llvalue = "LLVMConstFPExt" 246external const_uitofp : llvalue -> lltype -> llvalue = "LLVMConstUIToFP" 247external const_sitofp : llvalue -> lltype -> llvalue = "LLVMConstSIToFP" 248external const_fptoui : llvalue -> lltype -> llvalue = "LLVMConstFPToUI" 249external const_fptosi : llvalue -> lltype -> llvalue = "LLVMConstFPToSI" 250external const_ptrtoint : llvalue -> lltype -> llvalue = "LLVMConstPtrToInt" 251external const_inttoptr : llvalue -> lltype -> llvalue = "LLVMConstIntToPtr" 252external const_bitcast : llvalue -> lltype -> llvalue = "LLVMConstBitCast" 253external const_select : llvalue -> llvalue -> llvalue -> llvalue 254 = "LLVMConstSelect" 255external const_extractelement : llvalue -> llvalue -> llvalue 256 = "LLVMConstExtractElement" 257external const_insertelement : llvalue -> llvalue -> llvalue -> llvalue 258 = "LLVMConstInsertElement" 259external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue 260 = "LLVMConstShuffleVector" 261 262(*--... Operations on global variables, functions, and aliases (globals) ...--*) 263external is_declaration : llvalue -> bool = "llvm_is_declaration" 264external linkage : llvalue -> Linkage.t = "llvm_linkage" 265external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage" 266external section : llvalue -> string = "llvm_section" 267external set_section : string -> llvalue -> unit = "llvm_set_section" 268external visibility : llvalue -> Visibility.t = "llvm_visibility" 269external set_visibility : Visibility.t -> llvalue -> unit = "llvm_set_visibility" 270external alignment : llvalue -> int = "llvm_alignment" 271external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" 272external is_global_constant : llvalue -> bool = "llvm_is_global_constant" 273external set_global_constant : bool -> llvalue -> unit 274 = "llvm_set_global_constant" 275 276(*--... Operations on global variables .....................................--*) 277external declare_global : lltype -> string -> llmodule -> llvalue 278 = "llvm_declare_global" 279external define_global : string -> llvalue -> llmodule -> llvalue 280 = "llvm_define_global" 281external lookup_global : string -> llmodule -> llvalue option 282 = "llvm_lookup_global" 283external delete_global : llvalue -> unit = "llvm_delete_global" 284external has_initializer : llvalue -> bool = "llvm_has_initializer" 285external global_initializer : llvalue -> llvalue = "LLVMGetInitializer" 286external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer" 287external remove_initializer : llvalue -> unit = "llvm_remove_initializer" 288external is_thread_local : llvalue -> bool = "llvm_is_thread_local" 289external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local" 290 291(*--... Operations on functions ............................................--*) 292external declare_function : string -> lltype -> llmodule -> llvalue 293 = "llvm_declare_function" 294external define_function : string -> lltype -> llmodule -> llvalue 295 = "llvm_define_function" 296external lookup_function : string -> llmodule -> llvalue option 297 = "llvm_lookup_function" 298external delete_function : llvalue -> unit = "llvm_delete_function" 299external params : llvalue -> llvalue array = "llvm_params" 300external param : llvalue -> int -> llvalue = "llvm_param" 301external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic" 302external function_call_conv : llvalue -> int = "llvm_function_call_conv" 303external set_function_call_conv : int -> llvalue -> unit 304 = "llvm_set_function_call_conv" 305external collector : llvalue -> string option = "llvm_collector" 306external set_collector : string option -> llvalue -> unit = "llvm_set_collector" 307 308(* TODO: param attrs *) 309 310(*--... Operations on basic blocks .........................................--*) 311external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks" 312external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock" 313external delete_block : llbasicblock -> unit = "llvm_delete_block" 314external append_block : string -> llvalue -> llbasicblock = "llvm_append_block" 315external insert_block : string -> llbasicblock -> llbasicblock 316 = "llvm_insert_block" 317external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" 318external value_is_block : llvalue -> bool = "llvm_value_is_block" 319external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" 320 321(*--... Operations on phi nodes ............................................--*) 322external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit 323 = "llvm_add_incoming" 324external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" 325 326 327(*===-- Instruction builders ----------------------------------------------===*) 328external builder_before : llvalue -> llbuilder = "llvm_builder_before" 329external builder_at_end : llbasicblock -> llbuilder = "llvm_builder_at_end" 330external position_before : llvalue -> llbuilder -> unit = "llvm_position_before" 331external position_at_end : llbasicblock -> llbuilder -> unit 332 = "llvm_position_at_end" 333 334(*--... Terminators ........................................................--*) 335external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void" 336external build_ret : llvalue -> llbuilder -> llvalue = "llvm_build_ret" 337external build_br : llbasicblock -> llbuilder -> llvalue = "llvm_build_br" 338external build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder -> 339 llvalue = "llvm_build_cond_br" 340external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue 341 = "llvm_build_switch" 342external build_invoke : llvalue -> llvalue array -> llbasicblock -> 343 llbasicblock -> string -> llbuilder -> llvalue 344 = "llvm_build_invoke_bc" "llvm_build_invoke_nat" 345external build_unwind : llbuilder -> llvalue = "llvm_build_unwind" 346external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable" 347 348(*--... Arithmetic .........................................................--*) 349external build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 350 = "llvm_build_add" 351external build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 352 = "llvm_build_sub" 353external build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 354 = "llvm_build_mul" 355external build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 356 = "llvm_build_udiv" 357external build_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 358 = "llvm_build_sdiv" 359external build_fdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 360 = "llvm_build_fdiv" 361external build_urem : llvalue -> llvalue -> string -> llbuilder -> llvalue 362 = "llvm_build_urem" 363external build_srem : llvalue -> llvalue -> string -> llbuilder -> llvalue 364 = "llvm_build_srem" 365external build_frem : llvalue -> llvalue -> string -> llbuilder -> llvalue 366 = "llvm_build_frem" 367external build_shl : llvalue -> llvalue -> string -> llbuilder -> llvalue 368 = "llvm_build_shl" 369external build_lshr : llvalue -> llvalue -> string -> llbuilder -> llvalue 370 = "llvm_build_lshr" 371external build_ashr : llvalue -> llvalue -> string -> llbuilder -> llvalue 372 = "llvm_build_ashr" 373external build_and : llvalue -> llvalue -> string -> llbuilder -> llvalue 374 = "llvm_build_and" 375external build_or : llvalue -> llvalue -> string -> llbuilder -> llvalue 376 = "llvm_build_or" 377external build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue 378 = "llvm_build_xor" 379external build_neg : llvalue -> string -> llbuilder -> llvalue 380 = "llvm_build_neg" 381external build_not : llvalue -> string -> llbuilder -> llvalue 382 = "llvm_build_not" 383 384(*--... Memory .............................................................--*) 385external build_malloc : lltype -> string -> llbuilder -> llvalue 386 = "llvm_build_malloc" 387external build_array_malloc : lltype -> llvalue -> string -> llbuilder -> 388 llvalue = "llvm_build_array_malloc" 389external build_alloca : lltype -> string -> llbuilder -> llvalue 390 = "llvm_build_alloca" 391external build_array_alloca : lltype -> llvalue -> string -> llbuilder -> 392 llvalue = "llvm_build_array_alloca" 393external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free" 394external build_load : llvalue -> string -> llbuilder -> llvalue 395 = "llvm_build_load" 396external build_store : llvalue -> llvalue -> llbuilder -> llvalue 397 = "llvm_build_store" 398external build_gep : llvalue -> llvalue array -> string -> llbuilder -> llvalue 399 = "llvm_build_gep" 400 401(*--... Casts ..............................................................--*) 402external build_trunc : llvalue -> lltype -> string -> llbuilder -> llvalue 403 = "llvm_build_trunc" 404external build_zext : llvalue -> lltype -> string -> llbuilder -> llvalue 405 = "llvm_build_zext" 406external build_sext : llvalue -> lltype -> string -> llbuilder -> llvalue 407 = "llvm_build_sext" 408external build_fptoui : llvalue -> lltype -> string -> llbuilder -> llvalue 409 = "llvm_build_fptoui" 410external build_fptosi : llvalue -> lltype -> string -> llbuilder -> llvalue 411 = "llvm_build_fptosi" 412external build_uitofp : llvalue -> lltype -> string -> llbuilder -> llvalue 413 = "llvm_build_uitofp" 414external build_sitofp : llvalue -> lltype -> string -> llbuilder -> llvalue 415 = "llvm_build_sitofp" 416external build_fptrunc : llvalue -> lltype -> string -> llbuilder -> llvalue 417 = "llvm_build_fptrunc" 418external build_fpext : llvalue -> lltype -> string -> llbuilder -> llvalue 419 = "llvm_build_fpext" 420external build_ptrtoint : llvalue -> lltype -> string -> llbuilder -> llvalue 421 = "llvm_build_prttoint" 422external build_inttoptr : llvalue -> lltype -> string -> llbuilder -> llvalue 423 = "llvm_build_inttoptr" 424external build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue 425 = "llvm_build_bitcast" 426 427(*--... Comparisons ........................................................--*) 428external build_icmp : Icmp.t -> llvalue -> llvalue -> string -> 429 llbuilder -> llvalue = "llvm_build_icmp" 430external build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> 431 llbuilder -> llvalue = "llvm_build_fcmp" 432 433(*--... Miscellaneous instructions .........................................--*) 434external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder -> 435 llvalue = "llvm_build_phi" 436external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue 437 = "llvm_build_call" 438external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder -> 439 llvalue = "llvm_build_select" 440external build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue 441 = "llvm_build_va_arg" 442external build_extractelement : llvalue -> llvalue -> string -> llbuilder -> 443 llvalue = "llvm_build_extractelement" 444external build_insertelement : llvalue -> llvalue -> llvalue -> string -> 445 llbuilder -> llvalue = "llvm_build_insertelement" 446external build_shufflevector : llvalue -> llvalue -> llvalue -> string -> 447 llbuilder -> llvalue = "llvm_build_shufflevector" 448 449 450(*===-- Module providers --------------------------------------------------===*) 451 452module ModuleProvider = struct 453 external create : llmodule -> llmoduleprovider 454 = "LLVMCreateModuleProviderForExistingModule" 455 external dispose : llmoduleprovider -> unit = "llvm_dispose_module_provider" 456end 457 458 459(*===-- Memory buffers ----------------------------------------------------===*) 460 461module MemoryBuffer = struct 462 external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file" 463 external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin" 464 external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose" 465end 466 467 468(*===-- Non-Externs -------------------------------------------------------===*) 469(* These functions are built using the externals, so must be declared late. *) 470 471let concat2 sep arr = 472 let s = ref "" in 473 if 0 < Array.length arr then begin 474 s := !s ^ arr.(0); 475 for i = 1 to (Array.length arr) - 1 do 476 s := !s ^ sep ^ arr.(i) 477 done 478 end; 479 !s 480 481let rec string_of_lltype ty = 482 (* FIXME: stop infinite recursion! :) *) 483 match classify_type ty with 484 TypeKind.Integer -> "i" ^ string_of_int (integer_bitwidth ty) 485 | TypeKind.Pointer -> (string_of_lltype (element_type ty)) ^ "*" 486 | TypeKind.Struct -> 487 let s = "{ " ^ (concat2 ", " ( 488 Array.map string_of_lltype (element_types ty) 489 )) ^ " }" in 490 if is_packed ty 491 then "<" ^ s ^ ">" 492 else s 493 | TypeKind.Array -> "[" ^ (string_of_int (array_length ty)) ^ 494 " x " ^ (string_of_lltype (element_type ty)) ^ "]" 495 | TypeKind.Vector -> "<" ^ (string_of_int (vector_size ty)) ^ 496 " x " ^ (string_of_lltype (element_type ty)) ^ ">" 497 | TypeKind.Opaque -> "opaque" 498 | TypeKind.Function -> string_of_lltype (return_type ty) ^ 499 " (" ^ (concat2 ", " ( 500 Array.map string_of_lltype (param_types ty) 501 )) ^ ")" 502 | TypeKind.Label -> "label" 503 | TypeKind.Ppc_fp128 -> "ppc_fp128" 504 | TypeKind.Fp128 -> "fp128" 505 | TypeKind.X86fp80 -> "x86_fp80" 506 | TypeKind.Double -> "double" 507 | TypeKind.Float -> "float" 508 | TypeKind.Void -> "void" 509