bindings/ocaml/llvm/llvm.ml

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