llvm.ml revision 705443ffd3f67018c1ec387014262566502a9ee3
1(*===-- llvm/llvm.ml - LLVM Ocaml Interface --------------------------------===* 2 * 3 * The LLVM Compiler Infrastructure 4 * 5 * This file is distributed under the University of Illinois Open Source 6 * License. See LICENSE.TXT for details. 7 * 8 *===----------------------------------------------------------------------===*) 9 10 11type llcontext 12type llmodule 13type lltype 14type lltypehandle 15type llvalue 16type lluse 17type llbasicblock 18type llbuilder 19type llmoduleprovider 20type llmemorybuffer 21 22module TypeKind = struct 23 type t = 24 | Void 25 | Float 26 | Double 27 | X86fp80 28 | Fp128 29 | Ppc_fp128 30 | Label 31 | Integer 32 | Function 33 | Struct 34 | Array 35 | Pointer 36 | Opaque 37 | Vector 38 | Metadata 39 | Union 40end 41 42module Linkage = struct 43 type t = 44 | External 45 | Available_externally 46 | Link_once 47 | Link_once_odr 48 | Weak 49 | Weak_odr 50 | Appending 51 | Internal 52 | Private 53 | Dllimport 54 | Dllexport 55 | External_weak 56 | Ghost 57 | Common 58 | Linker_private 59end 60 61module Visibility = struct 62 type t = 63 | Default 64 | Hidden 65 | Protected 66end 67 68module CallConv = struct 69 let c = 0 70 let fast = 8 71 let cold = 9 72 let x86_stdcall = 64 73 let x86_fastcall = 65 74end 75 76module Attribute = struct 77 type t = 78 | Zext 79 | Sext 80 | Noreturn 81 | Inreg 82 | Structret 83 | Nounwind 84 | Noalias 85 | Byval 86 | Nest 87 | Readnone 88 | Readonly 89 | Noinline 90 | Alwaysinline 91 | Optsize 92 | Ssp 93 | Sspreq 94 | Nocapture 95 | Noredzone 96 | Noimplicitfloat 97 | Naked 98 | Inlinehint 99end 100 101module Icmp = struct 102 type t = 103 | Eq 104 | Ne 105 | Ugt 106 | Uge 107 | Ult 108 | Ule 109 | Sgt 110 | Sge 111 | Slt 112 | Sle 113end 114 115module Fcmp = struct 116 type t = 117 | False 118 | Oeq 119 | Ogt 120 | Oge 121 | Olt 122 | Ole 123 | One 124 | Ord 125 | Uno 126 | Ueq 127 | Ugt 128 | Uge 129 | Ult 130 | Ule 131 | Une 132 | True 133end 134 135exception IoError of string 136 137external register_exns : exn -> unit = "llvm_register_core_exns" 138let _ = register_exns (IoError "") 139 140type ('a, 'b) llpos = 141| At_end of 'a 142| Before of 'b 143 144type ('a, 'b) llrev_pos = 145| At_start of 'a 146| After of 'b 147 148(*===-- Contexts ----------------------------------------------------------===*) 149external create_context : unit -> llcontext = "llvm_create_context" 150external dispose_context : llcontext -> unit = "llvm_dispose_context" 151external global_context : unit -> llcontext = "llvm_global_context" 152external mdkind_id : llcontext -> string -> int = "llvm_mdkind_id" 153 154(*===-- Modules -----------------------------------------------------------===*) 155external create_module : llcontext -> string -> llmodule = "llvm_create_module" 156external dispose_module : llmodule -> unit = "llvm_dispose_module" 157external target_triple: llmodule -> string 158 = "llvm_target_triple" 159external set_target_triple: string -> llmodule -> unit 160 = "llvm_set_target_triple" 161external data_layout: llmodule -> string 162 = "llvm_data_layout" 163external set_data_layout: string -> llmodule -> unit 164 = "llvm_set_data_layout" 165external define_type_name : string -> lltype -> llmodule -> bool 166 = "llvm_add_type_name" 167external delete_type_name : string -> llmodule -> unit 168 = "llvm_delete_type_name" 169external type_by_name : llmodule -> string -> lltype option 170 = "llvm_type_by_name" 171external dump_module : llmodule -> unit = "llvm_dump_module" 172 173(*===-- Types -------------------------------------------------------------===*) 174external classify_type : lltype -> TypeKind.t = "llvm_classify_type" 175external type_context : lltype -> llcontext = "llvm_type_context" 176 177(*--... Operations on integer types ........................................--*) 178external i1_type : llcontext -> lltype = "llvm_i1_type" 179external i8_type : llcontext -> lltype = "llvm_i8_type" 180external i16_type : llcontext -> lltype = "llvm_i16_type" 181external i32_type : llcontext -> lltype = "llvm_i32_type" 182external i64_type : llcontext -> lltype = "llvm_i64_type" 183 184external integer_type : llcontext -> int -> lltype = "llvm_integer_type" 185external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth" 186 187(*--... Operations on real types ...........................................--*) 188external float_type : llcontext -> lltype = "llvm_float_type" 189external double_type : llcontext -> lltype = "llvm_double_type" 190external x86fp80_type : llcontext -> lltype = "llvm_x86fp80_type" 191external fp128_type : llcontext -> lltype = "llvm_fp128_type" 192external ppc_fp128_type : llcontext -> lltype = "llvm_ppc_fp128_type" 193 194(*--... Operations on function types .......................................--*) 195external function_type : lltype -> lltype array -> lltype = "llvm_function_type" 196external var_arg_function_type : lltype -> lltype array -> lltype 197 = "llvm_var_arg_function_type" 198external is_var_arg : lltype -> bool = "llvm_is_var_arg" 199external return_type : lltype -> lltype = "LLVMGetReturnType" 200external param_types : lltype -> lltype array = "llvm_param_types" 201 202(*--... Operations on struct types .........................................--*) 203external struct_type : llcontext -> lltype array -> lltype = "llvm_struct_type" 204external packed_struct_type : llcontext -> lltype array -> lltype 205 = "llvm_packed_struct_type" 206external struct_element_types : lltype -> lltype array 207 = "llvm_struct_element_types" 208external is_packed : lltype -> bool = "llvm_is_packed" 209 210(*--... Operations on union types ..........................................--*) 211external union_type : llcontext -> lltype array -> lltype = "llvm_union_type" 212external union_element_types : lltype -> lltype array 213 = "llvm_union_element_types" 214 215(*--... Operations on pointer, vector, and array types .....................--*) 216external array_type : lltype -> int -> lltype = "llvm_array_type" 217external pointer_type : lltype -> lltype = "llvm_pointer_type" 218external qualified_pointer_type : lltype -> int -> lltype 219 = "llvm_qualified_pointer_type" 220external vector_type : lltype -> int -> lltype = "llvm_vector_type" 221 222external element_type : lltype -> lltype = "LLVMGetElementType" 223external array_length : lltype -> int = "llvm_array_length" 224external address_space : lltype -> int = "llvm_address_space" 225external vector_size : lltype -> int = "llvm_vector_size" 226 227(*--... Operations on other types ..........................................--*) 228external opaque_type : llcontext -> lltype = "llvm_opaque_type" 229external void_type : llcontext -> lltype = "llvm_void_type" 230external label_type : llcontext -> lltype = "llvm_label_type" 231 232(*--... Operations on type handles .........................................--*) 233external handle_to_type : lltype -> lltypehandle = "llvm_handle_to_type" 234external type_of_handle : lltypehandle -> lltype = "llvm_type_of_handle" 235external refine_type : lltype -> lltype -> unit = "llvm_refine_type" 236 237 238(*===-- Values ------------------------------------------------------------===*) 239external type_of : llvalue -> lltype = "llvm_type_of" 240external value_name : llvalue -> string = "llvm_value_name" 241external set_value_name : string -> llvalue -> unit = "llvm_set_value_name" 242external dump_value : llvalue -> unit = "llvm_dump_value" 243external replace_all_uses_with : llvalue -> llvalue -> unit 244 = "LLVMReplaceAllUsesWith" 245 246(*--... Operations on uses .................................................--*) 247external use_begin : llvalue -> lluse option = "llvm_use_begin" 248external use_succ : lluse -> lluse option = "llvm_use_succ" 249external user : lluse -> llvalue = "llvm_user" 250external used_value : lluse -> llvalue = "llvm_used_value" 251 252let iter_uses f v = 253 let rec aux = function 254 | None -> () 255 | Some u -> 256 f u; 257 aux (use_succ u) 258 in 259 aux (use_begin v) 260 261let fold_left_uses f init v = 262 let rec aux init u = 263 match u with 264 | None -> init 265 | Some u -> aux (f init u) (use_succ u) 266 in 267 aux init (use_begin v) 268 269let fold_right_uses f v init = 270 let rec aux u init = 271 match u with 272 | None -> init 273 | Some u -> f u (aux (use_succ u) init) 274 in 275 aux (use_begin v) init 276 277 278(*--... Operations on users ................................................--*) 279external operand : llvalue -> int -> llvalue = "llvm_operand" 280 281(*--... Operations on constants of (mostly) any type .......................--*) 282external is_constant : llvalue -> bool = "llvm_is_constant" 283external const_null : lltype -> llvalue = "LLVMConstNull" 284external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes" 285external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull" 286external undef : lltype -> llvalue = "LLVMGetUndef" 287external is_null : llvalue -> bool = "llvm_is_null" 288external is_undef : llvalue -> bool = "llvm_is_undef" 289 290(*--... Operations on instructions .........................................--*) 291external has_metadata : llvalue -> bool = "llvm_has_metadata" 292external metadata : llvalue -> int -> llvalue option = "llvm_metadata" 293external set_metadata : llvalue -> int -> llvalue -> unit = "llvm_set_metadata" 294external clear_metadata : llvalue -> int -> unit = "llvm_clear_metadata" 295 296(*--... Operations on metadata .......,.....................................--*) 297external mdstring : llcontext -> string -> llvalue = "llvm_mdstring" 298external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode" 299 300(*--... Operations on scalar constants .....................................--*) 301external const_int : lltype -> int -> llvalue = "llvm_const_int" 302external const_of_int64 : lltype -> Int64.t -> bool -> llvalue 303 = "llvm_const_of_int64" 304external const_int_of_string : lltype -> string -> int -> llvalue 305 = "llvm_const_int_of_string" 306external const_float : lltype -> float -> llvalue = "llvm_const_float" 307external const_float_of_string : lltype -> string -> llvalue 308 = "llvm_const_float_of_string" 309 310(*--... Operations on composite constants ..................................--*) 311external const_string : llcontext -> string -> llvalue = "llvm_const_string" 312external const_stringz : llcontext -> string -> llvalue = "llvm_const_stringz" 313external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array" 314external const_struct : llcontext -> llvalue array -> llvalue 315 = "llvm_const_struct" 316external const_packed_struct : llcontext -> llvalue array -> llvalue 317 = "llvm_const_packed_struct" 318external const_vector : llvalue array -> llvalue = "llvm_const_vector" 319external const_union : lltype -> llvalue -> llvalue = "LLVMConstUnion" 320 321(*--... Constant expressions ...............................................--*) 322external align_of : lltype -> llvalue = "LLVMAlignOf" 323external size_of : lltype -> llvalue = "LLVMSizeOf" 324external const_neg : llvalue -> llvalue = "LLVMConstNeg" 325external const_nsw_neg : llvalue -> llvalue = "LLVMConstNSWNeg" 326external const_nuw_neg : llvalue -> llvalue = "LLVMConstNUWNeg" 327external const_fneg : llvalue -> llvalue = "LLVMConstFNeg" 328external const_not : llvalue -> llvalue = "LLVMConstNot" 329external const_add : llvalue -> llvalue -> llvalue = "LLVMConstAdd" 330external const_nsw_add : llvalue -> llvalue -> llvalue = "LLVMConstNSWAdd" 331external const_nuw_add : llvalue -> llvalue -> llvalue = "LLVMConstNUWAdd" 332external const_fadd : llvalue -> llvalue -> llvalue = "LLVMConstFAdd" 333external const_sub : llvalue -> llvalue -> llvalue = "LLVMConstSub" 334external const_nsw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNSWSub" 335external const_nuw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNUWSub" 336external const_fsub : llvalue -> llvalue -> llvalue = "LLVMConstFSub" 337external const_mul : llvalue -> llvalue -> llvalue = "LLVMConstMul" 338external const_nsw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNSWMul" 339external const_nuw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNUWMul" 340external const_fmul : llvalue -> llvalue -> llvalue = "LLVMConstFMul" 341external const_udiv : llvalue -> llvalue -> llvalue = "LLVMConstUDiv" 342external const_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstSDiv" 343external const_exact_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstExactSDiv" 344external const_fdiv : llvalue -> llvalue -> llvalue = "LLVMConstFDiv" 345external const_urem : llvalue -> llvalue -> llvalue = "LLVMConstURem" 346external const_srem : llvalue -> llvalue -> llvalue = "LLVMConstSRem" 347external const_frem : llvalue -> llvalue -> llvalue = "LLVMConstFRem" 348external const_and : llvalue -> llvalue -> llvalue = "LLVMConstAnd" 349external const_or : llvalue -> llvalue -> llvalue = "LLVMConstOr" 350external const_xor : llvalue -> llvalue -> llvalue = "LLVMConstXor" 351external const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue 352 = "llvm_const_icmp" 353external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue 354 = "llvm_const_fcmp" 355external const_shl : llvalue -> llvalue -> llvalue = "LLVMConstShl" 356external const_lshr : llvalue -> llvalue -> llvalue = "LLVMConstLShr" 357external const_ashr : llvalue -> llvalue -> llvalue = "LLVMConstAShr" 358external const_gep : llvalue -> llvalue array -> llvalue = "llvm_const_gep" 359external const_in_bounds_gep : llvalue -> llvalue array -> llvalue 360 = "llvm_const_in_bounds_gep" 361external const_trunc : llvalue -> lltype -> llvalue = "LLVMConstTrunc" 362external const_sext : llvalue -> lltype -> llvalue = "LLVMConstSExt" 363external const_zext : llvalue -> lltype -> llvalue = "LLVMConstZExt" 364external const_fptrunc : llvalue -> lltype -> llvalue = "LLVMConstFPTrunc" 365external const_fpext : llvalue -> lltype -> llvalue = "LLVMConstFPExt" 366external const_uitofp : llvalue -> lltype -> llvalue = "LLVMConstUIToFP" 367external const_sitofp : llvalue -> lltype -> llvalue = "LLVMConstSIToFP" 368external const_fptoui : llvalue -> lltype -> llvalue = "LLVMConstFPToUI" 369external const_fptosi : llvalue -> lltype -> llvalue = "LLVMConstFPToSI" 370external const_ptrtoint : llvalue -> lltype -> llvalue = "LLVMConstPtrToInt" 371external const_inttoptr : llvalue -> lltype -> llvalue = "LLVMConstIntToPtr" 372external const_bitcast : llvalue -> lltype -> llvalue = "LLVMConstBitCast" 373external const_zext_or_bitcast : llvalue -> lltype -> llvalue 374 = "LLVMConstZExtOrBitCast" 375external const_sext_or_bitcast : llvalue -> lltype -> llvalue 376 = "LLVMConstSExtOrBitCast" 377external const_trunc_or_bitcast : llvalue -> lltype -> llvalue 378 = "LLVMConstTruncOrBitCast" 379external const_pointercast : llvalue -> lltype -> llvalue 380 = "LLVMConstPointerCast" 381external const_intcast : llvalue -> lltype -> llvalue = "LLVMConstIntCast" 382external const_fpcast : llvalue -> lltype -> llvalue = "LLVMConstFPCast" 383external const_select : llvalue -> llvalue -> llvalue -> llvalue 384 = "LLVMConstSelect" 385external const_extractelement : llvalue -> llvalue -> llvalue 386 = "LLVMConstExtractElement" 387external const_insertelement : llvalue -> llvalue -> llvalue -> llvalue 388 = "LLVMConstInsertElement" 389external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue 390 = "LLVMConstShuffleVector" 391external const_extractvalue : llvalue -> int array -> llvalue 392 = "llvm_const_extractvalue" 393external const_insertvalue : llvalue -> llvalue -> int array -> llvalue 394 = "llvm_const_insertvalue" 395external const_inline_asm : lltype -> string -> string -> bool -> bool -> 396 llvalue 397 = "llvm_const_inline_asm" 398external block_address : llvalue -> llbasicblock -> llvalue = "LLVMBlockAddress" 399 400(*--... Operations on global variables, functions, and aliases (globals) ...--*) 401external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent" 402external is_declaration : llvalue -> bool = "llvm_is_declaration" 403external linkage : llvalue -> Linkage.t = "llvm_linkage" 404external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage" 405external section : llvalue -> string = "llvm_section" 406external set_section : string -> llvalue -> unit = "llvm_set_section" 407external visibility : llvalue -> Visibility.t = "llvm_visibility" 408external set_visibility : Visibility.t -> llvalue -> unit = "llvm_set_visibility" 409external alignment : llvalue -> int = "llvm_alignment" 410external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" 411external is_global_constant : llvalue -> bool = "llvm_is_global_constant" 412external set_global_constant : bool -> llvalue -> unit 413 = "llvm_set_global_constant" 414 415(*--... Operations on global variables .....................................--*) 416external declare_global : lltype -> string -> llmodule -> llvalue 417 = "llvm_declare_global" 418external declare_qualified_global : lltype -> string -> int -> llmodule -> 419 llvalue 420 = "llvm_declare_qualified_global" 421external define_global : string -> llvalue -> llmodule -> llvalue 422 = "llvm_define_global" 423external define_qualified_global : string -> llvalue -> int -> llmodule -> 424 llvalue 425 = "llvm_define_qualified_global" 426external lookup_global : string -> llmodule -> llvalue option 427 = "llvm_lookup_global" 428external delete_global : llvalue -> unit = "llvm_delete_global" 429external global_initializer : llvalue -> llvalue = "LLVMGetInitializer" 430external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer" 431external remove_initializer : llvalue -> unit = "llvm_remove_initializer" 432external is_thread_local : llvalue -> bool = "llvm_is_thread_local" 433external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local" 434external global_begin : llmodule -> (llmodule, llvalue) llpos 435 = "llvm_global_begin" 436external global_succ : llvalue -> (llmodule, llvalue) llpos 437 = "llvm_global_succ" 438external global_end : llmodule -> (llmodule, llvalue) llrev_pos 439 = "llvm_global_end" 440external global_pred : llvalue -> (llmodule, llvalue) llrev_pos 441 = "llvm_global_pred" 442 443let rec iter_global_range f i e = 444 if i = e then () else 445 match i with 446 | At_end _ -> raise (Invalid_argument "Invalid global variable range.") 447 | Before bb -> 448 f bb; 449 iter_global_range f (global_succ bb) e 450 451let iter_globals f m = 452 iter_global_range f (global_begin m) (At_end m) 453 454let rec fold_left_global_range f init i e = 455 if i = e then init else 456 match i with 457 | At_end _ -> raise (Invalid_argument "Invalid global variable range.") 458 | Before bb -> fold_left_global_range f (f init bb) (global_succ bb) e 459 460let fold_left_globals f init m = 461 fold_left_global_range f init (global_begin m) (At_end m) 462 463let rec rev_iter_global_range f i e = 464 if i = e then () else 465 match i with 466 | At_start _ -> raise (Invalid_argument "Invalid global variable range.") 467 | After bb -> 468 f bb; 469 rev_iter_global_range f (global_pred bb) e 470 471let rev_iter_globals f m = 472 rev_iter_global_range f (global_end m) (At_start m) 473 474let rec fold_right_global_range f i e init = 475 if i = e then init else 476 match i with 477 | At_start _ -> raise (Invalid_argument "Invalid global variable range.") 478 | After bb -> fold_right_global_range f (global_pred bb) e (f bb init) 479 480let fold_right_globals f m init = 481 fold_right_global_range f (global_end m) (At_start m) init 482 483(*--... Operations on aliases ..............................................--*) 484external add_alias : llmodule -> lltype -> llvalue -> string -> llvalue 485 = "llvm_add_alias" 486 487(*--... Operations on functions ............................................--*) 488external declare_function : string -> lltype -> llmodule -> llvalue 489 = "llvm_declare_function" 490external define_function : string -> lltype -> llmodule -> llvalue 491 = "llvm_define_function" 492external lookup_function : string -> llmodule -> llvalue option 493 = "llvm_lookup_function" 494external delete_function : llvalue -> unit = "llvm_delete_function" 495external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic" 496external function_call_conv : llvalue -> int = "llvm_function_call_conv" 497external set_function_call_conv : int -> llvalue -> unit 498 = "llvm_set_function_call_conv" 499external gc : llvalue -> string option = "llvm_gc" 500external set_gc : string option -> llvalue -> unit = "llvm_set_gc" 501external function_begin : llmodule -> (llmodule, llvalue) llpos 502 = "llvm_function_begin" 503external function_succ : llvalue -> (llmodule, llvalue) llpos 504 = "llvm_function_succ" 505external function_end : llmodule -> (llmodule, llvalue) llrev_pos 506 = "llvm_function_end" 507external function_pred : llvalue -> (llmodule, llvalue) llrev_pos 508 = "llvm_function_pred" 509 510let rec iter_function_range f i e = 511 if i = e then () else 512 match i with 513 | At_end _ -> raise (Invalid_argument "Invalid function range.") 514 | Before fn -> 515 f fn; 516 iter_function_range f (function_succ fn) e 517 518let iter_functions f m = 519 iter_function_range f (function_begin m) (At_end m) 520 521let rec fold_left_function_range f init i e = 522 if i = e then init else 523 match i with 524 | At_end _ -> raise (Invalid_argument "Invalid function range.") 525 | Before fn -> fold_left_function_range f (f init fn) (function_succ fn) e 526 527let fold_left_functions f init m = 528 fold_left_function_range f init (function_begin m) (At_end m) 529 530let rec rev_iter_function_range f i e = 531 if i = e then () else 532 match i with 533 | At_start _ -> raise (Invalid_argument "Invalid function range.") 534 | After fn -> 535 f fn; 536 rev_iter_function_range f (function_pred fn) e 537 538let rev_iter_functions f m = 539 rev_iter_function_range f (function_end m) (At_start m) 540 541let rec fold_right_function_range f i e init = 542 if i = e then init else 543 match i with 544 | At_start _ -> raise (Invalid_argument "Invalid function range.") 545 | After fn -> fold_right_function_range f (function_pred fn) e (f fn init) 546 547let fold_right_functions f m init = 548 fold_right_function_range f (function_end m) (At_start m) init 549 550external add_function_attr : llvalue -> Attribute.t -> unit 551 = "llvm_add_function_attr" 552external remove_function_attr : llvalue -> Attribute.t -> unit 553 = "llvm_remove_function_attr" 554 555(*--... Operations on params ...............................................--*) 556external params : llvalue -> llvalue array = "llvm_params" 557external param : llvalue -> int -> llvalue = "llvm_param" 558external param_parent : llvalue -> llvalue = "LLVMGetParamParent" 559external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin" 560external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ" 561external param_end : llvalue -> (llvalue, llvalue) llrev_pos = "llvm_param_end" 562external param_pred : llvalue -> (llvalue, llvalue) llrev_pos ="llvm_param_pred" 563 564let rec iter_param_range f i e = 565 if i = e then () else 566 match i with 567 | At_end _ -> raise (Invalid_argument "Invalid parameter range.") 568 | Before p -> 569 f p; 570 iter_param_range f (param_succ p) e 571 572let iter_params f fn = 573 iter_param_range f (param_begin fn) (At_end fn) 574 575let rec fold_left_param_range f init i e = 576 if i = e then init else 577 match i with 578 | At_end _ -> raise (Invalid_argument "Invalid parameter range.") 579 | Before p -> fold_left_param_range f (f init p) (param_succ p) e 580 581let fold_left_params f init fn = 582 fold_left_param_range f init (param_begin fn) (At_end fn) 583 584let rec rev_iter_param_range f i e = 585 if i = e then () else 586 match i with 587 | At_start _ -> raise (Invalid_argument "Invalid parameter range.") 588 | After p -> 589 f p; 590 rev_iter_param_range f (param_pred p) e 591 592let rev_iter_params f fn = 593 rev_iter_param_range f (param_end fn) (At_start fn) 594 595let rec fold_right_param_range f init i e = 596 if i = e then init else 597 match i with 598 | At_start _ -> raise (Invalid_argument "Invalid parameter range.") 599 | After p -> fold_right_param_range f (f p init) (param_pred p) e 600 601let fold_right_params f fn init = 602 fold_right_param_range f init (param_end fn) (At_start fn) 603 604external add_param_attr : llvalue -> Attribute.t -> unit 605 = "llvm_add_param_attr" 606external remove_param_attr : llvalue -> Attribute.t -> unit 607 = "llvm_remove_param_attr" 608external set_param_alignment : llvalue -> int -> unit 609 = "llvm_set_param_alignment" 610 611(*--... Operations on basic blocks .........................................--*) 612external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" 613external value_is_block : llvalue -> bool = "llvm_value_is_block" 614external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" 615external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent" 616external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks" 617external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock" 618external delete_block : llbasicblock -> unit = "llvm_delete_block" 619external append_block : llcontext -> string -> llvalue -> llbasicblock 620 = "llvm_append_block" 621external insert_block : llcontext -> string -> llbasicblock -> llbasicblock 622 = "llvm_insert_block" 623external block_begin : llvalue -> (llvalue, llbasicblock) llpos 624 = "llvm_block_begin" 625external block_succ : llbasicblock -> (llvalue, llbasicblock) llpos 626 = "llvm_block_succ" 627external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos 628 = "llvm_block_end" 629external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos 630 = "llvm_block_pred" 631 632let rec iter_block_range f i e = 633 if i = e then () else 634 match i with 635 | At_end _ -> raise (Invalid_argument "Invalid block range.") 636 | Before bb -> 637 f bb; 638 iter_block_range f (block_succ bb) e 639 640let iter_blocks f fn = 641 iter_block_range f (block_begin fn) (At_end fn) 642 643let rec fold_left_block_range f init i e = 644 if i = e then init else 645 match i with 646 | At_end _ -> raise (Invalid_argument "Invalid block range.") 647 | Before bb -> fold_left_block_range f (f init bb) (block_succ bb) e 648 649let fold_left_blocks f init fn = 650 fold_left_block_range f init (block_begin fn) (At_end fn) 651 652let rec rev_iter_block_range f i e = 653 if i = e then () else 654 match i with 655 | At_start _ -> raise (Invalid_argument "Invalid block range.") 656 | After bb -> 657 f bb; 658 rev_iter_block_range f (block_pred bb) e 659 660let rev_iter_blocks f fn = 661 rev_iter_block_range f (block_end fn) (At_start fn) 662 663let rec fold_right_block_range f init i e = 664 if i = e then init else 665 match i with 666 | At_start _ -> raise (Invalid_argument "Invalid block range.") 667 | After bb -> fold_right_block_range f (f bb init) (block_pred bb) e 668 669let fold_right_blocks f fn init = 670 fold_right_block_range f init (block_end fn) (At_start fn) 671 672(*--... Operations on instructions .........................................--*) 673external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" 674external instr_begin : llbasicblock -> (llbasicblock, llvalue) llpos 675 = "llvm_instr_begin" 676external instr_succ : llvalue -> (llbasicblock, llvalue) llpos 677 = "llvm_instr_succ" 678external instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos 679 = "llvm_instr_end" 680external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos 681 = "llvm_instr_pred" 682 683let rec iter_instrs_range f i e = 684 if i = e then () else 685 match i with 686 | At_end _ -> raise (Invalid_argument "Invalid instruction range.") 687 | Before i -> 688 f i; 689 iter_instrs_range f (instr_succ i) e 690 691let iter_instrs f bb = 692 iter_instrs_range f (instr_begin bb) (At_end bb) 693 694let rec fold_left_instrs_range f init i e = 695 if i = e then init else 696 match i with 697 | At_end _ -> raise (Invalid_argument "Invalid instruction range.") 698 | Before i -> fold_left_instrs_range f (f init i) (instr_succ i) e 699 700let fold_left_instrs f init bb = 701 fold_left_instrs_range f init (instr_begin bb) (At_end bb) 702 703let rec rev_iter_instrs_range f i e = 704 if i = e then () else 705 match i with 706 | At_start _ -> raise (Invalid_argument "Invalid instruction range.") 707 | After i -> 708 f i; 709 rev_iter_instrs_range f (instr_pred i) e 710 711let rev_iter_instrs f bb = 712 rev_iter_instrs_range f (instr_end bb) (At_start bb) 713 714let rec fold_right_instr_range f i e init = 715 if i = e then init else 716 match i with 717 | At_start _ -> raise (Invalid_argument "Invalid instruction range.") 718 | After i -> fold_right_instr_range f (instr_pred i) e (f i init) 719 720let fold_right_instrs f bb init = 721 fold_right_instr_range f (instr_end bb) (At_start bb) init 722 723 724(*--... Operations on call sites ...........................................--*) 725external instruction_call_conv: llvalue -> int 726 = "llvm_instruction_call_conv" 727external set_instruction_call_conv: int -> llvalue -> unit 728 = "llvm_set_instruction_call_conv" 729external add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit 730 = "llvm_add_instruction_param_attr" 731external remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit 732 = "llvm_remove_instruction_param_attr" 733 734(*--... Operations on call instructions (only) .............................--*) 735external is_tail_call : llvalue -> bool = "llvm_is_tail_call" 736external set_tail_call : bool -> llvalue -> unit = "llvm_set_tail_call" 737 738(*--... Operations on phi nodes ............................................--*) 739external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit 740 = "llvm_add_incoming" 741external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" 742 743 744(*===-- Instruction builders ----------------------------------------------===*) 745external builder : llcontext -> llbuilder = "llvm_builder" 746external position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit 747 = "llvm_position_builder" 748external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block" 749external insert_into_builder : llvalue -> string -> llbuilder -> unit 750 = "llvm_insert_into_builder" 751 752let builder_at context ip = 753 let b = builder context in 754 position_builder ip b; 755 b 756 757let builder_before context i = builder_at context (Before i) 758let builder_at_end context bb = builder_at context (At_end bb) 759 760let position_before i = position_builder (Before i) 761let position_at_end bb = position_builder (At_end bb) 762 763 764(*--... Metadata ...........................................................--*) 765external set_current_debug_location : llbuilder -> llvalue -> unit 766 = "llvm_set_current_debug_location" 767external clear_current_debug_location : llbuilder -> unit 768 = "llvm_clear_current_debug_location" 769external current_debug_location : llbuilder -> llvalue option 770 = "llvm_current_debug_location" 771external set_inst_debug_location : llbuilder -> llvalue -> unit 772 = "llvm_set_inst_debug_location" 773 774 775(*--... Terminators ........................................................--*) 776external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void" 777external build_ret : llvalue -> llbuilder -> llvalue = "llvm_build_ret" 778external build_aggregate_ret : llvalue array -> llbuilder -> llvalue 779 = "llvm_build_aggregate_ret" 780external build_br : llbasicblock -> llbuilder -> llvalue = "llvm_build_br" 781external build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder -> 782 llvalue = "llvm_build_cond_br" 783external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue 784 = "llvm_build_switch" 785external add_case : llvalue -> llvalue -> llbasicblock -> unit 786 = "llvm_add_case" 787external build_indirect_br : llvalue -> int -> llbuilder -> llvalue 788 = "llvm_build_indirect_br" 789external add_destination : llvalue -> llbasicblock -> unit 790 = "llvm_add_destination" 791external build_invoke : llvalue -> llvalue array -> llbasicblock -> 792 llbasicblock -> string -> llbuilder -> llvalue 793 = "llvm_build_invoke_bc" "llvm_build_invoke_nat" 794external build_unwind : llbuilder -> llvalue = "llvm_build_unwind" 795external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable" 796 797(*--... Arithmetic .........................................................--*) 798external build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 799 = "llvm_build_add" 800external build_nsw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 801 = "llvm_build_nsw_add" 802external build_nuw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 803 = "llvm_build_nuw_add" 804external build_fadd : llvalue -> llvalue -> string -> llbuilder -> llvalue 805 = "llvm_build_fadd" 806external build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 807 = "llvm_build_sub" 808external build_nsw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 809 = "llvm_build_nsw_sub" 810external build_nuw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 811 = "llvm_build_nuw_sub" 812external build_fsub : llvalue -> llvalue -> string -> llbuilder -> llvalue 813 = "llvm_build_fsub" 814external build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 815 = "llvm_build_mul" 816external build_nsw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 817 = "llvm_build_nsw_mul" 818external build_nuw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 819 = "llvm_build_nuw_mul" 820external build_fmul : llvalue -> llvalue -> string -> llbuilder -> llvalue 821 = "llvm_build_fmul" 822external build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 823 = "llvm_build_udiv" 824external build_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 825 = "llvm_build_sdiv" 826external build_exact_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 827 = "llvm_build_exact_sdiv" 828external build_fdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 829 = "llvm_build_fdiv" 830external build_urem : llvalue -> llvalue -> string -> llbuilder -> llvalue 831 = "llvm_build_urem" 832external build_srem : llvalue -> llvalue -> string -> llbuilder -> llvalue 833 = "llvm_build_srem" 834external build_frem : llvalue -> llvalue -> string -> llbuilder -> llvalue 835 = "llvm_build_frem" 836external build_shl : llvalue -> llvalue -> string -> llbuilder -> llvalue 837 = "llvm_build_shl" 838external build_lshr : llvalue -> llvalue -> string -> llbuilder -> llvalue 839 = "llvm_build_lshr" 840external build_ashr : llvalue -> llvalue -> string -> llbuilder -> llvalue 841 = "llvm_build_ashr" 842external build_and : llvalue -> llvalue -> string -> llbuilder -> llvalue 843 = "llvm_build_and" 844external build_or : llvalue -> llvalue -> string -> llbuilder -> llvalue 845 = "llvm_build_or" 846external build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue 847 = "llvm_build_xor" 848external build_neg : llvalue -> string -> llbuilder -> llvalue 849 = "llvm_build_neg" 850external build_nsw_neg : llvalue -> string -> llbuilder -> llvalue 851 = "llvm_build_nsw_neg" 852external build_nuw_neg : llvalue -> string -> llbuilder -> llvalue 853 = "llvm_build_nuw_neg" 854external build_fneg : llvalue -> string -> llbuilder -> llvalue 855 = "llvm_build_fneg" 856external build_not : llvalue -> string -> llbuilder -> llvalue 857 = "llvm_build_not" 858 859(*--... Memory .............................................................--*) 860external build_alloca : lltype -> string -> llbuilder -> llvalue 861 = "llvm_build_alloca" 862external build_array_alloca : lltype -> llvalue -> string -> llbuilder -> 863 llvalue = "llvm_build_array_alloca" 864external build_load : llvalue -> string -> llbuilder -> llvalue 865 = "llvm_build_load" 866external build_store : llvalue -> llvalue -> llbuilder -> llvalue 867 = "llvm_build_store" 868external build_gep : llvalue -> llvalue array -> string -> llbuilder -> llvalue 869 = "llvm_build_gep" 870external build_in_bounds_gep : llvalue -> llvalue array -> string -> 871 llbuilder -> llvalue = "llvm_build_in_bounds_gep" 872external build_struct_gep : llvalue -> int -> string -> llbuilder -> llvalue 873 = "llvm_build_struct_gep" 874 875external build_global_string : string -> string -> llbuilder -> llvalue 876 = "llvm_build_global_string" 877external build_global_stringptr : string -> string -> llbuilder -> llvalue 878 = "llvm_build_global_stringptr" 879 880(*--... Casts ..............................................................--*) 881external build_trunc : llvalue -> lltype -> string -> llbuilder -> llvalue 882 = "llvm_build_trunc" 883external build_zext : llvalue -> lltype -> string -> llbuilder -> llvalue 884 = "llvm_build_zext" 885external build_sext : llvalue -> lltype -> string -> llbuilder -> llvalue 886 = "llvm_build_sext" 887external build_fptoui : llvalue -> lltype -> string -> llbuilder -> llvalue 888 = "llvm_build_fptoui" 889external build_fptosi : llvalue -> lltype -> string -> llbuilder -> llvalue 890 = "llvm_build_fptosi" 891external build_uitofp : llvalue -> lltype -> string -> llbuilder -> llvalue 892 = "llvm_build_uitofp" 893external build_sitofp : llvalue -> lltype -> string -> llbuilder -> llvalue 894 = "llvm_build_sitofp" 895external build_fptrunc : llvalue -> lltype -> string -> llbuilder -> llvalue 896 = "llvm_build_fptrunc" 897external build_fpext : llvalue -> lltype -> string -> llbuilder -> llvalue 898 = "llvm_build_fpext" 899external build_ptrtoint : llvalue -> lltype -> string -> llbuilder -> llvalue 900 = "llvm_build_prttoint" 901external build_inttoptr : llvalue -> lltype -> string -> llbuilder -> llvalue 902 = "llvm_build_inttoptr" 903external build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue 904 = "llvm_build_bitcast" 905external build_zext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 906 llvalue = "llvm_build_zext_or_bitcast" 907external build_sext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 908 llvalue = "llvm_build_sext_or_bitcast" 909external build_trunc_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 910 llvalue = "llvm_build_trunc_or_bitcast" 911external build_pointercast : llvalue -> lltype -> string -> llbuilder -> llvalue 912 = "llvm_build_pointercast" 913external build_intcast : llvalue -> lltype -> string -> llbuilder -> llvalue 914 = "llvm_build_intcast" 915external build_fpcast : llvalue -> lltype -> string -> llbuilder -> llvalue 916 = "llvm_build_fpcast" 917 918(*--... Comparisons ........................................................--*) 919external build_icmp : Icmp.t -> llvalue -> llvalue -> string -> 920 llbuilder -> llvalue = "llvm_build_icmp" 921external build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> 922 llbuilder -> llvalue = "llvm_build_fcmp" 923 924(*--... Miscellaneous instructions .........................................--*) 925external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder -> 926 llvalue = "llvm_build_phi" 927external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue 928 = "llvm_build_call" 929external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder -> 930 llvalue = "llvm_build_select" 931external build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue 932 = "llvm_build_va_arg" 933external build_extractelement : llvalue -> llvalue -> string -> llbuilder -> 934 llvalue = "llvm_build_extractelement" 935external build_insertelement : llvalue -> llvalue -> llvalue -> string -> 936 llbuilder -> llvalue = "llvm_build_insertelement" 937external build_shufflevector : llvalue -> llvalue -> llvalue -> string -> 938 llbuilder -> llvalue = "llvm_build_shufflevector" 939external build_extractvalue : llvalue -> int -> string -> llbuilder -> llvalue 940 = "llvm_build_extractvalue" 941external build_insertvalue : llvalue -> llvalue -> int -> string -> llbuilder -> 942 llvalue = "llvm_build_insertvalue" 943 944external build_is_null : llvalue -> string -> llbuilder -> llvalue 945 = "llvm_build_is_null" 946external build_is_not_null : llvalue -> string -> llbuilder -> llvalue 947 = "llvm_build_is_not_null" 948external build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue 949 = "llvm_build_ptrdiff" 950 951(*===-- Module providers --------------------------------------------------===*) 952 953module ModuleProvider = struct 954 external create : llmodule -> llmoduleprovider 955 = "LLVMCreateModuleProviderForExistingModule" 956 external dispose : llmoduleprovider -> unit = "llvm_dispose_module_provider" 957end 958 959 960(*===-- Memory buffers ----------------------------------------------------===*) 961 962module MemoryBuffer = struct 963 external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file" 964 external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin" 965 external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose" 966end 967 968 969(*===-- Pass Manager ------------------------------------------------------===*) 970 971module PassManager = struct 972 type 'a t 973 type any = [ `Module | `Function ] 974 external create : unit -> [ `Module ] t = "llvm_passmanager_create" 975 external create_function : llmoduleprovider -> [ `Function ] t 976 = "LLVMCreateFunctionPassManager" 977 external run_module : llmodule -> [ `Module ] t -> bool 978 = "llvm_passmanager_run_module" 979 external initialize : [ `Function ] t -> bool = "llvm_passmanager_initialize" 980 external run_function : llvalue -> [ `Function ] t -> bool 981 = "llvm_passmanager_run_function" 982 external finalize : [ `Function ] t -> bool = "llvm_passmanager_finalize" 983 external dispose : [< any ] t -> unit = "llvm_passmanager_dispose" 984end 985 986 987(*===-- Non-Externs -------------------------------------------------------===*) 988(* These functions are built using the externals, so must be declared late. *) 989 990let concat2 sep arr = 991 let s = ref "" in 992 if 0 < Array.length arr then begin 993 s := !s ^ arr.(0); 994 for i = 1 to (Array.length arr) - 1 do 995 s := !s ^ sep ^ arr.(i) 996 done 997 end; 998 !s 999 1000let rec string_of_lltype ty = 1001 (* FIXME: stop infinite recursion! :) *) 1002 match classify_type ty with 1003 TypeKind.Integer -> "i" ^ string_of_int (integer_bitwidth ty) 1004 | TypeKind.Pointer -> (string_of_lltype (element_type ty)) ^ "*" 1005 | TypeKind.Struct -> 1006 let s = "{ " ^ (concat2 ", " ( 1007 Array.map string_of_lltype (struct_element_types ty) 1008 )) ^ " }" in 1009 if is_packed ty 1010 then "<" ^ s ^ ">" 1011 else s 1012 | TypeKind.Union -> "union { " ^ (concat2 ", " ( 1013 Array.map string_of_lltype (union_element_types ty) 1014 )) ^ " }" 1015 | TypeKind.Array -> "[" ^ (string_of_int (array_length ty)) ^ 1016 " x " ^ (string_of_lltype (element_type ty)) ^ "]" 1017 | TypeKind.Vector -> "<" ^ (string_of_int (vector_size ty)) ^ 1018 " x " ^ (string_of_lltype (element_type ty)) ^ ">" 1019 | TypeKind.Opaque -> "opaque" 1020 | TypeKind.Function -> string_of_lltype (return_type ty) ^ 1021 " (" ^ (concat2 ", " ( 1022 Array.map string_of_lltype (param_types ty) 1023 )) ^ ")" 1024 | TypeKind.Label -> "label" 1025 | TypeKind.Ppc_fp128 -> "ppc_fp128" 1026 | TypeKind.Fp128 -> "fp128" 1027 | TypeKind.X86fp80 -> "x86_fp80" 1028 | TypeKind.Double -> "double" 1029 | TypeKind.Float -> "float" 1030 | TypeKind.Void -> "void" 1031 | TypeKind.Metadata -> "metadata" 1032