X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=blobdiff_plain;f=bindings%2Focaml%2Fllvm%2Fllvm.ml;h=9d138eb08d8ead84e9fcad70e0b8a71246cb83b2;hp=a415b94594707096617e2feb30f7edbdab40b8cb;hb=bbf1c514bd832bf1306fe3e87221fd78bbc306ef;hpb=0465fb5663a0108399df4c19db1afb4516328964 diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml index a415b945947..9d138eb08d8 100644 --- a/bindings/ocaml/llvm/llvm.ml +++ b/bindings/ocaml/llvm/llvm.ml @@ -1,9 +1,9 @@ -(*===-- tools/ml/llvm.ml - LLVM Ocaml Interface ---------------------------===* +(*===-- llvm/llvm.ml - LLVM Ocaml Interface --------------------------------===* * * The LLVM Compiler Infrastructure * - * This file was developed by Gordon Henriksen and is distributed under the - * University of Illinois Open Source License. See LICENSE.TXT for details. + * This file is distributed under the University of Illinois Open Source + * License. See LICENSE.TXT for details. * *===----------------------------------------------------------------------===*) @@ -14,80 +14,107 @@ type lltypehandle type llvalue type llbasicblock type llbuilder - -type type_kind = - Void_type -| Float_type -| Double_type -| X86fp80_type -| Fp128_type -| Ppc_fp128_type -| Label_type -| Integer_type -| Function_type -| Struct_type -| Array_type -| Pointer_type -| Opaque_type -| Vector_type - -type linkage = - External_linkage -| Link_once_linkage -| Weak_linkage -| Appending_linkage -| Internal_linkage -| Dllimport_linkage -| Dllexport_linkage -| External_weak_linkage -| Ghost_linkage - -type visibility = - Default_visibility -| Hidden_visibility -| Protected_visibility - -let ccc = 0 -let fastcc = 8 -let coldcc = 9 -let x86_stdcallcc = 64 -let x86_fastcallcc = 65 - -type int_predicate = - Icmp_eq -| Icmp_ne -| Icmp_ugt -| Icmp_uge -| Icmp_ult -| Icmp_ule -| Icmp_sgt -| Icmp_sge -| Icmp_slt -| Icmp_sle - -type real_predicate = - Fcmp_false -| Fcmp_oeq -| Fcmp_ogt -| Fcmp_oge -| Fcmp_olt -| Fcmp_ole -| Fcmp_one -| Fcmp_ord -| Fcmp_uno -| Fcmp_ueq -| Fcmp_ugt -| Fcmp_uge -| Fcmp_ult -| Fcmp_ule -| Fcmp_une -| Fcmp_true +type llmoduleprovider +type llmemorybuffer + +module TypeKind = struct + type t = + | Void + | Float + | Double + | X86fp80 + | Fp128 + | Ppc_fp128 + | Label + | Integer + | Function + | Struct + | Array + | Pointer + | Opaque + | Vector +end + +module Linkage = struct + type t = + | External + | Link_once + | Weak + | Appending + | Internal + | Dllimport + | Dllexport + | External_weak + | Ghost +end + +module Visibility = struct + type t = + | Default + | Hidden + | Protected +end + +module CallConv = struct + let c = 0 + let fast = 8 + let cold = 9 + let x86_stdcall = 64 + let x86_fastcall = 65 +end + +module Icmp = struct + type t = + | Eq + | Ne + | Ugt + | Uge + | Ult + | Ule + | Sgt + | Sge + | Slt + | Sle +end + +module Fcmp = struct + type t = + | False + | Oeq + | Ogt + | Oge + | Olt + | Ole + | One + | Ord + | Uno + | Ueq + | Ugt + | Uge + | Ult + | Ule + | Une + | True +end + +exception IoError of string + +external register_exns : exn -> unit = "llvm_register_core_exns" +let _ = register_exns (IoError "") (*===-- Modules -----------------------------------------------------------===*) external create_module : string -> llmodule = "llvm_create_module" external dispose_module : llmodule -> unit = "llvm_dispose_module" +external target_triple: llmodule -> string + = "llvm_target_triple" +external set_target_triple: string -> llmodule -> unit + = "llvm_set_target_triple" +external data_layout: llmodule -> string + = "llvm_data_layout" +external set_data_layout: string -> llmodule -> unit + = "llvm_set_data_layout" external define_type_name : string -> lltype -> llmodule -> bool = "llvm_add_type_name" external delete_type_name : string -> llmodule -> unit @@ -96,7 +123,7 @@ external delete_type_name : string -> llmodule -> unit (*===-- Types -------------------------------------------------------------===*) -external classify_type : lltype -> type_kind = "llvm_classify_type" +external classify_type : lltype -> TypeKind.t = "llvm_classify_type" (*--... Operations on integer types ........................................--*) external _i1_type : unit -> lltype = "llvm_i1_type" @@ -143,11 +170,14 @@ external is_packed : lltype -> bool = "llvm_is_packed" (*--... Operations on pointer, vector, and array types .....................--*) external array_type : lltype -> int -> lltype = "llvm_array_type" -external pointer_type : lltype -> lltype = "LLVMPointerType" +external pointer_type : lltype -> lltype = "llvm_pointer_type" +external qualified_pointer_type : lltype -> int -> lltype + = "llvm_qualified_pointer_type" external vector_type : lltype -> int -> lltype = "llvm_vector_type" external element_type : lltype -> lltype = "LLVMGetElementType" external array_length : lltype -> int = "llvm_array_length" +external address_space : lltype -> int = "llvm_address_space" external vector_size : lltype -> int = "llvm_vector_size" (*--... Operations on other types ..........................................--*) @@ -210,9 +240,9 @@ external const_frem : llvalue -> llvalue -> llvalue = "LLVMConstFRem" external const_and : llvalue -> llvalue -> llvalue = "LLVMConstAnd" external const_or : llvalue -> llvalue -> llvalue = "LLVMConstOr" external const_xor : llvalue -> llvalue -> llvalue = "LLVMConstXor" -external const_icmp : int_predicate -> llvalue -> llvalue -> llvalue +external const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue = "llvm_const_icmp" -external const_fcmp : real_predicate -> llvalue -> llvalue -> llvalue +external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue = "llvm_const_fcmp" external const_shl : llvalue -> llvalue -> llvalue = "LLVMConstShl" external const_lshr : llvalue -> llvalue -> llvalue = "LLVMConstLShr" @@ -241,12 +271,12 @@ external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue (*--... Operations on global variables, functions, and aliases (globals) ...--*) external is_declaration : llvalue -> bool = "llvm_is_declaration" -external linkage : llvalue -> linkage = "llvm_linkage" -external set_linkage : linkage -> llvalue -> unit = "llvm_set_linkage" +external linkage : llvalue -> Linkage.t = "llvm_linkage" +external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage" external section : llvalue -> string = "llvm_section" external set_section : string -> llvalue -> unit = "llvm_set_section" -external visibility : llvalue -> visibility = "llvm_visibility" -external set_visibility : visibility -> llvalue -> unit = "llvm_set_visibility" +external visibility : llvalue -> Visibility.t = "llvm_visibility" +external set_visibility : Visibility.t -> llvalue -> unit = "llvm_set_visibility" external alignment : llvalue -> int = "llvm_alignment" external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" external is_global_constant : llvalue -> bool = "llvm_is_global_constant" @@ -282,6 +312,8 @@ external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic" external function_call_conv : llvalue -> int = "llvm_function_call_conv" external set_function_call_conv : int -> llvalue -> unit = "llvm_set_function_call_conv" +external collector : llvalue -> string option = "llvm_collector" +external set_collector : string option -> llvalue -> unit = "llvm_set_collector" (* TODO: param attrs *) @@ -296,6 +328,12 @@ external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" external value_is_block : llvalue -> bool = "llvm_value_is_block" external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" +(*--... Operations on call sites ...........................................--*) +external instruction_call_conv: llvalue -> int + = "llvm_instruction_call_conv" +external set_instruction_call_conv: int -> llvalue -> unit + = "llvm_set_instruction_call_conv" + (*--... Operations on phi nodes ............................................--*) external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit = "llvm_add_incoming" @@ -303,6 +341,8 @@ external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" (*===-- Instruction builders ----------------------------------------------===*) +external builder: unit-> llbuilder + = "llvm_builder" external builder_before : llvalue -> llbuilder = "llvm_builder_before" external builder_at_end : llbasicblock -> llbuilder = "llvm_builder_at_end" external position_before : llvalue -> llbuilder -> unit = "llvm_position_before" @@ -403,9 +443,9 @@ external build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue = "llvm_build_bitcast" (*--... Comparisons ........................................................--*) -external build_icmp : int_predicate -> llvalue -> llvalue -> string -> +external build_icmp : Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_icmp" -external build_fcmp : real_predicate -> llvalue -> llvalue -> string -> +external build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_fcmp" (*--... Miscellaneous instructions .........................................--*) @@ -425,6 +465,24 @@ external build_shufflevector : llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue = "llvm_build_shufflevector" +(*===-- Module providers --------------------------------------------------===*) + +module ModuleProvider = struct + external create : llmodule -> llmoduleprovider + = "LLVMCreateModuleProviderForExistingModule" + external dispose : llmoduleprovider -> unit = "llvm_dispose_module_provider" +end + + +(*===-- Memory buffers ----------------------------------------------------===*) + +module MemoryBuffer = struct + external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file" + external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin" + external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose" +end + + (*===-- Non-Externs -------------------------------------------------------===*) (* These functions are built using the externals, so must be declared late. *) @@ -441,28 +499,28 @@ let concat2 sep arr = let rec string_of_lltype ty = (* FIXME: stop infinite recursion! :) *) match classify_type ty with - Integer_type -> "i" ^ string_of_int (integer_bitwidth ty) - | Pointer_type -> (string_of_lltype (element_type ty)) ^ "*" - | Struct_type -> + TypeKind.Integer -> "i" ^ string_of_int (integer_bitwidth ty) + | TypeKind.Pointer -> (string_of_lltype (element_type ty)) ^ "*" + | TypeKind.Struct -> let s = "{ " ^ (concat2 ", " ( Array.map string_of_lltype (element_types ty) )) ^ " }" in if is_packed ty then "<" ^ s ^ ">" else s - | Array_type -> "[" ^ (string_of_int (array_length ty)) ^ - " x " ^ (string_of_lltype (element_type ty)) ^ "]" - | Vector_type -> "<" ^ (string_of_int (vector_size ty)) ^ - " x " ^ (string_of_lltype (element_type ty)) ^ ">" - | Opaque_type -> "opaque" - | Function_type -> string_of_lltype (return_type ty) ^ - " (" ^ (concat2 ", " ( - Array.map string_of_lltype (param_types ty) - )) ^ ")" - | Label_type -> "label" - | Ppc_fp128_type -> "ppc_fp128" - | Fp128_type -> "fp128" - | X86fp80_type -> "x86_fp80" - | Double_type -> "double" - | Float_type -> "float" - | Void_type -> "void" + | TypeKind.Array -> "[" ^ (string_of_int (array_length ty)) ^ + " x " ^ (string_of_lltype (element_type ty)) ^ "]" + | TypeKind.Vector -> "<" ^ (string_of_int (vector_size ty)) ^ + " x " ^ (string_of_lltype (element_type ty)) ^ ">" + | TypeKind.Opaque -> "opaque" + | TypeKind.Function -> string_of_lltype (return_type ty) ^ + " (" ^ (concat2 ", " ( + Array.map string_of_lltype (param_types ty) + )) ^ ")" + | TypeKind.Label -> "label" + | TypeKind.Ppc_fp128 -> "ppc_fp128" + | TypeKind.Fp128 -> "fp128" + | TypeKind.X86fp80 -> "x86_fp80" + | TypeKind.Double -> "double" + | TypeKind.Float -> "float" + | TypeKind.Void -> "void"