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