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