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