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