llvm.ml revision 033d778249e59548c495f39166a53fa80f48eb91
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 llmodule 12type lltype 13type lltypehandle 14type llvalue 15type llbasicblock 16type llbuilder 17type llmoduleprovider 18type llmemorybuffer 19 20module TypeKind = struct 21 type t = 22 | Void 23 | Float 24 | Double 25 | X86fp80 26 | Fp128 27 | Ppc_fp128 28 | Label 29 | Integer 30 | Function 31 | Struct 32 | Array 33 | Pointer 34 | Opaque 35 | Vector 36end 37 38module Linkage = struct 39 type t = 40 | External 41 | Link_once 42 | Weak 43 | Appending 44 | Internal 45 | Dllimport 46 | Dllexport 47 | External_weak 48 | Ghost 49end 50 51module Visibility = struct 52 type t = 53 | Default 54 | Hidden 55 | Protected 56end 57 58module CallConv = struct 59 let c = 0 60 let fast = 8 61 let cold = 9 62 let x86_stdcall = 64 63 let x86_fastcall = 65 64end 65 66module Icmp = struct 67 type t = 68 | Eq 69 | Ne 70 | Ugt 71 | Uge 72 | Ult 73 | Ule 74 | Sgt 75 | Sge 76 | Slt 77 | Sle 78end 79 80module Fcmp = struct 81 type t = 82 | False 83 | Oeq 84 | Ogt 85 | Oge 86 | Olt 87 | Ole 88 | One 89 | Ord 90 | Uno 91 | Ueq 92 | Ugt 93 | Uge 94 | Ult 95 | Ule 96 | Une 97 | True 98end 99 100exception IoError of string 101 102external register_exns : exn -> unit = "llvm_register_core_exns" 103let _ = register_exns (IoError "") 104 105type ('a, 'b) llpos = 106| At_end of 'a 107| Before of 'b 108 109type ('a, 'b) llrev_pos = 110| At_start of 'a 111| After of 'b 112 113 114(*===-- Modules -----------------------------------------------------------===*) 115 116external create_module : string -> llmodule = "llvm_create_module" 117external dispose_module : llmodule -> unit = "llvm_dispose_module" 118external target_triple: llmodule -> string 119 = "llvm_target_triple" 120external set_target_triple: string -> llmodule -> unit 121 = "llvm_set_target_triple" 122external data_layout: llmodule -> string 123 = "llvm_data_layout" 124external set_data_layout: string -> llmodule -> unit 125 = "llvm_set_data_layout" 126external define_type_name : string -> lltype -> llmodule -> bool 127 = "llvm_add_type_name" 128external delete_type_name : string -> llmodule -> unit 129 = "llvm_delete_type_name" 130external dump_module : llmodule -> unit = "llvm_dump_module" 131 132(*===-- Types -------------------------------------------------------------===*) 133 134external classify_type : lltype -> TypeKind.t = "llvm_classify_type" 135 136(*--... Operations on integer types ........................................--*) 137external _i1_type : unit -> lltype = "llvm_i1_type" 138external _i8_type : unit -> lltype = "llvm_i8_type" 139external _i16_type : unit -> lltype = "llvm_i16_type" 140external _i32_type : unit -> lltype = "llvm_i32_type" 141external _i64_type : unit -> lltype = "llvm_i64_type" 142 143let i1_type = _i1_type () 144let i8_type = _i8_type () 145let i16_type = _i16_type () 146let i32_type = _i32_type () 147let i64_type = _i64_type () 148 149external integer_type : int -> lltype = "llvm_integer_type" 150external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth" 151 152(*--... Operations on real types ...........................................--*) 153external _float_type : unit -> lltype = "llvm_float_type" 154external _double_type : unit -> lltype = "llvm_double_type" 155external _x86fp80_type : unit -> lltype = "llvm_x86fp80_type" 156external _fp128_type : unit -> lltype = "llvm_fp128_type" 157external _ppc_fp128_type : unit -> lltype = "llvm_ppc_fp128_type" 158 159let float_type = _float_type () 160let double_type = _double_type () 161let x86fp80_type = _x86fp80_type () 162let fp128_type = _fp128_type () 163let ppc_fp128_type = _ppc_fp128_type () 164 165(*--... Operations on function types .......................................--*) 166external function_type : lltype -> lltype array -> lltype = "llvm_function_type" 167external var_arg_function_type : lltype -> lltype array -> lltype 168 = "llvm_var_arg_function_type" 169external is_var_arg : lltype -> bool = "llvm_is_var_arg" 170external return_type : lltype -> lltype = "LLVMGetReturnType" 171external param_types : lltype -> lltype array = "llvm_param_types" 172 173(*--... Operations on struct types .........................................--*) 174external struct_type : lltype array -> lltype = "llvm_struct_type" 175external packed_struct_type : lltype array -> lltype = "llvm_packed_struct_type" 176external element_types : lltype -> lltype array = "llvm_element_types" 177external is_packed : lltype -> bool = "llvm_is_packed" 178 179(*--... Operations on pointer, vector, and array types .....................--*) 180external array_type : lltype -> int -> lltype = "llvm_array_type" 181external pointer_type : lltype -> lltype = "llvm_pointer_type" 182external qualified_pointer_type : lltype -> int -> lltype 183 = "llvm_qualified_pointer_type" 184external vector_type : lltype -> int -> lltype = "llvm_vector_type" 185 186external element_type : lltype -> lltype = "LLVMGetElementType" 187external array_length : lltype -> int = "llvm_array_length" 188external address_space : lltype -> int = "llvm_address_space" 189external vector_size : lltype -> int = "llvm_vector_size" 190 191(*--... Operations on other types ..........................................--*) 192external opaque_type : unit -> lltype = "llvm_opaque_type" 193external _void_type : unit -> lltype = "llvm_void_type" 194external _label_type : unit -> lltype = "llvm_label_type" 195 196let void_type = _void_type () 197let label_type = _label_type () 198 199(*--... Operations on type handles .........................................--*) 200external handle_to_type : lltype -> lltypehandle = "llvm_handle_to_type" 201external type_of_handle : lltypehandle -> lltype = "llvm_type_of_handle" 202external refine_type : lltype -> lltype -> unit = "llvm_refine_type" 203 204 205(*===-- Values ------------------------------------------------------------===*) 206 207external type_of : llvalue -> lltype = "llvm_type_of" 208external value_name : llvalue -> string = "llvm_value_name" 209external set_value_name : string -> llvalue -> unit = "llvm_set_value_name" 210external dump_value : llvalue -> unit = "llvm_dump_value" 211 212(*--... Operations on constants of (mostly) any type .......................--*) 213external is_constant : llvalue -> bool = "llvm_is_constant" 214external const_null : lltype -> llvalue = "LLVMConstNull" 215external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes" 216external undef : lltype -> llvalue = "LLVMGetUndef" 217external is_null : llvalue -> bool = "llvm_is_null" 218external is_undef : llvalue -> bool = "llvm_is_undef" 219 220(*--... Operations on scalar constants .....................................--*) 221external const_int : lltype -> int -> llvalue = "llvm_const_int" 222external const_of_int64 : lltype -> Int64.t -> bool -> llvalue 223 = "llvm_const_of_int64" 224external const_float : lltype -> float -> llvalue = "llvm_const_float" 225 226(*--... Operations on composite constants ..................................--*) 227external const_string : string -> llvalue = "llvm_const_string" 228external const_stringz : string -> llvalue = "llvm_const_stringz" 229external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array" 230external const_struct : llvalue array -> llvalue = "llvm_const_struct" 231external const_packed_struct : llvalue array -> llvalue 232 = "llvm_const_packed_struct" 233external const_vector : llvalue array -> llvalue = "llvm_const_vector" 234 235(*--... Constant expressions ...............................................--*) 236external size_of : lltype -> llvalue = "LLVMSizeOf" 237external const_neg : llvalue -> llvalue = "LLVMConstNeg" 238external const_not : llvalue -> llvalue = "LLVMConstNot" 239external const_add : llvalue -> llvalue -> llvalue = "LLVMConstAdd" 240external const_sub : llvalue -> llvalue -> llvalue = "LLVMConstSub" 241external const_mul : llvalue -> llvalue -> llvalue = "LLVMConstMul" 242external const_udiv : llvalue -> llvalue -> llvalue = "LLVMConstUDiv" 243external const_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstSDiv" 244external const_fdiv : llvalue -> llvalue -> llvalue = "LLVMConstFDiv" 245external const_urem : llvalue -> llvalue -> llvalue = "LLVMConstURem" 246external const_srem : llvalue -> llvalue -> llvalue = "LLVMConstSRem" 247external const_frem : llvalue -> llvalue -> llvalue = "LLVMConstFRem" 248external const_and : llvalue -> llvalue -> llvalue = "LLVMConstAnd" 249external const_or : llvalue -> llvalue -> llvalue = "LLVMConstOr" 250external const_xor : llvalue -> llvalue -> llvalue = "LLVMConstXor" 251external const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue 252 = "llvm_const_icmp" 253external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue 254 = "llvm_const_fcmp" 255external const_shl : llvalue -> llvalue -> llvalue = "LLVMConstShl" 256external const_lshr : llvalue -> llvalue -> llvalue = "LLVMConstLShr" 257external const_ashr : llvalue -> llvalue -> llvalue = "LLVMConstAShr" 258external const_gep : llvalue -> llvalue array -> llvalue = "llvm_const_gep" 259external const_trunc : llvalue -> lltype -> llvalue = "LLVMConstTrunc" 260external const_sext : llvalue -> lltype -> llvalue = "LLVMConstSExt" 261external const_zext : llvalue -> lltype -> llvalue = "LLVMConstZExt" 262external const_fptrunc : llvalue -> lltype -> llvalue = "LLVMConstFPTrunc" 263external const_fpext : llvalue -> lltype -> llvalue = "LLVMConstFPExt" 264external const_uitofp : llvalue -> lltype -> llvalue = "LLVMConstUIToFP" 265external const_sitofp : llvalue -> lltype -> llvalue = "LLVMConstSIToFP" 266external const_fptoui : llvalue -> lltype -> llvalue = "LLVMConstFPToUI" 267external const_fptosi : llvalue -> lltype -> llvalue = "LLVMConstFPToSI" 268external const_ptrtoint : llvalue -> lltype -> llvalue = "LLVMConstPtrToInt" 269external const_inttoptr : llvalue -> lltype -> llvalue = "LLVMConstIntToPtr" 270external const_bitcast : llvalue -> lltype -> llvalue = "LLVMConstBitCast" 271external const_select : llvalue -> llvalue -> llvalue -> llvalue 272 = "LLVMConstSelect" 273external const_extractelement : llvalue -> llvalue -> llvalue 274 = "LLVMConstExtractElement" 275external const_insertelement : llvalue -> llvalue -> llvalue -> llvalue 276 = "LLVMConstInsertElement" 277external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue 278 = "LLVMConstShuffleVector" 279 280(*--... Operations on global variables, functions, and aliases (globals) ...--*) 281external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent" 282external is_declaration : llvalue -> bool = "llvm_is_declaration" 283external linkage : llvalue -> Linkage.t = "llvm_linkage" 284external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage" 285external section : llvalue -> string = "llvm_section" 286external set_section : string -> llvalue -> unit = "llvm_set_section" 287external visibility : llvalue -> Visibility.t = "llvm_visibility" 288external set_visibility : Visibility.t -> llvalue -> unit = "llvm_set_visibility" 289external alignment : llvalue -> int = "llvm_alignment" 290external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" 291external is_global_constant : llvalue -> bool = "llvm_is_global_constant" 292external set_global_constant : bool -> llvalue -> unit 293 = "llvm_set_global_constant" 294 295(*--... Operations on global variables .....................................--*) 296external declare_global : lltype -> string -> llmodule -> llvalue 297 = "llvm_declare_global" 298external define_global : string -> llvalue -> llmodule -> llvalue 299 = "llvm_define_global" 300external lookup_global : string -> llmodule -> llvalue option 301 = "llvm_lookup_global" 302external delete_global : llvalue -> unit = "llvm_delete_global" 303external has_initializer : llvalue -> bool = "llvm_has_initializer" 304external global_initializer : llvalue -> llvalue = "LLVMGetInitializer" 305external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer" 306external remove_initializer : llvalue -> unit = "llvm_remove_initializer" 307external is_thread_local : llvalue -> bool = "llvm_is_thread_local" 308external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local" 309external global_begin : llmodule -> (llmodule, llvalue) llpos 310 = "llvm_global_begin" 311external global_succ : llvalue -> (llmodule, llvalue) llpos 312 = "llvm_global_succ" 313external global_end : llmodule -> (llmodule, llvalue) llrev_pos 314 = "llvm_global_end" 315external global_pred : llvalue -> (llmodule, llvalue) llrev_pos 316 = "llvm_global_pred" 317 318let rec iter_global_range f i e = 319 if i = e then () else 320 match i with 321 | At_end _ -> raise (Invalid_argument "Invalid global variable range.") 322 | Before bb -> 323 f bb; 324 iter_global_range f (global_succ bb) e 325 326let iter_globals f m = 327 iter_global_range f (global_begin m) (At_end m) 328 329let rec fold_left_global_range f init i e = 330 if i = e then init else 331 match i with 332 | At_end _ -> raise (Invalid_argument "Invalid global variable range.") 333 | Before bb -> fold_left_global_range f (f init bb) (global_succ bb) e 334 335let fold_left_globals f init m = 336 fold_left_global_range f init (global_begin m) (At_end m) 337 338let rec rev_iter_global_range f i e = 339 if i = e then () else 340 match i with 341 | At_start _ -> raise (Invalid_argument "Invalid global variable range.") 342 | After bb -> 343 f bb; 344 rev_iter_global_range f (global_pred bb) e 345 346let rev_iter_globals f m = 347 rev_iter_global_range f (global_end m) (At_start m) 348 349let rec fold_right_global_range f i e init = 350 if i = e then init else 351 match i with 352 | At_start _ -> raise (Invalid_argument "Invalid global variable range.") 353 | After bb -> fold_right_global_range f (global_pred bb) e (f bb init) 354 355let fold_right_globals f m init = 356 fold_right_global_range f (global_end m) (At_start m) init 357 358(*--... Operations on functions ............................................--*) 359external declare_function : string -> lltype -> llmodule -> llvalue 360 = "llvm_declare_function" 361external define_function : string -> lltype -> llmodule -> llvalue 362 = "llvm_define_function" 363external lookup_function : string -> llmodule -> llvalue option 364 = "llvm_lookup_function" 365external delete_function : llvalue -> unit = "llvm_delete_function" 366external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic" 367external function_call_conv : llvalue -> int = "llvm_function_call_conv" 368external set_function_call_conv : int -> llvalue -> unit 369 = "llvm_set_function_call_conv" 370external collector : llvalue -> string option = "llvm_collector" 371external set_collector : string option -> llvalue -> unit = "llvm_set_collector" 372external function_begin : llmodule -> (llmodule, llvalue) llpos 373 = "llvm_function_begin" 374external function_succ : llvalue -> (llmodule, llvalue) llpos 375 = "llvm_function_succ" 376external function_end : llmodule -> (llmodule, llvalue) llrev_pos 377 = "llvm_function_end" 378external function_pred : llvalue -> (llmodule, llvalue) llrev_pos 379 = "llvm_function_pred" 380 381let rec iter_function_range f i e = 382 if i = e then () else 383 match i with 384 | At_end _ -> raise (Invalid_argument "Invalid function range.") 385 | Before fn -> 386 f fn; 387 iter_function_range f (function_succ fn) e 388 389let iter_functions f m = 390 iter_function_range f (function_begin m) (At_end m) 391 392let rec fold_left_function_range f init i e = 393 if i = e then init else 394 match i with 395 | At_end _ -> raise (Invalid_argument "Invalid function range.") 396 | Before fn -> fold_left_function_range f (f init fn) (function_succ fn) e 397 398let fold_left_functions f init m = 399 fold_left_function_range f init (function_begin m) (At_end m) 400 401let rec rev_iter_function_range f i e = 402 if i = e then () else 403 match i with 404 | At_start _ -> raise (Invalid_argument "Invalid function range.") 405 | After fn -> 406 f fn; 407 rev_iter_function_range f (function_pred fn) e 408 409let rev_iter_functions f m = 410 rev_iter_function_range f (function_end m) (At_start m) 411 412let rec fold_right_function_range f i e init = 413 if i = e then init else 414 match i with 415 | At_start _ -> raise (Invalid_argument "Invalid function range.") 416 | After fn -> fold_right_function_range f (function_pred fn) e (f fn init) 417 418let fold_right_functions f m init = 419 fold_right_function_range f (function_end m) (At_start m) init 420 421(* TODO: param attrs *) 422 423(*--... Operations on params ...............................................--*) 424external params : llvalue -> llvalue array = "llvm_params" 425external param : llvalue -> int -> llvalue = "llvm_param" 426external param_parent : llvalue -> llvalue = "LLVMGetParamParent" 427external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin" 428external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ" 429external param_end : llvalue -> (llvalue, llvalue) llrev_pos = "llvm_param_end" 430external param_pred : llvalue -> (llvalue, llvalue) llrev_pos ="llvm_param_pred" 431 432let rec iter_param_range f i e = 433 if i = e then () else 434 match i with 435 | At_end _ -> raise (Invalid_argument "Invalid parameter range.") 436 | Before p -> 437 f p; 438 iter_param_range f (param_succ p) e 439 440let iter_params f fn = 441 iter_param_range f (param_begin fn) (At_end fn) 442 443let rec fold_left_param_range f init i e = 444 if i = e then init else 445 match i with 446 | At_end _ -> raise (Invalid_argument "Invalid parameter range.") 447 | Before p -> fold_left_param_range f (f init p) (param_succ p) e 448 449let fold_left_params f init fn = 450 fold_left_param_range f init (param_begin fn) (At_end fn) 451 452let rec rev_iter_param_range f i e = 453 if i = e then () else 454 match i with 455 | At_start _ -> raise (Invalid_argument "Invalid parameter range.") 456 | After p -> 457 f p; 458 rev_iter_param_range f (param_pred p) e 459 460let rev_iter_params f fn = 461 rev_iter_param_range f (param_end fn) (At_start fn) 462 463let rec fold_right_param_range f init i e = 464 if i = e then init else 465 match i with 466 | At_start _ -> raise (Invalid_argument "Invalid parameter range.") 467 | After p -> fold_right_param_range f (f p init) (param_pred p) e 468 469let fold_right_params f fn init = 470 fold_right_param_range f init (param_end fn) (At_start fn) 471 472(*--... Operations on basic blocks .........................................--*) 473external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" 474external value_is_block : llvalue -> bool = "llvm_value_is_block" 475external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" 476external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent" 477external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks" 478external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock" 479external delete_block : llbasicblock -> unit = "llvm_delete_block" 480external append_block : string -> llvalue -> llbasicblock = "llvm_append_block" 481external insert_block : string -> llbasicblock -> llbasicblock 482 = "llvm_insert_block" 483external block_begin : llvalue -> (llvalue, llbasicblock) llpos 484 = "llvm_block_begin" 485external block_succ : llbasicblock -> (llvalue, llbasicblock) llpos 486 = "llvm_block_succ" 487external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos 488 = "llvm_block_end" 489external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos 490 = "llvm_block_pred" 491 492let rec iter_block_range f i e = 493 if i = e then () else 494 match i with 495 | At_end _ -> raise (Invalid_argument "Invalid block range.") 496 | Before bb -> 497 f bb; 498 iter_block_range f (block_succ bb) e 499 500let iter_blocks f fn = 501 iter_block_range f (block_begin fn) (At_end fn) 502 503let rec fold_left_block_range f init i e = 504 if i = e then init else 505 match i with 506 | At_end _ -> raise (Invalid_argument "Invalid block range.") 507 | Before bb -> fold_left_block_range f (f init bb) (block_succ bb) e 508 509let fold_left_blocks f init fn = 510 fold_left_block_range f init (block_begin fn) (At_end fn) 511 512let rec rev_iter_block_range f i e = 513 if i = e then () else 514 match i with 515 | At_start _ -> raise (Invalid_argument "Invalid block range.") 516 | After bb -> 517 f bb; 518 rev_iter_block_range f (block_pred bb) e 519 520let rev_iter_blocks f fn = 521 rev_iter_block_range f (block_end fn) (At_start fn) 522 523let rec fold_right_block_range f init i e = 524 if i = e then init else 525 match i with 526 | At_start _ -> raise (Invalid_argument "Invalid block range.") 527 | After bb -> fold_right_block_range f (f bb init) (block_pred bb) e 528 529let fold_right_blocks f fn init = 530 fold_right_block_range f init (block_end fn) (At_start fn) 531 532(*--... Operations on instructions .........................................--*) 533external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" 534external instr_begin : llbasicblock -> (llbasicblock, llvalue) llpos 535 = "llvm_instr_begin" 536external instr_succ : llvalue -> (llbasicblock, llvalue) llpos 537 = "llvm_instr_succ" 538external instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos 539 = "llvm_instr_end" 540external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos 541 = "llvm_instr_pred" 542 543let rec iter_instrs_range f i e = 544 if i = e then () else 545 match i with 546 | At_end _ -> raise (Invalid_argument "Invalid instruction range.") 547 | Before i -> 548 f i; 549 iter_instrs_range f (instr_succ i) e 550 551let iter_instrs f bb = 552 iter_instrs_range f (instr_begin bb) (At_end bb) 553 554let rec fold_left_instrs_range f init i e = 555 if i = e then init else 556 match i with 557 | At_end _ -> raise (Invalid_argument "Invalid instruction range.") 558 | Before i -> fold_left_instrs_range f (f init i) (instr_succ i) e 559 560let fold_left_instrs f init bb = 561 fold_left_instrs_range f init (instr_begin bb) (At_end bb) 562 563let rec rev_iter_instrs_range f i e = 564 if i = e then () else 565 match i with 566 | At_start _ -> raise (Invalid_argument "Invalid instruction range.") 567 | After i -> 568 f i; 569 rev_iter_instrs_range f (instr_pred i) e 570 571let rev_iter_instrs f bb = 572 rev_iter_instrs_range f (instr_end bb) (At_start bb) 573 574let rec fold_right_instr_range f i e init = 575 if i = e then init else 576 match i with 577 | At_start _ -> raise (Invalid_argument "Invalid instruction range.") 578 | After i -> fold_right_instr_range f (instr_pred i) e (f i init) 579 580let fold_right_instrs f bb init = 581 fold_right_instr_range f (instr_end bb) (At_start bb) init 582 583 584(*--... Operations on call sites ...........................................--*) 585external instruction_call_conv: llvalue -> int 586 = "llvm_instruction_call_conv" 587external set_instruction_call_conv: int -> llvalue -> unit 588 = "llvm_set_instruction_call_conv" 589 590(*--... Operations on phi nodes ............................................--*) 591external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit 592 = "llvm_add_incoming" 593external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" 594 595 596(*===-- Instruction builders ----------------------------------------------===*) 597external builder : unit -> llbuilder = "llvm_builder" 598external position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit 599 = "llvm_position_builder" 600external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block" 601 602let builder_at ip = 603 let b = builder () in 604 position_builder ip b; 605 b 606 607let builder_before i = builder_at (Before i) 608let builder_at_end bb = builder_at (At_end bb) 609 610let position_before i = position_builder (Before i) 611let position_at_end bb = position_builder (At_end bb) 612 613 614(*--... Terminators ........................................................--*) 615external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void" 616external build_ret : llvalue -> llbuilder -> llvalue = "llvm_build_ret" 617external build_br : llbasicblock -> llbuilder -> llvalue = "llvm_build_br" 618external build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder -> 619 llvalue = "llvm_build_cond_br" 620external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue 621 = "llvm_build_switch" 622external build_invoke : llvalue -> llvalue array -> llbasicblock -> 623 llbasicblock -> string -> llbuilder -> llvalue 624 = "llvm_build_invoke_bc" "llvm_build_invoke_nat" 625external build_unwind : llbuilder -> llvalue = "llvm_build_unwind" 626external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable" 627 628(*--... Arithmetic .........................................................--*) 629external build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 630 = "llvm_build_add" 631external build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 632 = "llvm_build_sub" 633external build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 634 = "llvm_build_mul" 635external build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 636 = "llvm_build_udiv" 637external build_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 638 = "llvm_build_sdiv" 639external build_fdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 640 = "llvm_build_fdiv" 641external build_urem : llvalue -> llvalue -> string -> llbuilder -> llvalue 642 = "llvm_build_urem" 643external build_srem : llvalue -> llvalue -> string -> llbuilder -> llvalue 644 = "llvm_build_srem" 645external build_frem : llvalue -> llvalue -> string -> llbuilder -> llvalue 646 = "llvm_build_frem" 647external build_shl : llvalue -> llvalue -> string -> llbuilder -> llvalue 648 = "llvm_build_shl" 649external build_lshr : llvalue -> llvalue -> string -> llbuilder -> llvalue 650 = "llvm_build_lshr" 651external build_ashr : llvalue -> llvalue -> string -> llbuilder -> llvalue 652 = "llvm_build_ashr" 653external build_and : llvalue -> llvalue -> string -> llbuilder -> llvalue 654 = "llvm_build_and" 655external build_or : llvalue -> llvalue -> string -> llbuilder -> llvalue 656 = "llvm_build_or" 657external build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue 658 = "llvm_build_xor" 659external build_neg : llvalue -> string -> llbuilder -> llvalue 660 = "llvm_build_neg" 661external build_not : llvalue -> string -> llbuilder -> llvalue 662 = "llvm_build_not" 663 664(*--... Memory .............................................................--*) 665external build_malloc : lltype -> string -> llbuilder -> llvalue 666 = "llvm_build_malloc" 667external build_array_malloc : lltype -> llvalue -> string -> llbuilder -> 668 llvalue = "llvm_build_array_malloc" 669external build_alloca : lltype -> string -> llbuilder -> llvalue 670 = "llvm_build_alloca" 671external build_array_alloca : lltype -> llvalue -> string -> llbuilder -> 672 llvalue = "llvm_build_array_alloca" 673external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free" 674external build_load : llvalue -> string -> llbuilder -> llvalue 675 = "llvm_build_load" 676external build_store : llvalue -> llvalue -> llbuilder -> llvalue 677 = "llvm_build_store" 678external build_gep : llvalue -> llvalue array -> string -> llbuilder -> llvalue 679 = "llvm_build_gep" 680 681(*--... Casts ..............................................................--*) 682external build_trunc : llvalue -> lltype -> string -> llbuilder -> llvalue 683 = "llvm_build_trunc" 684external build_zext : llvalue -> lltype -> string -> llbuilder -> llvalue 685 = "llvm_build_zext" 686external build_sext : llvalue -> lltype -> string -> llbuilder -> llvalue 687 = "llvm_build_sext" 688external build_fptoui : llvalue -> lltype -> string -> llbuilder -> llvalue 689 = "llvm_build_fptoui" 690external build_fptosi : llvalue -> lltype -> string -> llbuilder -> llvalue 691 = "llvm_build_fptosi" 692external build_uitofp : llvalue -> lltype -> string -> llbuilder -> llvalue 693 = "llvm_build_uitofp" 694external build_sitofp : llvalue -> lltype -> string -> llbuilder -> llvalue 695 = "llvm_build_sitofp" 696external build_fptrunc : llvalue -> lltype -> string -> llbuilder -> llvalue 697 = "llvm_build_fptrunc" 698external build_fpext : llvalue -> lltype -> string -> llbuilder -> llvalue 699 = "llvm_build_fpext" 700external build_ptrtoint : llvalue -> lltype -> string -> llbuilder -> llvalue 701 = "llvm_build_prttoint" 702external build_inttoptr : llvalue -> lltype -> string -> llbuilder -> llvalue 703 = "llvm_build_inttoptr" 704external build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue 705 = "llvm_build_bitcast" 706 707(*--... Comparisons ........................................................--*) 708external build_icmp : Icmp.t -> llvalue -> llvalue -> string -> 709 llbuilder -> llvalue = "llvm_build_icmp" 710external build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> 711 llbuilder -> llvalue = "llvm_build_fcmp" 712 713(*--... Miscellaneous instructions .........................................--*) 714external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder -> 715 llvalue = "llvm_build_phi" 716external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue 717 = "llvm_build_call" 718external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder -> 719 llvalue = "llvm_build_select" 720external build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue 721 = "llvm_build_va_arg" 722external build_extractelement : llvalue -> llvalue -> string -> llbuilder -> 723 llvalue = "llvm_build_extractelement" 724external build_insertelement : llvalue -> llvalue -> llvalue -> string -> 725 llbuilder -> llvalue = "llvm_build_insertelement" 726external build_shufflevector : llvalue -> llvalue -> llvalue -> string -> 727 llbuilder -> llvalue = "llvm_build_shufflevector" 728 729 730(*===-- Module providers --------------------------------------------------===*) 731 732module ModuleProvider = struct 733 external create : llmodule -> llmoduleprovider 734 = "LLVMCreateModuleProviderForExistingModule" 735 external dispose : llmoduleprovider -> unit = "llvm_dispose_module_provider" 736end 737 738 739(*===-- Memory buffers ----------------------------------------------------===*) 740 741module MemoryBuffer = struct 742 external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file" 743 external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin" 744 external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose" 745end 746 747 748(*===-- Pass Manager ------------------------------------------------------===*) 749 750module PassManager = struct 751 type 'a t 752 type any = [ `Module | `Function ] 753 external create : unit -> [ `Module ] t = "llvm_passmanager_create" 754 external create_function : llmoduleprovider -> [ `Function ] t 755 = "LLVMCreateFunctionPassManager" 756 external run_module : llmodule -> [ `Module ] t -> bool 757 = "llvm_passmanager_run_module" 758 external initialize : [ `Function ] t -> bool = "llvm_passmanager_initialize" 759 external run_function : llvalue -> [ `Function ] t -> bool 760 = "llvm_passmanager_run_function" 761 external finalize : [ `Function ] t -> bool = "llvm_passmanager_finalize" 762 external dispose : [< any ] t -> unit = "llvm_passmanager_dispose" 763end 764 765 766(*===-- Non-Externs -------------------------------------------------------===*) 767(* These functions are built using the externals, so must be declared late. *) 768 769let concat2 sep arr = 770 let s = ref "" in 771 if 0 < Array.length arr then begin 772 s := !s ^ arr.(0); 773 for i = 1 to (Array.length arr) - 1 do 774 s := !s ^ sep ^ arr.(i) 775 done 776 end; 777 !s 778 779let rec string_of_lltype ty = 780 (* FIXME: stop infinite recursion! :) *) 781 match classify_type ty with 782 TypeKind.Integer -> "i" ^ string_of_int (integer_bitwidth ty) 783 | TypeKind.Pointer -> (string_of_lltype (element_type ty)) ^ "*" 784 | TypeKind.Struct -> 785 let s = "{ " ^ (concat2 ", " ( 786 Array.map string_of_lltype (element_types ty) 787 )) ^ " }" in 788 if is_packed ty 789 then "<" ^ s ^ ">" 790 else s 791 | TypeKind.Array -> "[" ^ (string_of_int (array_length ty)) ^ 792 " x " ^ (string_of_lltype (element_type ty)) ^ "]" 793 | TypeKind.Vector -> "<" ^ (string_of_int (vector_size ty)) ^ 794 " x " ^ (string_of_lltype (element_type ty)) ^ ">" 795 | TypeKind.Opaque -> "opaque" 796 | TypeKind.Function -> string_of_lltype (return_type ty) ^ 797 " (" ^ (concat2 ", " ( 798 Array.map string_of_lltype (param_types ty) 799 )) ^ ")" 800 | TypeKind.Label -> "label" 801 | TypeKind.Ppc_fp128 -> "ppc_fp128" 802 | TypeKind.Fp128 -> "fp128" 803 | TypeKind.X86fp80 -> "x86_fp80" 804 | TypeKind.Double -> "double" 805 | TypeKind.Float -> "float" 806 | TypeKind.Void -> "void" 807