bindings/ocaml/llvm/llvm.ml

   1 (*===-- llvm/llvm.ml - LLVM OCaml Interface -------------------------------===*
   2  *
   3  * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
   4  * See https://llvm.org/LICENSE.txt for license information.
   5  * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
   6  *
   7  *===----------------------------------------------------------------------===*)
   8
   9
  10 type llcontext
  11 type llmodule
  12 type lltype
  13 type llvalue
  14 type lluse
  15 type llbasicblock
  16 type llbuilder
  17 type llattrkind
  18 type llattribute
  19 type llmemorybuffer
  20 type llmdkind
  21
  22 exception FeatureDisabled of string
  23
  24 let () = Callback.register_exception "Llvm.FeatureDisabled" (FeatureDisabled "")
  25
  26 module TypeKind = struct
  27   type t =
  28   | Void
  29   | Half
  30   | Float
  31   | Double
  32   | X86fp80
  33   | Fp128
  34   | Ppc_fp128
  35   | Label
  36   | Integer
  37   | Function
  38   | Struct
  39   | Array
  40   | Pointer
  41   | Vector
  42   | Metadata
  43   | X86_mmx
  44   | Token
  45 end
  46
  47 module Linkage = struct
  48   type t =
  49   | External
  50   | Available_externally
  51   | Link_once
  52   | Link_once_odr
  53   | Link_once_odr_auto_hide
  54   | Weak
  55   | Weak_odr
  56   | Appending
  57   | Internal
  58   | Private
  59   | Dllimport
  60   | Dllexport
  61   | External_weak
  62   | Ghost
  63   | Common
  64   | Linker_private
  65   | Linker_private_weak
  66 end
  67
  68 module Visibility = struct
  69   type t =
  70   | Default
  71   | Hidden
  72   | Protected
  73 end
  74
  75 module DLLStorageClass = struct
  76   type t =
  77   | Default
  78   | DLLImport
  79   | DLLExport
  80 end
  81
  82 module CallConv = struct
  83   let c = 0
  84   let fast = 8
  85   let cold = 9
  86   let x86_stdcall = 64
  87   let x86_fastcall = 65
  88 end
  89
  90 module AttrRepr = struct
  91   type t =
  92   | Enum of llattrkind * int64
  93   | String of string * string
  94 end
  95
  96 module AttrIndex = struct
  97   type t =
  98   | Function
  99   | Return
 100   | Param of int
 101
 102   let to_int index =
 103     match index with
 104     | Function -> -1
 105     | Return -> 0
 106     | Param(n) -> 1 + n
 107 end
 108
 109 module Attribute = struct
 110   type t =
 111   | Zext
 112   | Sext
 113   | Noreturn
 114   | Inreg
 115   | Structret
 116   | Nounwind
 117   | Noalias
 118   | Byval
 119   | Nest
 120   | Readnone
 121   | Readonly
 122   | Noinline
 123   | Alwaysinline
 124   | Optsize
 125   | Ssp
 126   | Sspreq
 127   | Alignment of int
 128   | Nocapture
 129   | Noredzone
 130   | Noimplicitfloat
 131   | Naked
 132   | Inlinehint
 133   | Stackalignment of int
 134   | ReturnsTwice
 135   | UWTable
 136   | NonLazyBind
 137 end
 138
 139 module Icmp = struct
 140   type t =
 141   | Eq
 142   | Ne
 143   | Ugt
 144   | Uge
 145   | Ult
 146   | Ule
 147   | Sgt
 148   | Sge
 149   | Slt
 150   | Sle
 151 end
 152
 153 module Fcmp = struct
 154   type t =
 155   | False
 156   | Oeq
 157   | Ogt
 158   | Oge
 159   | Olt
 160   | Ole
 161   | One
 162   | Ord
 163   | Uno
 164   | Ueq
 165   | Ugt
 166   | Uge
 167   | Ult
 168   | Ule
 169   | Une
 170   | True
 171 end
 172
 173 module Opcode  = struct
 174   type t =
 175   | Invalid (* not an instruction *)
 176   (* Terminator Instructions *)
 177   | Ret
 178   | Br
 179   | Switch
 180   | IndirectBr
 181   | Invoke
 182   | Invalid2
 183   | Unreachable
 184   (* Standard Binary Operators *)
 185   | Add
 186   | FAdd
 187   | Sub
 188   | FSub
 189   | Mul
 190   | FMul
 191   | UDiv
 192   | SDiv
 193   | FDiv
 194   | URem
 195   | SRem
 196   | FRem
 197   (* Logical Operators *)
 198   | Shl
 199   | LShr
 200   | AShr
 201   | And
 202   | Or
 203   | Xor
 204   (* Memory Operators *)
 205   | Alloca
 206   | Load
 207   | Store
 208   | GetElementPtr
 209   (* Cast Operators *)
 210   | Trunc
 211   | ZExt
 212   | SExt
 213   | FPToUI
 214   | FPToSI
 215   | UIToFP
 216   | SIToFP
 217   | FPTrunc
 218   | FPExt
 219   | PtrToInt
 220   | IntToPtr
 221   | BitCast
 222   (* Other Operators *)
 223   | ICmp
 224   | FCmp
 225   | PHI
 226   | Call
 227   | Select
 228   | UserOp1
 229   | UserOp2
 230   | VAArg
 231   | ExtractElement
 232   | InsertElement
 233   | ShuffleVector
 234   | ExtractValue
 235   | InsertValue
 236   | Fence
 237   | AtomicCmpXchg
 238   | AtomicRMW
 239   | Resume
 240   | LandingPad
 241   | AddrSpaceCast
 242   | CleanupRet
 243   | CatchRet
 244   | CatchPad
 245   | CleanupPad
 246   | CatchSwitch
 247   | FNeg
 248   | CallBr
 249 end
 250
 251 module LandingPadClauseTy = struct
 252   type t =
 253   | Catch
 254   | Filter
 255 end
 256
 257 module ThreadLocalMode = struct
 258   type t =
 259   | None
 260   | GeneralDynamic
 261   | LocalDynamic
 262   | InitialExec
 263   | LocalExec
 264 end
 265
 266 module AtomicOrdering = struct
 267   type t =
 268   | NotAtomic
 269   | Unordered
 270   | Monotonic
 271   | Invalid
 272   | Acquire
 273   | Release
 274   | AcqiureRelease
 275   | SequentiallyConsistent
 276 end
 277
 278 module AtomicRMWBinOp = struct
 279   type t =
 280   | Xchg
 281   | Add
 282   | Sub
 283   | And
 284   | Nand
 285   | Or
 286   | Xor
 287   | Max
 288   | Min
 289   | UMax
 290   | UMin
 291 end
 292
 293 module ValueKind = struct
 294   type t =
 295   | NullValue
 296   | Argument
 297   | BasicBlock
 298   | InlineAsm
 299   | MDNode
 300   | MDString
 301   | BlockAddress
 302   | ConstantAggregateZero
 303   | ConstantArray
 304   | ConstantDataArray
 305   | ConstantDataVector
 306   | ConstantExpr
 307   | ConstantFP
 308   | ConstantInt
 309   | ConstantPointerNull
 310   | ConstantStruct
 311   | ConstantVector
 312   | Function
 313   | GlobalAlias
 314   | GlobalIFunc
 315   | GlobalVariable
 316   | UndefValue
 317   | Instruction of Opcode.t
 318 end
 319
 320 module DiagnosticSeverity = struct
 321   type t =
 322   | Error
 323   | Warning
 324   | Remark
 325   | Note
 326 end
 327
 328 exception IoError of string
 329
 330 let () = Callback.register_exception "Llvm.IoError" (IoError "")
 331
 332 external install_fatal_error_handler : (string -> unit) -> unit
 333                                      = "llvm_install_fatal_error_handler"
 334 external reset_fatal_error_handler : unit -> unit
 335                                    = "llvm_reset_fatal_error_handler"
 336 external enable_pretty_stacktrace : unit -> unit
 337                                   = "llvm_enable_pretty_stacktrace"
 338 external parse_command_line_options : ?overview:string -> string array -> unit
 339                                     = "llvm_parse_command_line_options"
 340
 341 type ('a, 'b) llpos =
 342 | At_end of 'a
 343 | Before of 'b
 344
 345 type ('a, 'b) llrev_pos =
 346 | At_start of 'a
 347 | After of 'b
 348
 349
 350 (*===-- Context error handling --------------------------------------------===*)
 351 module Diagnostic = struct
 352   type t
 353
 354   external description : t -> string = "llvm_get_diagnostic_description"
 355   external severity : t -> DiagnosticSeverity.t
 356                     = "llvm_get_diagnostic_severity"
 357 end
 358
 359 external set_diagnostic_handler
 360   : llcontext -> (Diagnostic.t -> unit) option -> unit
 361   = "llvm_set_diagnostic_handler"
 362
 363 (*===-- Contexts ----------------------------------------------------------===*)
 364 external create_context : unit -> llcontext = "llvm_create_context"
 365 external dispose_context : llcontext -> unit = "llvm_dispose_context"
 366 external global_context : unit -> llcontext = "llvm_global_context"
 367 external mdkind_id : llcontext -> string -> llmdkind = "llvm_mdkind_id"
 368
 369 (*===-- Attributes --------------------------------------------------------===*)
 370 exception UnknownAttribute of string
 371
 372 let () = Callback.register_exception "Llvm.UnknownAttribute"
 373                                      (UnknownAttribute "")
 374
 375 external enum_attr_kind : string -> llattrkind = "llvm_enum_attr_kind"
 376 external llvm_create_enum_attr : llcontext -> llattrkind -> int64 ->
 377                                  llattribute
 378                                = "llvm_create_enum_attr_by_kind"
 379 external is_enum_attr : llattribute -> bool = "llvm_is_enum_attr"
 380 external get_enum_attr_kind : llattribute -> llattrkind
 381                             = "llvm_get_enum_attr_kind"
 382 external get_enum_attr_value : llattribute -> int64
 383                              = "llvm_get_enum_attr_value"
 384 external llvm_create_string_attr : llcontext -> string -> string ->
 385                                    llattribute
 386                                  = "llvm_create_string_attr"
 387 external is_string_attr : llattribute -> bool = "llvm_is_string_attr"
 388 external get_string_attr_kind : llattribute -> string
 389                               = "llvm_get_string_attr_kind"
 390 external get_string_attr_value : llattribute -> string
 391                                = "llvm_get_string_attr_value"
 392
 393 let create_enum_attr context name value =
 394   llvm_create_enum_attr context (enum_attr_kind name) value
 395 let create_string_attr context kind value =
 396   llvm_create_string_attr context kind value
 397
 398 let attr_of_repr context repr =
 399   match repr with
 400   | AttrRepr.Enum(kind, value) -> llvm_create_enum_attr context kind value
 401   | AttrRepr.String(key, value) -> llvm_create_string_attr context key value
 402
 403 let repr_of_attr attr =
 404   if is_enum_attr attr then
 405     AttrRepr.Enum(get_enum_attr_kind attr, get_enum_attr_value attr)
 406   else if is_string_attr attr then
 407     AttrRepr.String(get_string_attr_kind attr, get_string_attr_value attr)
 408   else assert false
 409
 410 (*===-- Modules -----------------------------------------------------------===*)
 411 external create_module : llcontext -> string -> llmodule = "llvm_create_module"
 412 external dispose_module : llmodule -> unit = "llvm_dispose_module"
 413 external target_triple: llmodule -> string
 414                       = "llvm_target_triple"
 415 external set_target_triple: string -> llmodule -> unit
 416                           = "llvm_set_target_triple"
 417 external data_layout: llmodule -> string
 418                     = "llvm_data_layout"
 419 external set_data_layout: string -> llmodule -> unit
 420                         = "llvm_set_data_layout"
 421 external dump_module : llmodule -> unit = "llvm_dump_module"
 422 external print_module : string -> llmodule -> unit = "llvm_print_module"
 423 external string_of_llmodule : llmodule -> string = "llvm_string_of_llmodule"
 424 external set_module_inline_asm : llmodule -> string -> unit
 425                                = "llvm_set_module_inline_asm"
 426 external module_context : llmodule -> llcontext = "LLVMGetModuleContext"
 427
 428 (*===-- Types -------------------------------------------------------------===*)
 429 external classify_type : lltype -> TypeKind.t = "llvm_classify_type"
 430 external type_context : lltype -> llcontext = "llvm_type_context"
 431 external type_is_sized : lltype -> bool = "llvm_type_is_sized"
 432 external dump_type : lltype -> unit = "llvm_dump_type"
 433 external string_of_lltype : lltype -> string = "llvm_string_of_lltype"
 434
 435 (*--... Operations on integer types ........................................--*)
 436 external i1_type : llcontext -> lltype = "llvm_i1_type"
 437 external i8_type : llcontext -> lltype = "llvm_i8_type"
 438 external i16_type : llcontext -> lltype = "llvm_i16_type"
 439 external i32_type : llcontext -> lltype = "llvm_i32_type"
 440 external i64_type : llcontext -> lltype = "llvm_i64_type"
 441
 442 external integer_type : llcontext -> int -> lltype = "llvm_integer_type"
 443 external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth"
 444
 445 (*--... Operations on real types ...........................................--*)
 446 external float_type : llcontext -> lltype = "llvm_float_type"
 447 external double_type : llcontext -> lltype = "llvm_double_type"
 448 external x86fp80_type : llcontext -> lltype = "llvm_x86fp80_type"
 449 external fp128_type : llcontext -> lltype = "llvm_fp128_type"
 450 external ppc_fp128_type : llcontext -> lltype = "llvm_ppc_fp128_type"
 451
 452 (*--... Operations on function types .......................................--*)
 453 external function_type : lltype -> lltype array -> lltype = "llvm_function_type"
 454 external var_arg_function_type : lltype -> lltype array -> lltype
 455                                = "llvm_var_arg_function_type"
 456 external is_var_arg : lltype -> bool = "llvm_is_var_arg"
 457 external return_type : lltype -> lltype = "LLVMGetReturnType"
 458 external param_types : lltype -> lltype array = "llvm_param_types"
 459
 460 (*--... Operations on struct types .........................................--*)
 461 external struct_type : llcontext -> lltype array -> lltype = "llvm_struct_type"
 462 external packed_struct_type : llcontext -> lltype array -> lltype
 463                             = "llvm_packed_struct_type"
 464 external struct_name : lltype -> string option = "llvm_struct_name"
 465 external named_struct_type : llcontext -> string -> lltype =
 466     "llvm_named_struct_type"
 467 external struct_set_body : lltype -> lltype array -> bool -> unit =
 468     "llvm_struct_set_body"
 469 external struct_element_types : lltype -> lltype array
 470                               = "llvm_struct_element_types"
 471 external is_packed : lltype -> bool = "llvm_is_packed"
 472 external is_opaque : lltype -> bool = "llvm_is_opaque"
 473 external is_literal : lltype -> bool = "llvm_is_literal"
 474
 475 (*--... Operations on pointer, vector, and array types .....................--*)
 476
 477 external subtypes : lltype -> lltype array = "llvm_subtypes"
 478 external array_type : lltype -> int -> lltype = "llvm_array_type"
 479 external pointer_type : lltype -> lltype = "llvm_pointer_type"
 480 external qualified_pointer_type : lltype -> int -> lltype
 481                                 = "llvm_qualified_pointer_type"
 482 external vector_type : lltype -> int -> lltype = "llvm_vector_type"
 483
 484 external element_type : lltype -> lltype = "LLVMGetElementType"
 485 external array_length : lltype -> int = "llvm_array_length"
 486 external address_space : lltype -> int = "llvm_address_space"
 487 external vector_size : lltype -> int = "llvm_vector_size"
 488
 489 (*--... Operations on other types ..........................................--*)
 490 external void_type : llcontext -> lltype = "llvm_void_type"
 491 external label_type : llcontext -> lltype = "llvm_label_type"
 492 external x86_mmx_type : llcontext -> lltype = "llvm_x86_mmx_type"
 493 external type_by_name : llmodule -> string -> lltype option = "llvm_type_by_name"
 494
 495 external classify_value : llvalue -> ValueKind.t = "llvm_classify_value"
 496 (*===-- Values ------------------------------------------------------------===*)
 497 external type_of : llvalue -> lltype = "llvm_type_of"
 498 external value_name : llvalue -> string = "llvm_value_name"
 499 external set_value_name : string -> llvalue -> unit = "llvm_set_value_name"
 500 external dump_value : llvalue -> unit = "llvm_dump_value"
 501 external string_of_llvalue : llvalue -> string = "llvm_string_of_llvalue"
 502 external replace_all_uses_with : llvalue -> llvalue -> unit
 503                                = "llvm_replace_all_uses_with"
 504
 505 (*--... Operations on uses .................................................--*)
 506 external use_begin : llvalue -> lluse option = "llvm_use_begin"
 507 external use_succ : lluse -> lluse option = "llvm_use_succ"
 508 external user : lluse -> llvalue = "llvm_user"
 509 external used_value : lluse -> llvalue = "llvm_used_value"
 510
 511 let iter_uses f v =
 512   let rec aux = function
 513     | None -> ()
 514     | Some u ->
 515         f u;
 516         aux (use_succ u)
 517   in
 518   aux (use_begin v)
 519
 520 let fold_left_uses f init v =
 521   let rec aux init u =
 522     match u with
 523     | None -> init
 524     | Some u -> aux (f init u) (use_succ u)
 525   in
 526   aux init (use_begin v)
 527
 528 let fold_right_uses f v init =
 529   let rec aux u init =
 530     match u with
 531     | None -> init
 532     | Some u -> f u (aux (use_succ u) init)
 533   in
 534   aux (use_begin v) init
 535
 536
 537 (*--... Operations on users ................................................--*)
 538 external operand : llvalue -> int -> llvalue = "llvm_operand"
 539 external operand_use : llvalue -> int -> lluse = "llvm_operand_use"
 540 external set_operand : llvalue -> int -> llvalue -> unit = "llvm_set_operand"
 541 external num_operands : llvalue -> int = "llvm_num_operands"
 542 external indices : llvalue -> int array = "llvm_indices"
 543
 544 (*--... Operations on constants of (mostly) any type .......................--*)
 545 external is_constant : llvalue -> bool = "llvm_is_constant"
 546 external const_null : lltype -> llvalue = "LLVMConstNull"
 547 external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes"
 548 external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull"
 549 external undef : lltype -> llvalue = "LLVMGetUndef"
 550 external is_null : llvalue -> bool = "llvm_is_null"
 551 external is_undef : llvalue -> bool = "llvm_is_undef"
 552 external constexpr_opcode : llvalue -> Opcode.t = "llvm_constexpr_get_opcode"
 553
 554 (*--... Operations on instructions .........................................--*)
 555 external has_metadata : llvalue -> bool = "llvm_has_metadata"
 556 external metadata : llvalue -> llmdkind -> llvalue option = "llvm_metadata"
 557 external set_metadata : llvalue -> llmdkind -> llvalue -> unit = "llvm_set_metadata"
 558 external clear_metadata : llvalue -> llmdkind -> unit = "llvm_clear_metadata"
 559
 560 (*--... Operations on metadata .......,.....................................--*)
 561 external mdstring : llcontext -> string -> llvalue = "llvm_mdstring"
 562 external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode"
 563 external mdnull : llcontext -> llvalue = "llvm_mdnull"
 564 external get_mdstring : llvalue -> string option = "llvm_get_mdstring"
 565 external get_mdnode_operands : llvalue -> llvalue array
 566                             = "llvm_get_mdnode_operands"
 567 external get_named_metadata : llmodule -> string -> llvalue array
 568                             = "llvm_get_namedmd"
 569 external add_named_metadata_operand : llmodule -> string -> llvalue -> unit
 570                                     = "llvm_append_namedmd"
 571
 572 (*--... Operations on scalar constants .....................................--*)
 573 external const_int : lltype -> int -> llvalue = "llvm_const_int"
 574 external const_of_int64 : lltype -> Int64.t -> bool -> llvalue
 575                         = "llvm_const_of_int64"
 576 external int64_of_const : llvalue -> Int64.t option
 577                         = "llvm_int64_of_const"
 578 external const_int_of_string : lltype -> string -> int -> llvalue
 579                              = "llvm_const_int_of_string"
 580 external const_float : lltype -> float -> llvalue = "llvm_const_float"
 581 external float_of_const : llvalue -> float option
 582                         = "llvm_float_of_const"
 583 external const_float_of_string : lltype -> string -> llvalue
 584                                = "llvm_const_float_of_string"
 585
 586 (*--... Operations on composite constants ..................................--*)
 587 external const_string : llcontext -> string -> llvalue = "llvm_const_string"
 588 external const_stringz : llcontext -> string -> llvalue = "llvm_const_stringz"
 589 external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array"
 590 external const_struct : llcontext -> llvalue array -> llvalue
 591                       = "llvm_const_struct"
 592 external const_named_struct : lltype -> llvalue array -> llvalue
 593                       = "llvm_const_named_struct"
 594 external const_packed_struct : llcontext -> llvalue array -> llvalue
 595                              = "llvm_const_packed_struct"
 596 external const_vector : llvalue array -> llvalue = "llvm_const_vector"
 597 external string_of_const : llvalue -> string option = "llvm_string_of_const"
 598 external const_element : llvalue -> int -> llvalue = "llvm_const_element"
 599
 600 (*--... Constant expressions ...............................................--*)
 601 external align_of : lltype -> llvalue = "LLVMAlignOf"
 602 external size_of : lltype -> llvalue = "LLVMSizeOf"
 603 external const_neg : llvalue -> llvalue = "LLVMConstNeg"
 604 external const_nsw_neg : llvalue -> llvalue = "LLVMConstNSWNeg"
 605 external const_nuw_neg : llvalue -> llvalue = "LLVMConstNUWNeg"
 606 external const_fneg : llvalue -> llvalue = "LLVMConstFNeg"
 607 external const_not : llvalue -> llvalue = "LLVMConstNot"
 608 external const_add : llvalue -> llvalue -> llvalue = "LLVMConstAdd"
 609 external const_nsw_add : llvalue -> llvalue -> llvalue = "LLVMConstNSWAdd"
 610 external const_nuw_add : llvalue -> llvalue -> llvalue = "LLVMConstNUWAdd"
 611 external const_fadd : llvalue -> llvalue -> llvalue = "LLVMConstFAdd"
 612 external const_sub : llvalue -> llvalue -> llvalue = "LLVMConstSub"
 613 external const_nsw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNSWSub"
 614 external const_nuw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNUWSub"
 615 external const_fsub : llvalue -> llvalue -> llvalue = "LLVMConstFSub"
 616 external const_mul : llvalue -> llvalue -> llvalue = "LLVMConstMul"
 617 external const_nsw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNSWMul"
 618 external const_nuw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNUWMul"
 619 external const_fmul : llvalue -> llvalue -> llvalue = "LLVMConstFMul"
 620 external const_udiv : llvalue -> llvalue -> llvalue = "LLVMConstUDiv"
 621 external const_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstSDiv"
 622 external const_exact_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstExactSDiv"
 623 external const_fdiv : llvalue -> llvalue -> llvalue = "LLVMConstFDiv"
 624 external const_urem : llvalue -> llvalue -> llvalue = "LLVMConstURem"
 625 external const_srem : llvalue -> llvalue -> llvalue = "LLVMConstSRem"
 626 external const_frem : llvalue -> llvalue -> llvalue = "LLVMConstFRem"
 627 external const_and : llvalue -> llvalue -> llvalue = "LLVMConstAnd"
 628 external const_or : llvalue -> llvalue -> llvalue = "LLVMConstOr"
 629 external const_xor : llvalue -> llvalue -> llvalue = "LLVMConstXor"
 630 external const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue
 631                     = "llvm_const_icmp"
 632 external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue
 633                     = "llvm_const_fcmp"
 634 external const_shl : llvalue -> llvalue -> llvalue = "LLVMConstShl"
 635 external const_lshr : llvalue -> llvalue -> llvalue = "LLVMConstLShr"
 636 external const_ashr : llvalue -> llvalue -> llvalue = "LLVMConstAShr"
 637 external const_gep : llvalue -> llvalue array -> llvalue = "llvm_const_gep"
 638 external const_in_bounds_gep : llvalue -> llvalue array -> llvalue
 639                             = "llvm_const_in_bounds_gep"
 640 external const_trunc : llvalue -> lltype -> llvalue = "LLVMConstTrunc"
 641 external const_sext : llvalue -> lltype -> llvalue = "LLVMConstSExt"
 642 external const_zext : llvalue -> lltype -> llvalue = "LLVMConstZExt"
 643 external const_fptrunc : llvalue -> lltype -> llvalue = "LLVMConstFPTrunc"
 644 external const_fpext : llvalue -> lltype -> llvalue = "LLVMConstFPExt"
 645 external const_uitofp : llvalue -> lltype -> llvalue = "LLVMConstUIToFP"
 646 external const_sitofp : llvalue -> lltype -> llvalue = "LLVMConstSIToFP"
 647 external const_fptoui : llvalue -> lltype -> llvalue = "LLVMConstFPToUI"
 648 external const_fptosi : llvalue -> lltype -> llvalue = "LLVMConstFPToSI"
 649 external const_ptrtoint : llvalue -> lltype -> llvalue = "LLVMConstPtrToInt"
 650 external const_inttoptr : llvalue -> lltype -> llvalue = "LLVMConstIntToPtr"
 651 external const_bitcast : llvalue -> lltype -> llvalue = "LLVMConstBitCast"
 652 external const_zext_or_bitcast : llvalue -> lltype -> llvalue
 653                              = "LLVMConstZExtOrBitCast"
 654 external const_sext_or_bitcast : llvalue -> lltype -> llvalue
 655                              = "LLVMConstSExtOrBitCast"
 656 external const_trunc_or_bitcast : llvalue -> lltype -> llvalue
 657                               = "LLVMConstTruncOrBitCast"
 658 external const_pointercast : llvalue -> lltype -> llvalue
 659                            = "LLVMConstPointerCast"
 660 external const_intcast : llvalue -> lltype -> is_signed:bool -> llvalue
 661                        = "llvm_const_intcast"
 662 external const_fpcast : llvalue -> lltype -> llvalue = "LLVMConstFPCast"
 663 external const_select : llvalue -> llvalue -> llvalue -> llvalue
 664                       = "LLVMConstSelect"
 665 external const_extractelement : llvalue -> llvalue -> llvalue
 666                               = "LLVMConstExtractElement"
 667 external const_insertelement : llvalue -> llvalue -> llvalue -> llvalue
 668                              = "LLVMConstInsertElement"
 669 external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue
 670                              = "LLVMConstShuffleVector"
 671 external const_extractvalue : llvalue -> int array -> llvalue
 672                             = "llvm_const_extractvalue"
 673 external const_insertvalue : llvalue -> llvalue -> int array -> llvalue
 674                            = "llvm_const_insertvalue"
 675 external const_inline_asm : lltype -> string -> string -> bool -> bool ->
 676                             llvalue
 677                           = "llvm_const_inline_asm"
 678 external block_address : llvalue -> llbasicblock -> llvalue = "LLVMBlockAddress"
 679
 680 (*--... Operations on global variables, functions, and aliases (globals) ...--*)
 681 external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent"
 682 external is_declaration : llvalue -> bool = "llvm_is_declaration"
 683 external linkage : llvalue -> Linkage.t = "llvm_linkage"
 684 external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage"
 685 external unnamed_addr : llvalue -> bool = "llvm_unnamed_addr"
 686 external set_unnamed_addr : bool -> llvalue -> unit = "llvm_set_unnamed_addr"
 687 external section : llvalue -> string = "llvm_section"
 688 external set_section : string -> llvalue -> unit = "llvm_set_section"
 689 external visibility : llvalue -> Visibility.t = "llvm_visibility"
 690 external set_visibility : Visibility.t -> llvalue -> unit = "llvm_set_visibility"
 691 external dll_storage_class : llvalue -> DLLStorageClass.t = "llvm_dll_storage_class"
 692 external set_dll_storage_class : DLLStorageClass.t -> llvalue -> unit = "llvm_set_dll_storage_class"
 693 external alignment : llvalue -> int = "llvm_alignment"
 694 external set_alignment : int -> llvalue -> unit = "llvm_set_alignment"
 695 external is_global_constant : llvalue -> bool = "llvm_is_global_constant"
 696 external set_global_constant : bool -> llvalue -> unit
 697                              = "llvm_set_global_constant"
 698
 699 (*--... Operations on global variables .....................................--*)
 700 external declare_global : lltype -> string -> llmodule -> llvalue
 701                         = "llvm_declare_global"
 702 external declare_qualified_global : lltype -> string -> int -> llmodule ->
 703                                     llvalue
 704                                   = "llvm_declare_qualified_global"
 705 external define_global : string -> llvalue -> llmodule -> llvalue
 706                        = "llvm_define_global"
 707 external define_qualified_global : string -> llvalue -> int -> llmodule ->
 708                                    llvalue
 709                                  = "llvm_define_qualified_global"
 710 external lookup_global : string -> llmodule -> llvalue option
 711                        = "llvm_lookup_global"
 712 external delete_global : llvalue -> unit = "llvm_delete_global"
 713 external global_initializer : llvalue -> llvalue = "LLVMGetInitializer"
 714 external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer"
 715 external remove_initializer : llvalue -> unit = "llvm_remove_initializer"
 716 external is_thread_local : llvalue -> bool = "llvm_is_thread_local"
 717 external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local"
 718 external thread_local_mode : llvalue -> ThreadLocalMode.t
 719                            = "llvm_thread_local_mode"
 720 external set_thread_local_mode : ThreadLocalMode.t -> llvalue -> unit
 721                                = "llvm_set_thread_local_mode"
 722 external is_externally_initialized : llvalue -> bool
 723                                    = "llvm_is_externally_initialized"
 724 external set_externally_initialized : bool -> llvalue -> unit
 725                                     = "llvm_set_externally_initialized"
 726 external global_begin : llmodule -> (llmodule, llvalue) llpos
 727                       = "llvm_global_begin"
 728 external global_succ : llvalue -> (llmodule, llvalue) llpos
 729                      = "llvm_global_succ"
 730 external global_end : llmodule -> (llmodule, llvalue) llrev_pos
 731                     = "llvm_global_end"
 732 external global_pred : llvalue -> (llmodule, llvalue) llrev_pos
 733                      = "llvm_global_pred"
 734
 735 let rec iter_global_range f i e =
 736   if i = e then () else
 737   match i with
 738   | At_end _ -> raise (Invalid_argument "Invalid global variable range.")
 739   | Before bb ->
 740       f bb;
 741       iter_global_range f (global_succ bb) e
 742
 743 let iter_globals f m =
 744   iter_global_range f (global_begin m) (At_end m)
 745
 746 let rec fold_left_global_range f init i e =
 747   if i = e then init else
 748   match i with
 749   | At_end _ -> raise (Invalid_argument "Invalid global variable range.")
 750   | Before bb -> fold_left_global_range f (f init bb) (global_succ bb) e
 751
 752 let fold_left_globals f init m =
 753   fold_left_global_range f init (global_begin m) (At_end m)
 754
 755 let rec rev_iter_global_range f i e =
 756   if i = e then () else
 757   match i with
 758   | At_start _ -> raise (Invalid_argument "Invalid global variable range.")
 759   | After bb ->
 760       f bb;
 761       rev_iter_global_range f (global_pred bb) e
 762
 763 let rev_iter_globals f m =
 764   rev_iter_global_range f (global_end m) (At_start m)
 765
 766 let rec fold_right_global_range f i e init =
 767   if i = e then init else
 768   match i with
 769   | At_start _ -> raise (Invalid_argument "Invalid global variable range.")
 770   | After bb -> fold_right_global_range f (global_pred bb) e (f bb init)
 771
 772 let fold_right_globals f m init =
 773   fold_right_global_range f (global_end m) (At_start m) init
 774
 775 (*--... Operations on aliases ..............................................--*)
 776 external add_alias : llmodule -> lltype -> llvalue -> string -> llvalue
 777                    = "llvm_add_alias"
 778
 779 (*--... Operations on functions ............................................--*)
 780 external declare_function : string -> lltype -> llmodule -> llvalue
 781                           = "llvm_declare_function"
 782 external define_function : string -> lltype -> llmodule -> llvalue
 783                          = "llvm_define_function"
 784 external lookup_function : string -> llmodule -> llvalue option
 785                          = "llvm_lookup_function"
 786 external delete_function : llvalue -> unit = "llvm_delete_function"
 787 external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic"
 788 external function_call_conv : llvalue -> int = "llvm_function_call_conv"
 789 external set_function_call_conv : int -> llvalue -> unit
 790                                 = "llvm_set_function_call_conv"
 791 external gc : llvalue -> string option = "llvm_gc"
 792 external set_gc : string option -> llvalue -> unit = "llvm_set_gc"
 793 external function_begin : llmodule -> (llmodule, llvalue) llpos
 794                         = "llvm_function_begin"
 795 external function_succ : llvalue -> (llmodule, llvalue) llpos
 796                        = "llvm_function_succ"
 797 external function_end : llmodule -> (llmodule, llvalue) llrev_pos
 798                       = "llvm_function_end"
 799 external function_pred : llvalue -> (llmodule, llvalue) llrev_pos
 800                        = "llvm_function_pred"
 801
 802 let rec iter_function_range f i e =
 803   if i = e then () else
 804   match i with
 805   | At_end _ -> raise (Invalid_argument "Invalid function range.")
 806   | Before fn ->
 807       f fn;
 808       iter_function_range f (function_succ fn) e
 809
 810 let iter_functions f m =
 811   iter_function_range f (function_begin m) (At_end m)
 812
 813 let rec fold_left_function_range f init i e =
 814   if i = e then init else
 815   match i with
 816   | At_end _ -> raise (Invalid_argument "Invalid function range.")
 817   | Before fn -> fold_left_function_range f (f init fn) (function_succ fn) e
 818
 819 let fold_left_functions f init m =
 820   fold_left_function_range f init (function_begin m) (At_end m)
 821
 822 let rec rev_iter_function_range f i e =
 823   if i = e then () else
 824   match i with
 825   | At_start _ -> raise (Invalid_argument "Invalid function range.")
 826   | After fn ->
 827       f fn;
 828       rev_iter_function_range f (function_pred fn) e
 829
 830 let rev_iter_functions f m =
 831   rev_iter_function_range f (function_end m) (At_start m)
 832
 833 let rec fold_right_function_range f i e init =
 834   if i = e then init else
 835   match i with
 836   | At_start _ -> raise (Invalid_argument "Invalid function range.")
 837   | After fn -> fold_right_function_range f (function_pred fn) e (f fn init)
 838
 839 let fold_right_functions f m init =
 840   fold_right_function_range f (function_end m) (At_start m) init
 841
 842 external llvm_add_function_attr : llvalue -> llattribute -> int -> unit
 843                                 = "llvm_add_function_attr"
 844 external llvm_function_attrs : llvalue -> int -> llattribute array
 845                              = "llvm_function_attrs"
 846 external llvm_remove_enum_function_attr : llvalue -> llattrkind -> int -> unit
 847                                         = "llvm_remove_enum_function_attr"
 848 external llvm_remove_string_function_attr : llvalue -> string -> int -> unit
 849                                           = "llvm_remove_string_function_attr"
 850
 851 let add_function_attr f a i =
 852   llvm_add_function_attr f a (AttrIndex.to_int i)
 853 let function_attrs f i =
 854   llvm_function_attrs f (AttrIndex.to_int i)
 855 let remove_enum_function_attr f k i =
 856   llvm_remove_enum_function_attr f k (AttrIndex.to_int i)
 857 let remove_string_function_attr f k i =
 858   llvm_remove_string_function_attr f k (AttrIndex.to_int i)
 859
 860 (*--... Operations on params ...............................................--*)
 861 external params : llvalue -> llvalue array = "llvm_params"
 862 external param : llvalue -> int -> llvalue = "llvm_param"
 863 external param_parent : llvalue -> llvalue = "LLVMGetParamParent"
 864 external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin"
 865 external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ"
 866 external param_end : llvalue -> (llvalue, llvalue) llrev_pos = "llvm_param_end"
 867 external param_pred : llvalue -> (llvalue, llvalue) llrev_pos ="llvm_param_pred"
 868
 869 let rec iter_param_range f i e =
 870   if i = e then () else
 871   match i with
 872   | At_end _ -> raise (Invalid_argument "Invalid parameter range.")
 873   | Before p ->
 874       f p;
 875       iter_param_range f (param_succ p) e
 876
 877 let iter_params f fn =
 878   iter_param_range f (param_begin fn) (At_end fn)
 879
 880 let rec fold_left_param_range f init i e =
 881   if i = e then init else
 882   match i with
 883   | At_end _ -> raise (Invalid_argument "Invalid parameter range.")
 884   | Before p -> fold_left_param_range f (f init p) (param_succ p) e
 885
 886 let fold_left_params f init fn =
 887   fold_left_param_range f init (param_begin fn) (At_end fn)
 888
 889 let rec rev_iter_param_range f i e =
 890   if i = e then () else
 891   match i with
 892   | At_start _ -> raise (Invalid_argument "Invalid parameter range.")
 893   | After p ->
 894       f p;
 895       rev_iter_param_range f (param_pred p) e
 896
 897 let rev_iter_params f fn =
 898   rev_iter_param_range f (param_end fn) (At_start fn)
 899
 900 let rec fold_right_param_range f init i e =
 901   if i = e then init else
 902   match i with
 903   | At_start _ -> raise (Invalid_argument "Invalid parameter range.")
 904   | After p -> fold_right_param_range f (f p init) (param_pred p) e
 905
 906 let fold_right_params f fn init =
 907   fold_right_param_range f init (param_end fn) (At_start fn)
 908
 909 (*--... Operations on basic blocks .........................................--*)
 910 external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
 911 external value_is_block : llvalue -> bool = "llvm_value_is_block"
 912 external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock"
 913 external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent"
 914 external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks"
 915 external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock"
 916 external delete_block : llbasicblock -> unit = "llvm_delete_block"
 917 external remove_block : llbasicblock -> unit = "llvm_remove_block"
 918 external move_block_before : llbasicblock -> llbasicblock -> unit
 919                            = "llvm_move_block_before"
 920 external move_block_after : llbasicblock -> llbasicblock -> unit
 921                           = "llvm_move_block_after"
 922 external append_block : llcontext -> string -> llvalue -> llbasicblock
 923                       = "llvm_append_block"
 924 external insert_block : llcontext -> string -> llbasicblock -> llbasicblock
 925                       = "llvm_insert_block"
 926 external block_begin : llvalue -> (llvalue, llbasicblock) llpos
 927                      = "llvm_block_begin"
 928 external block_succ : llbasicblock -> (llvalue, llbasicblock) llpos
 929                     = "llvm_block_succ"
 930 external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos
 931                    = "llvm_block_end"
 932 external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos
 933                     = "llvm_block_pred"
 934 external block_terminator : llbasicblock -> llvalue option =
 935     "llvm_block_terminator"
 936
 937 let rec iter_block_range f i e =
 938   if i = e then () else
 939   match i with
 940   | At_end _ -> raise (Invalid_argument "Invalid block range.")
 941   | Before bb ->
 942       f bb;
 943       iter_block_range f (block_succ bb) e
 944
 945 let iter_blocks f fn =
 946   iter_block_range f (block_begin fn) (At_end fn)
 947
 948 let rec fold_left_block_range f init i e =
 949   if i = e then init else
 950   match i with
 951   | At_end _ -> raise (Invalid_argument "Invalid block range.")
 952   | Before bb -> fold_left_block_range f (f init bb) (block_succ bb) e
 953
 954 let fold_left_blocks f init fn =
 955   fold_left_block_range f init (block_begin fn) (At_end fn)
 956
 957 let rec rev_iter_block_range f i e =
 958   if i = e then () else
 959   match i with
 960   | At_start _ -> raise (Invalid_argument "Invalid block range.")
 961   | After bb ->
 962       f bb;
 963       rev_iter_block_range f (block_pred bb) e
 964
 965 let rev_iter_blocks f fn =
 966   rev_iter_block_range f (block_end fn) (At_start fn)
 967
 968 let rec fold_right_block_range f init i e =
 969   if i = e then init else
 970   match i with
 971   | At_start _ -> raise (Invalid_argument "Invalid block range.")
 972   | After bb -> fold_right_block_range f (f bb init) (block_pred bb) e
 973
 974 let fold_right_blocks f fn init =
 975   fold_right_block_range f init (block_end fn) (At_start fn)
 976
 977 (*--... Operations on instructions .........................................--*)
 978 external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent"
 979 external instr_begin : llbasicblock -> (llbasicblock, llvalue) llpos
 980                      = "llvm_instr_begin"
 981 external instr_succ : llvalue -> (llbasicblock, llvalue) llpos
 982                      = "llvm_instr_succ"
 983 external instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos
 984                      = "llvm_instr_end"
 985 external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos
 986                      = "llvm_instr_pred"
 987
 988 external instr_opcode : llvalue -> Opcode.t = "llvm_instr_get_opcode"
 989 external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate"
 990 external fcmp_predicate : llvalue -> Fcmp.t option = "llvm_instr_fcmp_predicate"
 991 external instr_clone : llvalue -> llvalue = "llvm_instr_clone"
 992
 993 let rec iter_instrs_range f i e =
 994   if i = e then () else
 995   match i with
 996   | At_end _ -> raise (Invalid_argument "Invalid instruction range.")
 997   | Before i ->
 998       f i;
 999       iter_instrs_range f (instr_succ i) e
1000
1001 let iter_instrs f bb =
1002   iter_instrs_range f (instr_begin bb) (At_end bb)
1003
1004 let rec fold_left_instrs_range f init i e =
1005   if i = e then init else
1006   match i with
1007   | At_end _ -> raise (Invalid_argument "Invalid instruction range.")
1008   | Before i -> fold_left_instrs_range f (f init i) (instr_succ i) e
1009
1010 let fold_left_instrs f init bb =
1011   fold_left_instrs_range f init (instr_begin bb) (At_end bb)
1012
1013 let rec rev_iter_instrs_range f i e =
1014   if i = e then () else
1015   match i with
1016   | At_start _ -> raise (Invalid_argument "Invalid instruction range.")
1017   | After i ->
1018       f i;
1019       rev_iter_instrs_range f (instr_pred i) e
1020
1021 let rev_iter_instrs f bb =
1022   rev_iter_instrs_range f (instr_end bb) (At_start bb)
1023
1024 let rec fold_right_instr_range f i e init =
1025   if i = e then init else
1026   match i with
1027   | At_start _ -> raise (Invalid_argument "Invalid instruction range.")
1028   | After i -> fold_right_instr_range f (instr_pred i) e (f i init)
1029
1030 let fold_right_instrs f bb init =
1031   fold_right_instr_range f (instr_end bb) (At_start bb) init
1032
1033
1034 (*--... Operations on call sites ...........................................--*)
1035 external instruction_call_conv: llvalue -> int
1036                               = "llvm_instruction_call_conv"
1037 external set_instruction_call_conv: int -> llvalue -> unit
1038                                   = "llvm_set_instruction_call_conv"
1039
1040 external llvm_add_call_site_attr : llvalue -> llattribute -> int -> unit
1041                                 = "llvm_add_call_site_attr"
1042 external llvm_call_site_attrs : llvalue -> int -> llattribute array
1043                              = "llvm_call_site_attrs"
1044 external llvm_remove_enum_call_site_attr : llvalue -> llattrkind -> int -> unit
1045                                         = "llvm_remove_enum_call_site_attr"
1046 external llvm_remove_string_call_site_attr : llvalue -> string -> int -> unit
1047                                           = "llvm_remove_string_call_site_attr"
1048
1049 let add_call_site_attr f a i =
1050   llvm_add_call_site_attr f a (AttrIndex.to_int i)
1051 let call_site_attrs f i =
1052   llvm_call_site_attrs f (AttrIndex.to_int i)
1053 let remove_enum_call_site_attr f k i =
1054   llvm_remove_enum_call_site_attr f k (AttrIndex.to_int i)
1055 let remove_string_call_site_attr f k i =
1056   llvm_remove_string_call_site_attr f k (AttrIndex.to_int i)
1057
1058 (*--... Operations on call and invoke instructions (only) ..................--*)
1059 external num_arg_operands : llvalue -> int = "llvm_num_arg_operands"
1060 external is_tail_call : llvalue -> bool = "llvm_is_tail_call"
1061 external set_tail_call : bool -> llvalue -> unit = "llvm_set_tail_call"
1062 external get_normal_dest : llvalue -> llbasicblock = "LLVMGetNormalDest"
1063 external get_unwind_dest : llvalue -> llbasicblock = "LLVMGetUnwindDest"
1064
1065 (*--... Operations on load/store instructions (only) .......................--*)
1066 external is_volatile : llvalue -> bool = "llvm_is_volatile"
1067 external set_volatile : bool -> llvalue -> unit = "llvm_set_volatile"
1068
1069 (*--... Operations on terminators ..........................................--*)
1070
1071 let is_terminator llv =
1072   let open ValueKind in
1073   let open Opcode in
1074   match classify_value llv with
1075     | Instruction (Br | IndirectBr | Invoke | Resume | Ret | Switch | Unreachable)
1076       -> true
1077     | _ -> false
1078
1079 external successor : llvalue -> int -> llbasicblock = "llvm_successor"
1080 external set_successor : llvalue -> int -> llbasicblock -> unit
1081                        = "llvm_set_successor"
1082 external num_successors : llvalue -> int = "llvm_num_successors"
1083
1084 let successors llv =
1085   if not (is_terminator llv) then
1086     raise (Invalid_argument "Llvm.successors can only be used on terminators")
1087   else
1088     Array.init (num_successors llv) (successor llv)
1089
1090 let iter_successors f llv =
1091   if not (is_terminator llv) then
1092     raise (Invalid_argument "Llvm.iter_successors can only be used on terminators")
1093   else
1094     for i = 0 to num_successors llv - 1 do
1095       f (successor llv i)
1096     done
1097
1098 let fold_successors f llv z =
1099   if not (is_terminator llv) then
1100     raise (Invalid_argument "Llvm.fold_successors can only be used on terminators")
1101   else
1102     let n = num_successors llv in
1103     let rec aux i acc =
1104       if i >= n then acc
1105       else begin
1106         let llb = successor llv i in
1107         aux (i+1) (f llb acc)
1108       end
1109     in aux 0 z
1110
1111
1112 (*--... Operations on branches .............................................--*)
1113 external condition : llvalue -> llvalue = "llvm_condition"
1114 external set_condition : llvalue -> llvalue -> unit
1115                        = "llvm_set_condition"
1116 external is_conditional : llvalue -> bool = "llvm_is_conditional"
1117
1118 let get_branch llv =
1119   if classify_value llv <> ValueKind.Instruction Opcode.Br then
1120     None
1121   else if is_conditional llv then
1122     Some (`Conditional (condition llv, successor llv 0, successor llv 1))
1123   else
1124     Some (`Unconditional (successor llv 0))
1125
1126 (*--... Operations on phi nodes ............................................--*)
1127 external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
1128                       = "llvm_add_incoming"
1129 external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
1130
1131 external delete_instruction : llvalue -> unit = "llvm_delete_instruction"
1132
1133 (*===-- Instruction builders ----------------------------------------------===*)
1134 external builder : llcontext -> llbuilder = "llvm_builder"
1135 external position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit
1136                           = "llvm_position_builder"
1137 external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block"
1138 external insert_into_builder : llvalue -> string -> llbuilder -> unit
1139                              = "llvm_insert_into_builder"
1140
1141 let builder_at context ip =
1142   let b = builder context in
1143   position_builder ip b;
1144   b
1145
1146 let builder_before context i = builder_at context (Before i)
1147 let builder_at_end context bb = builder_at context (At_end bb)
1148
1149 let position_before i = position_builder (Before i)
1150 let position_at_end bb = position_builder (At_end bb)
1151
1152
1153 (*--... Metadata ...........................................................--*)
1154 external set_current_debug_location : llbuilder -> llvalue -> unit
1155                                     = "llvm_set_current_debug_location"
1156 external clear_current_debug_location : llbuilder -> unit
1157                                       = "llvm_clear_current_debug_location"
1158 external current_debug_location : llbuilder -> llvalue option
1159                                     = "llvm_current_debug_location"
1160 external set_inst_debug_location : llbuilder -> llvalue -> unit
1161                                  = "llvm_set_inst_debug_location"
1162
1163
1164 (*--... Terminators ........................................................--*)
1165 external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void"
1166 external build_ret : llvalue -> llbuilder -> llvalue = "llvm_build_ret"
1167 external build_aggregate_ret : llvalue array -> llbuilder -> llvalue
1168                              = "llvm_build_aggregate_ret"
1169 external build_br : llbasicblock -> llbuilder -> llvalue = "llvm_build_br"
1170 external build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder ->
1171                          llvalue = "llvm_build_cond_br"
1172 external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue
1173                       = "llvm_build_switch"
1174 external build_malloc : lltype -> string -> llbuilder -> llvalue =
1175     "llvm_build_malloc"
1176 external build_array_malloc : lltype -> llvalue -> string -> llbuilder ->
1177     llvalue = "llvm_build_array_malloc"
1178 external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free"
1179 external add_case : llvalue -> llvalue -> llbasicblock -> unit
1180                   = "llvm_add_case"
1181 external switch_default_dest : llvalue -> llbasicblock =
1182     "LLVMGetSwitchDefaultDest"
1183 external build_indirect_br : llvalue -> int -> llbuilder -> llvalue
1184                            = "llvm_build_indirect_br"
1185 external add_destination : llvalue -> llbasicblock -> unit
1186                          = "llvm_add_destination"
1187 external build_invoke : llvalue -> llvalue array -> llbasicblock ->
1188                         llbasicblock -> string -> llbuilder -> llvalue
1189                       = "llvm_build_invoke_bc" "llvm_build_invoke_nat"
1190 external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
1191                             llvalue = "llvm_build_landingpad"
1192 external is_cleanup : llvalue -> bool = "llvm_is_cleanup"
1193 external set_cleanup : llvalue -> bool -> unit = "llvm_set_cleanup"
1194 external add_clause : llvalue -> llvalue -> unit = "llvm_add_clause"
1195 external build_resume : llvalue -> llbuilder -> llvalue = "llvm_build_resume"
1196 external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable"
1197
1198 (*--... Arithmetic .........................................................--*)
1199 external build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue
1200                    = "llvm_build_add"
1201 external build_nsw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue
1202                        = "llvm_build_nsw_add"
1203 external build_nuw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue
1204                        = "llvm_build_nuw_add"
1205 external build_fadd : llvalue -> llvalue -> string -> llbuilder -> llvalue
1206                     = "llvm_build_fadd"
1207 external build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue
1208                    = "llvm_build_sub"
1209 external build_nsw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue
1210                        = "llvm_build_nsw_sub"
1211 external build_nuw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue
1212                        = "llvm_build_nuw_sub"
1213 external build_fsub : llvalue -> llvalue -> string -> llbuilder -> llvalue
1214                     = "llvm_build_fsub"
1215 external build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue
1216                    = "llvm_build_mul"
1217 external build_nsw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue
1218                        = "llvm_build_nsw_mul"
1219 external build_nuw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue
1220                        = "llvm_build_nuw_mul"
1221 external build_fmul : llvalue -> llvalue -> string -> llbuilder -> llvalue
1222                     = "llvm_build_fmul"
1223 external build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue
1224                     = "llvm_build_udiv"
1225 external build_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue
1226                     = "llvm_build_sdiv"
1227 external build_exact_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue
1228                           = "llvm_build_exact_sdiv"
1229 external build_fdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue
1230                     = "llvm_build_fdiv"
1231 external build_urem : llvalue -> llvalue -> string -> llbuilder -> llvalue
1232                     = "llvm_build_urem"
1233 external build_srem : llvalue -> llvalue -> string -> llbuilder -> llvalue
1234                     = "llvm_build_srem"
1235 external build_frem : llvalue -> llvalue -> string -> llbuilder -> llvalue
1236                     = "llvm_build_frem"
1237 external build_shl : llvalue -> llvalue -> string -> llbuilder -> llvalue
1238                    = "llvm_build_shl"
1239 external build_lshr : llvalue -> llvalue -> string -> llbuilder -> llvalue
1240                     = "llvm_build_lshr"
1241 external build_ashr : llvalue -> llvalue -> string -> llbuilder -> llvalue
1242                     = "llvm_build_ashr"
1243 external build_and : llvalue -> llvalue -> string -> llbuilder -> llvalue
1244                    = "llvm_build_and"
1245 external build_or : llvalue -> llvalue -> string -> llbuilder -> llvalue
1246                   = "llvm_build_or"
1247 external build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue
1248                    = "llvm_build_xor"
1249 external build_neg : llvalue -> string -> llbuilder -> llvalue
1250                    = "llvm_build_neg"
1251 external build_nsw_neg : llvalue -> string -> llbuilder -> llvalue
1252                        = "llvm_build_nsw_neg"
1253 external build_nuw_neg : llvalue -> string -> llbuilder -> llvalue
1254                        = "llvm_build_nuw_neg"
1255 external build_fneg : llvalue -> string -> llbuilder -> llvalue
1256                     = "llvm_build_fneg"
1257 external build_not : llvalue -> string -> llbuilder -> llvalue
1258                    = "llvm_build_not"
1259
1260 (*--... Memory .............................................................--*)
1261 external build_alloca : lltype -> string -> llbuilder -> llvalue
1262                       = "llvm_build_alloca"
1263 external build_array_alloca : lltype -> llvalue -> string -> llbuilder ->
1264                               llvalue = "llvm_build_array_alloca"
1265 external build_load : llvalue -> string -> llbuilder -> llvalue
1266                     = "llvm_build_load"
1267 external build_store : llvalue -> llvalue -> llbuilder -> llvalue
1268                      = "llvm_build_store"
1269 external build_atomicrmw : AtomicRMWBinOp.t -> llvalue -> llvalue ->
1270                            AtomicOrdering.t -> bool -> string -> llbuilder ->
1271                            llvalue
1272                          = "llvm_build_atomicrmw_bytecode"
1273                            "llvm_build_atomicrmw_native"
1274 external build_gep : llvalue -> llvalue array -> string -> llbuilder -> llvalue
1275                    = "llvm_build_gep"
1276 external build_in_bounds_gep : llvalue -> llvalue array -> string ->
1277                              llbuilder -> llvalue = "llvm_build_in_bounds_gep"
1278 external build_struct_gep : llvalue -> int -> string -> llbuilder -> llvalue
1279                          = "llvm_build_struct_gep"
1280
1281 external build_global_string : string -> string -> llbuilder -> llvalue
1282                              = "llvm_build_global_string"
1283 external build_global_stringptr  : string -> string -> llbuilder -> llvalue
1284                                  = "llvm_build_global_stringptr"
1285
1286 (*--... Casts ..............................................................--*)
1287 external build_trunc : llvalue -> lltype -> string -> llbuilder -> llvalue
1288                      = "llvm_build_trunc"
1289 external build_zext : llvalue -> lltype -> string -> llbuilder -> llvalue
1290                     = "llvm_build_zext"
1291 external build_sext : llvalue -> lltype -> string -> llbuilder -> llvalue
1292                     = "llvm_build_sext"
1293 external build_fptoui : llvalue -> lltype -> string -> llbuilder -> llvalue
1294                       = "llvm_build_fptoui"
1295 external build_fptosi : llvalue -> lltype -> string -> llbuilder -> llvalue
1296                       = "llvm_build_fptosi"
1297 external build_uitofp : llvalue -> lltype -> string -> llbuilder -> llvalue
1298                       = "llvm_build_uitofp"
1299 external build_sitofp : llvalue -> lltype -> string -> llbuilder -> llvalue
1300                       = "llvm_build_sitofp"
1301 external build_fptrunc : llvalue -> lltype -> string -> llbuilder -> llvalue
1302                        = "llvm_build_fptrunc"
1303 external build_fpext : llvalue -> lltype -> string -> llbuilder -> llvalue
1304                      = "llvm_build_fpext"
1305 external build_ptrtoint : llvalue -> lltype -> string -> llbuilder -> llvalue
1306                         = "llvm_build_prttoint"
1307 external build_inttoptr : llvalue -> lltype -> string -> llbuilder -> llvalue
1308                         = "llvm_build_inttoptr"
1309 external build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue
1310                        = "llvm_build_bitcast"
1311 external build_zext_or_bitcast : llvalue -> lltype -> string -> llbuilder ->
1312                                  llvalue = "llvm_build_zext_or_bitcast"
1313 external build_sext_or_bitcast : llvalue -> lltype -> string -> llbuilder ->
1314                                  llvalue = "llvm_build_sext_or_bitcast"
1315 external build_trunc_or_bitcast : llvalue -> lltype -> string -> llbuilder ->
1316                                   llvalue = "llvm_build_trunc_or_bitcast"
1317 external build_pointercast : llvalue -> lltype -> string -> llbuilder -> llvalue
1318                            = "llvm_build_pointercast"
1319 external build_intcast : llvalue -> lltype -> string -> llbuilder -> llvalue
1320                        = "llvm_build_intcast"
1321 external build_fpcast : llvalue -> lltype -> string -> llbuilder -> llvalue
1322                       = "llvm_build_fpcast"
1323
1324 (*--... Comparisons ........................................................--*)
1325 external build_icmp : Icmp.t -> llvalue -> llvalue -> string ->
1326                       llbuilder -> llvalue = "llvm_build_icmp"
1327 external build_fcmp : Fcmp.t -> llvalue -> llvalue -> string ->
1328                       llbuilder -> llvalue = "llvm_build_fcmp"
1329
1330 (*--... Miscellaneous instructions .........................................--*)
1331 external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder ->
1332                      llvalue = "llvm_build_phi"
1333 external build_empty_phi : lltype -> string -> llbuilder -> llvalue
1334                          = "llvm_build_empty_phi"
1335 external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue
1336                     = "llvm_build_call"
1337 external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder ->
1338                         llvalue = "llvm_build_select"
1339 external build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue
1340                       = "llvm_build_va_arg"
1341 external build_extractelement : llvalue -> llvalue -> string -> llbuilder ->
1342                                 llvalue = "llvm_build_extractelement"
1343 external build_insertelement : llvalue -> llvalue -> llvalue -> string ->
1344                                llbuilder -> llvalue = "llvm_build_insertelement"
1345 external build_shufflevector : llvalue -> llvalue -> llvalue -> string ->
1346                                llbuilder -> llvalue = "llvm_build_shufflevector"
1347 external build_extractvalue : llvalue -> int -> string -> llbuilder -> llvalue
1348                             = "llvm_build_extractvalue"
1349 external build_insertvalue : llvalue -> llvalue -> int -> string -> llbuilder ->
1350                              llvalue = "llvm_build_insertvalue"
1351
1352 external build_is_null : llvalue -> string -> llbuilder -> llvalue
1353                        = "llvm_build_is_null"
1354 external build_is_not_null : llvalue -> string -> llbuilder -> llvalue
1355                            = "llvm_build_is_not_null"
1356 external build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue
1357                        = "llvm_build_ptrdiff"
1358
1359
1360 (*===-- Memory buffers ----------------------------------------------------===*)
1361
1362 module MemoryBuffer = struct
1363   external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file"
1364   external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin"
1365   external of_string : ?name:string -> string -> llmemorybuffer
1366                      = "llvm_memorybuffer_of_string"
1367   external as_string : llmemorybuffer -> string = "llvm_memorybuffer_as_string"
1368   external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose"
1369 end
1370
1371
1372 (*===-- Pass Manager ------------------------------------------------------===*)
1373
1374 module PassManager = struct
1375   type 'a t
1376   type any = [ `Module | `Function ]
1377   external create : unit -> [ `Module ] t = "llvm_passmanager_create"
1378   external create_function : llmodule -> [ `Function ] t
1379                            = "LLVMCreateFunctionPassManager"
1380   external run_module : llmodule -> [ `Module ] t -> bool
1381                       = "llvm_passmanager_run_module"
1382   external initialize : [ `Function ] t -> bool = "llvm_passmanager_initialize"
1383   external run_function : llvalue -> [ `Function ] t -> bool
1384                         = "llvm_passmanager_run_function"
1385   external finalize : [ `Function ] t -> bool = "llvm_passmanager_finalize"
1386   external dispose : [< any ] t -> unit = "llvm_passmanager_dispose"
1387 end