├── .gitignore ├── LICENSE ├── Makefile ├── README.md ├── llvm.mlb ├── llvm_core.sig ├── llvm_core.sml ├── llvm_mlkit.c └── test ├── miniml ├── miniml.mlb └── miniml.sml └── unittest ├── unittest.mlb └── unittest.sml /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | MLB -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2014 Martin Elsman 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # First, download llvm (in source form), unpack it, and compile it: 2 | # cd $(HOME)/llvm-3.5.0.src/ 3 | # TRIPLE=i686-apple-darwin10 4 | # ./configure --with-gxx-include-dir=/usr/include/c++/4.2.1 --build=$TRIPLE --host=$TRIPLE --target=$TRIPLE 5 | # make 6 | # Download MLKit and install it. 7 | # Update the variables LLVMDIR and MLKITINCLUDEDIR below. 8 | 9 | PWD=$(shell pwd) 10 | MLKITINCLUDEDIR=/usr/local/share/mlkit/include 11 | MLKIT=mlkit 12 | LLVMDIR=$(HOME)/llvm-3.5.0.src 13 | LLVMINCLUDEDIR=$(LLVMDIR)/include 14 | LLVMBINDIR=$(LLVMDIR)/Release+Asserts/bin 15 | LLVMCONFIG=$(LLVMBINDIR)/llvm-config 16 | #LLVM_LIBS_GEN=$(shell $(LLVMCONFIG) --libs core --libs bitwriter --libs engine --libs executionengine) 17 | LLVM_LIBS_GEN=$(shell $(LLVMCONFIG) --libs) $(shell $(LLVMCONFIG) --system-libs) 18 | TEST=$(shell $(LLVMCONFIG) --libs core jit native interpreter bitwriter) 19 | #LLVM_LIBNAMES=$(shell $(LLVMCONFIG) --libnames core --libnames bitwriter) 20 | LLVM_LDFLAGS=$(shell $(LLVMCONFIG) --ldflags) 21 | LLVM_CPPFLAGS=$(shell $(LLVMCONFIG) --cppflags) 22 | LLVM_LIBS=LLVMBitWriter,LLVMInterpreter,LLVMX86CodeGen,LLVMSelectionDAG,LLVMAsmPrinter,LLVMX86AsmParser,LLVMMCParser,LLVMX86Disassembler,LLVMX86Desc,LLVMX86Info,LLVMX86AsmPrinter,LLVMX86Utils,LLVMJIT,LLVMRuntimeDyld,LLVMExecutionEngine,LLVMCodeGen,LLVMScalarOpts,LLVMInstCombine,LLVMTransformUtils,LLVMipa,LLVMAnalysis,LLVMTarget,LLVMMC,LLVMObject,LLVMCore,LLVMSupport 23 | LLVM_LIBS2=$(LLVM_LIBS_GEN:-l%=%,) 24 | LIBS="c,LLVMMLKit,$(LLVM_LIBS2)dl" 25 | LIBDIRS="$(LLVMDIR)/Release+Asserts/lib,." 26 | CC="g++" 27 | MLKIT_CC_FLAGS=-g -O2 -m32 -Wall -std=gnu99 -DTAG_VALUES -DTAG_FREE_PAIRS -DENABLE_GC 28 | 29 | .PHONY: all 30 | all: libLLVMMLKit.a 31 | $(MLKIT) -cc $(CC) --libs $(LIBS) --libdirs $(LIBDIRS) llvm.mlb 32 | 33 | .PHONY: show 34 | show: 35 | @echo "LLVM_LIBS2:" 36 | @echo " $(LLVM_LIBS2)" 37 | @echo "TEST:" 38 | @echo " $(TEST)" 39 | @echo "LLVMDIR:" 40 | @echo " $(LLVMDIR)" 41 | @echo "LLVMBINDIR:" 42 | @echo " $(LLVMBINDIR)" 43 | @echo "LLVMCONFIG" 44 | @echo " $(LLVMCONFIG)" 45 | @echo "LLVM_LIBS_GEN:" 46 | @echo " $(LLVM_LIBS_GEN)" 47 | # @echo "$(LLVM_LIBNAMES)" 48 | @echo "LLVM_LDFLAGS:" 49 | @echo " $(LLVM_LDFLAGS)" 50 | @echo "LLVM_CPPFLAGS:" 51 | @echo " $(LLVM_CPPFLAGS)" 52 | @echo " $(LIBS)" 53 | 54 | libLLVMMLKit.a: LLVMMLKit.o 55 | cp -p $< $@ 56 | 57 | LLVMMLKit.o: llvm_mlkit.c 58 | gcc $(LLVM_CPPFLAGS) $(MLKIT_CC_FLAGS) -I $(MLKITINCLUDEDIR) -c -o $@ $< 59 | 60 | miniml: miniml.ll 61 | $(LLVMDIR)/Release+Asserts/bin/llc -O3 miniml.bc -o miniml.s 62 | gcc -O3 miniml.s -o miniml 63 | ./miniml 64 | 65 | miniml.bc: minimlexe 66 | ./minimlexe $@ 67 | 68 | minimlexe: libLLVMMLKit.a 69 | $(MLKIT) -cc $(CC) --libs $(LIBS) --libdirs $(LIBDIRS) -o $@ test/miniml/miniml.mlb 70 | 71 | .PHONY: minimljit 72 | minimljit: minimlexe 73 | ./minimlexe -jit 74 | 75 | .PHONY: minimlinterp 76 | minimlinterp: minimlexe 77 | ./minimlexe -interp 78 | 79 | .PHONY: test 80 | test: testexe 81 | ./testexe 82 | 83 | testexe: libLLVMMLKit.a 84 | $(MLKIT) -cc $(CC) --libs $(LIBS) --libdirs $(LIBDIRS) -o $@ test/unittest/unittest.mlb 85 | 86 | test.bc: testexe 87 | ./testexe 88 | 89 | %.ll: %.bc 90 | $(LLVMDIR)/Release+Asserts/bin/llvm-dis $< 91 | 92 | clean: 93 | rm -rf MLB *~ run test/*/MLB test/*/run test/*/*~ *.a *.o *.bc *.ll miniml *.s testexe minimlexe 94 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## sml-llvm - Standard ML bindings for LLVM 2 | 3 | _Copyright 2010-2014, Martin Elsman_ 4 | 5 | This repository contains a port for Standard ML (in particular, the 6 | MLKit) of the OCaml bindings for [LLVM](http://llvm.org). 7 | 8 | The repository also contains a port of an example by Jon Harrop for 9 | compiling a miniml language into LLVM. See [test/miniml](/test/miniml) and 10 | http://groups.google.com/group/fa.caml/msg/5aee553df34548e2 11 | 12 | ### Assumptions 13 | 14 | The library works with a 32bit installation of [LLVM](http://llvm.org) and the native 15 | [MLKit](http://melsman.github.io/mlkit) compiler. 16 | 17 | ### LICENSE 18 | 19 | The library is distributed under the MIT License; see the [LICENSE 20 | file](/LICENSE) for details. 21 | 22 | -------------------------------------------------------------------------------- /llvm.mlb: -------------------------------------------------------------------------------- 1 | local 2 | $(SML_LIB)/basis/basis.mlb 3 | in 4 | llvm_core.sig 5 | llvm_core.sml 6 | end -------------------------------------------------------------------------------- /llvm_core.sig: -------------------------------------------------------------------------------- 1 | (** Core API. 2 | 3 | This interface provides a Standard ML API for the LLVM intermediate 4 | representation, the classes in the VMCore library. *) 5 | 6 | signature LLVM_CORE = sig 7 | 8 | (** {6 Abstract types} 9 | 10 | These abstract types correlate directly to the LLVM VMCore classes. *) 11 | 12 | (** The top-level container for all LLVM global data. See the 13 | [llvm::LLVMContext] class. *) 14 | eqtype llcontext 15 | 16 | (** The top-level container for all other LLVM Intermediate Representation (IR) 17 | objects. See the [llvm::Module] class. *) 18 | eqtype llmodule 19 | 20 | (** Each value in the LLVM IR has a type, an instance of [lltype]. See the 21 | [llvm::Type] class. *) 22 | eqtype lltype 23 | 24 | (** Any value in the LLVM IR. Functions, instructions, global variables, 25 | constants, and much more are all [llvalues]. See the [llvm::Value] class. 26 | This type covers a wide range of subclasses. *) 27 | eqtype llvalue 28 | 29 | (** Used to store users and usees of values. See the [llvm::Use] class. *) 30 | eqtype lluse 31 | 32 | (** A basic block in LLVM IR. See the [llvm::BasicBlock] class. *) 33 | eqtype llbasicblock 34 | 35 | (** Used to generate instructions in the LLVM IR. See the [llvm::LLVMBuilder] 36 | class. *) 37 | eqtype llbuilder 38 | 39 | (** Used to efficiently handle large buffers of read-only binary data. 40 | See the [llvm::MemoryBuffer] class. *) 41 | eqtype llmemorybuffer 42 | 43 | (** The kind of an [lltype], the result of [classify_type ty]. See the 44 | [llvm::Type::TypeID] enumeration. *) 45 | structure TypeKind : sig 46 | datatype t = Void | Half | Float | Double | X86fp80 | Fp128 | Ppc_fp128 | 47 | Label | Integer | Function | Struct | Array | Pointer | Vector | 48 | Metadata 49 | val toString : t -> string 50 | end 51 | 52 | (** The linkage of a global value, accessed with {!linkage} and 53 | {!set_linkage}. See [llvm::GlobalValue::LinkageTypes]. *) 54 | structure Linkage : sig 55 | datatype t = External | Available_externally | Link_once | Link_once_odr | 56 | Weak | Weak_odr | Appending | Internal | Private | Dllimport | 57 | Dllexport | External_weak | Ghost | Common | Linker_private 58 | end 59 | 60 | (** The linker visibility of a global value, accessed with {!visibility} and 61 | {!set_visibility}. See [llvm::GlobalValue::VisibilityTypes]. *) 62 | structure Visibility : sig 63 | datatype t = Default | Hidden | Protected 64 | end 65 | 66 | (** The following calling convention values may be accessed with 67 | {!function_call_conv} and {!set_function_call_conv}. Calling 68 | conventions are open-ended. *) 69 | structure CallConv : sig 70 | val c : int (** [c] is the C calling convention. *) 71 | val fast : int (** [fast] is the calling convention to allow LLVM 72 | maximum optimization opportunities. Use only with 73 | internal linkage. *) 74 | val cold : int (** [cold] is the calling convention for 75 | callee-save. *) 76 | val x86_stdcall : int (** [x86_stdcall] is the familiar stdcall calling 77 | convention from C. *) 78 | val x86_fastcall : int (** [x86_fastcall] is the familiar fastcall calling 79 | convention from C. *) 80 | end 81 | 82 | structure Attribute : sig 83 | datatype t = Zext | Sext | Noreturn | Inreg | Structret | Nounwind | 84 | Noalias | Byval | Nest | Readnone | Readonly | Noinline | 85 | Alwaysinline | Optsize | Ssp | Sspreq | Alignment of int | Nocapture | 86 | Noredzone | Noimplicitfloat | Naked | Inlinehint | 87 | Stackalignment of int | ReturnsTwice | UWTable | NonLazyBind 88 | end 89 | 90 | (** The predicate for an integer comparison ([icmp]) instruction. 91 | See the [llvm::ICmpInst::Predicate] enumeration. *) 92 | structure Icmp : sig 93 | datatype t = Eq | Ne | Ugt | Uge | Ult | Ule | Sgt | Sge | Slt | Sle 94 | end 95 | 96 | (** The predicate for a floating-point comparison ([fcmp]) instruction. 97 | See the [llvm::FCmpInst::Predicate] enumeration. *) 98 | structure Fcmp : sig 99 | datatype t = False | Oeq | Ogt | Oge | Olt | Ole | One | Ord | Uno | 100 | Ueq | Ugt | Uge | Ult | Ule | Une | True 101 | end 102 | 103 | (** The opcodes for LLVM instructions and constant expressions. *) 104 | structure Opcode : sig 105 | datatype t = 106 | (* not an instruction *) 107 | Invalid | 108 | 109 | (* Terminator Instructions *) 110 | Ret | Br | Switch | IndirectBr | Invoke | Invalid2 | 111 | Unreachable | 112 | 113 | (* Standard Binary Operators *) 114 | Add | FAdd | Sub | FSub | Mul | FMul | UDiv | SDiv | FDiv | 115 | URem | SRem | FRem | 116 | 117 | (* Logical Operators *) 118 | Shl | LShr | AShr | And | Or | Xor | 119 | 120 | (* Memory Operators *) 121 | Alloca | Load | Store | GetElementPtr | 122 | 123 | (* Cast Operators *) 124 | Trunc | ZExt | SExt | FPToUI | FPToSI | UIToFP | SIToFP | 125 | FPTrunc | FPExt | PtrToInt | IntToPtr | BitCast | 126 | 127 | (* Other Operators *) 128 | ICmp | FCmp | PHI | Call | Select | UserOp1 | UserOp2 | VAArg | 129 | ExtractElement | InsertElement | ShuffleVector | ExtractValue | 130 | InsertValue | Fence | AtomicCmpXchg | AtomicRMW | Resume | 131 | LandingPad | Unwind 132 | end 133 | 134 | (** The kind of an [llvalue], the result of [classify_value v]. 135 | * See the various [LLVMIsA*] functions. *) 136 | structure ValueKind : sig 137 | datatype t = NullValue | Argument | BasicBlock | InlineAsm | MDNode | 138 | MDString | BlockAddress | ConstantAggregateZero | ConstantArray | 139 | ConstantExpr | ConstantFP | ConstantInt | ConstantPointerNull | 140 | ConstantStruct | ConstantVector | Function | GlobalAlias | 141 | GlobalVariable | UndefValue | Instruction of Opcode.t 142 | end 143 | 144 | (** {6 Iteration} *) 145 | 146 | (** [Before b] and [At_end a] specify positions from the start of the ['b] list 147 | of [a]. [llpos] is used to specify positions in and for forward iteration 148 | through the various value lists maintained by the LLVM IR. *) 149 | (* 150 | datatype ('a, 'b) llpos = At_end of 'a | Before of 'b 151 | *) 152 | (** [After b] and [At_start a] specify positions from the end of the ['b] list 153 | of [a]. [llrev_pos] is used for reverse iteration through the various value 154 | lists maintained by the LLVM IR. *) 155 | (* 156 | datatype ('a, 'b) llrev_pos = At_start of 'a | After of 'b 157 | *) 158 | 159 | (** {6 Exceptions} *) 160 | 161 | exception IoError of string 162 | 163 | 164 | (** {6 Contexts} *) 165 | 166 | (** [create_context ()] creates a context for storing the "global" state in 167 | LLVM. See the constructor [llvm::LLVMContext]. *) 168 | val create_context : unit -> llcontext 169 | 170 | (** [destroy_context ()] destroys a context. See the destructor 171 | [llvm::LLVMContext::~LLVMContext]. *) 172 | val dispose_context : llcontext -> unit 173 | 174 | (** See the function [llvm::getGlobalContext]. *) 175 | val global_context : unit -> llcontext 176 | 177 | (** [mdkind_id context name] returns the MDKind ID that corresponds to the 178 | name [name] in the context [context]. See the function 179 | [llvm::LLVMContext::getMDKindID]. *) 180 | val mdkind_id : llcontext -> string -> int 181 | 182 | 183 | (** {6 Modules} *) 184 | 185 | (** [create_module context id] creates a module with the supplied module ID in 186 | the context [context]. Modules are not garbage collected; it is mandatory 187 | to call {!dispose_module} to free memory. See the constructor 188 | [llvm::Module::Module]. *) 189 | val create_module : llcontext -> string -> llmodule 190 | 191 | (** [dispose_module m] destroys a module [m] and all of the IR objects it 192 | contained. All references to subordinate objects are invalidated; 193 | referencing them will invoke undefined behavior. See the destructor 194 | [llvm::Module::~Module]. *) 195 | val dispose_module : llmodule -> unit 196 | 197 | (** [target_triple m] is the target specifier for the module [m], something like 198 | [i686-apple-darwin8]. See the method [llvm::Module::getTargetTriple]. *) 199 | (* 200 | val target_triple: llmodule -> string 201 | *) 202 | 203 | (** [set_target_triple triple m] changes the target specifier for the module [m] to 204 | the string [triple]. See the method [llvm::Module::setTargetTriple]. *) 205 | (* 206 | val set_target_triple: string -> llmodule -> unit 207 | *) 208 | 209 | (** [data_layout m] is the data layout specifier for the module [m], something 210 | like [e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-...-a0:0:64-f80:128:128]. See the 211 | method [llvm::Module::getDataLayout]. *) 212 | (* 213 | val data_layout: llmodule -> string 214 | *) 215 | 216 | (** [set_data_layout s m] changes the data layout specifier for the module [m] 217 | to the string [s]. See the method [llvm::Module::setDataLayout]. *) 218 | (* 219 | val set_data_layout: string -> llmodule -> unit 220 | *) 221 | 222 | (** [dump_module m] prints the .ll representation of the module [m] to standard 223 | error. See the method [llvm::Module::dump]. *) 224 | (* 225 | val dump_module : llmodule -> unit 226 | *) 227 | 228 | (** [set_module_inline_asm m asm] sets the inline assembler for the module. See 229 | the method [llvm::Module::setModuleInlineAsm]. *) 230 | (* 231 | val set_module_inline_asm : llmodule -> string -> unit 232 | *) 233 | 234 | (** [module_context m] returns the context of the specified module. 235 | * See the method [llvm::Module::getContext] *) 236 | val module_context : llmodule -> llcontext 237 | 238 | (** {6 Types} *) 239 | 240 | (** [classify_type ty] returns the {!TypeKind.t} corresponding to the type [ty]. 241 | See the method [llvm::Type::getTypeID]. *) 242 | val classify_type : lltype -> TypeKind.t 243 | 244 | (** [type_is_sized ty] returns whether the type has a size or not. 245 | * If it doesn't then it is not safe to call the [TargetData::] methods on it. 246 | * *) 247 | (* 248 | val type_is_sized : lltype -> bool 249 | *) 250 | 251 | (** [type_context ty] returns the {!llcontext} corresponding to the type [ty]. 252 | See the method [llvm::Type::getContext]. *) 253 | val type_context : lltype -> llcontext 254 | 255 | (** [string_of_lltype ty] returns a string describing the type [ty]. *) 256 | val string_of_lltype : lltype -> string 257 | 258 | (** {7 Operations on integer types} *) 259 | 260 | (** [i1_type c] returns an integer type of bitwidth 1 in the context [c]. See 261 | [llvm::Type::Int1Ty]. *) 262 | val i1_type : llcontext -> lltype 263 | 264 | (** [i8_type c] returns an integer type of bitwidth 8 in the context [c]. See 265 | [llvm::Type::Int8Ty]. *) 266 | val i8_type : llcontext -> lltype 267 | 268 | (** [i16_type c] returns an integer type of bitwidth 16 in the context [c]. See 269 | [llvm::Type::Int16Ty]. *) 270 | val i16_type : llcontext -> lltype 271 | 272 | (** [i32_type c] returns an integer type of bitwidth 32 in the context [c]. See 273 | [llvm::Type::Int32Ty]. *) 274 | val i32_type : llcontext -> lltype 275 | 276 | (** [i64_type c] returns an integer type of bitwidth 64 in the context [c]. See 277 | [llvm::Type::Int64Ty]. *) 278 | val i64_type : llcontext -> lltype 279 | 280 | (** [integer_type c n] returns an integer type of bitwidth [n] in the context 281 | [c]. See the method [llvm::IntegerType::get]. *) 282 | val integer_type : llcontext -> int -> lltype 283 | 284 | (** [integer_bitwidth c ty] returns the number of bits in the integer type [ty] 285 | in the context [c]. See the method [llvm::IntegerType::getBitWidth]. *) 286 | val integer_bitwidth : lltype -> int 287 | 288 | 289 | (** {7 Operations on real types} *) 290 | 291 | (** [float_type c] returns the IEEE 32-bit floating point type in the context 292 | [c]. See [llvm::Type::FloatTy]. *) 293 | val float_type : llcontext -> lltype 294 | 295 | (** [double_type c] returns the IEEE 64-bit floating point type in the context 296 | [c]. See [llvm::Type::DoubleTy]. *) 297 | val double_type : llcontext -> lltype 298 | 299 | (** [x86fp80_type c] returns the x87 80-bit floating point type in the context 300 | [c]. See [llvm::Type::X86_FP80Ty]. *) 301 | (* 302 | val x86fp80_type : llcontext -> lltype 303 | *) 304 | 305 | (** [fp128_type c] returns the IEEE 128-bit floating point type in the context 306 | [c]. See [llvm::Type::FP128Ty]. *) 307 | (* 308 | val fp128_type : llcontext -> lltype 309 | *) 310 | 311 | (** [ppc_fp128_type c] returns the PowerPC 128-bit floating point type in the 312 | context [c]. See [llvm::Type::PPC_FP128Ty]. *) 313 | (* 314 | val ppc_fp128_type : llcontext -> lltype 315 | *) 316 | 317 | (** {7 Operations on function types} *) 318 | 319 | (** [function_type ret_ty param_tys] returns the function type returning 320 | [ret_ty] and taking [param_tys] as parameters. 321 | See the method [llvm::FunctionType::get]. *) 322 | val function_type : lltype -> lltype list -> lltype 323 | 324 | (** [var_arg_function_type ret_ty param_tys] is just like 325 | [function_type ret_ty param_tys] except that it returns the function type 326 | which also takes a variable number of arguments. 327 | See the method [llvm::FunctionType::get]. *) 328 | val var_arg_function_type : lltype -> lltype list -> lltype 329 | 330 | (** [is_var_arg fty] returns [true] if [fty] is a varargs function type, [false] 331 | otherwise. See the method [llvm::FunctionType::isVarArg]. *) 332 | val is_var_arg : lltype -> bool 333 | 334 | (** [return_type fty] gets the return type of the function type [fty]. 335 | See the method [llvm::FunctionType::getReturnType]. *) 336 | val return_type : lltype -> lltype 337 | 338 | (** [param_types fty] gets the parameter types of the function type [fty]. 339 | See the method [llvm::FunctionType::getParamType]. *) 340 | (* 341 | val param_types : lltype -> lltype array 342 | *) 343 | 344 | (** {7 Operations on struct types} *) 345 | 346 | (** [struct_type context tys] returns the structure type in the context 347 | [context] containing in the types in the array [tys]. See the method 348 | [llvm::StructType::get]. *) 349 | (* 350 | val struct_type : llcontext -> lltype array -> lltype 351 | *) 352 | 353 | (** [packed_struct_type context ys] returns the packed structure type in the 354 | context [context] containing in the types in the array [tys]. See the method 355 | [llvm::StructType::get]. *) 356 | (* 357 | val packed_struct_type : llcontext -> lltype array -> lltype 358 | *) 359 | 360 | (** [struct_name ty] returns the name of the named structure type [ty], 361 | * or None if the structure type is not named *) 362 | (* 363 | val struct_name : lltype -> string option 364 | *) 365 | 366 | (** [named_struct_type context name] returns the named structure type [name] 367 | * in the context [context]. 368 | * See the method [llvm::StructType::get]. *) 369 | (* 370 | val named_struct_type : llcontext -> string -> lltype 371 | *) 372 | 373 | (** [struct_set_body ty elts ispacked] sets the body of the named struct [ty] 374 | * to the [elts] elements. 375 | * See the moethd [llvm::StructType::setBody]. *) 376 | (* 377 | val struct_set_body : lltype -> lltype array -> bool -> unit 378 | *) 379 | 380 | (** [struct_element_types sty] returns the constituent types of the struct type 381 | [sty]. See the method [llvm::StructType::getElementType]. *) 382 | (* 383 | val struct_element_types : lltype -> lltype array 384 | *) 385 | 386 | (** [is_packed sty] returns [true] if the structure type [sty] is packed, 387 | [false] otherwise. See the method [llvm::StructType::isPacked]. *) 388 | (* 389 | val is_packed : lltype -> bool 390 | *) 391 | 392 | (** [is_opaque sty] returns [true] if the structure type [sty] is opaque. 393 | [false] otherwise. See the method [llvm::StructType::isOpaque]. *) 394 | (* 395 | val is_opaque : lltype -> bool 396 | *) 397 | 398 | (** {7 Operations on pointer, vector, and array types} *) 399 | 400 | (** [array_type ty n] returns the array type containing [n] elements of type 401 | [ty]. See the method [llvm::ArrayType::get]. *) 402 | (* 403 | val array_type : lltype -> int -> lltype 404 | *) 405 | 406 | (** [pointer_type ty] returns the pointer type referencing objects of type 407 | [ty] in the default address space (0). 408 | See the method [llvm::PointerType::getUnqual]. *) 409 | val pointer_type : lltype -> lltype 410 | 411 | (** [qualified_pointer_type ty as] returns the pointer type referencing objects 412 | of type [ty] in address space [as]. 413 | See the method [llvm::PointerType::get]. *) 414 | (* 415 | val qualified_pointer_type : lltype -> int -> lltype 416 | *) 417 | 418 | (** [vector_type ty n] returns the array type containing [n] elements of the 419 | primitive type [ty]. See the method [llvm::ArrayType::get]. *) 420 | (* 421 | val vector_type : lltype -> int -> lltype 422 | *) 423 | 424 | (** [element_type ty] returns the element type of the pointer, vector, or array 425 | type [ty]. See the method [llvm::SequentialType::get]. *) 426 | val element_type : lltype -> lltype 427 | 428 | (** [element_type aty] returns the element count of the array type [aty]. 429 | See the method [llvm::ArrayType::getNumElements]. *) 430 | val array_length : lltype -> int 431 | 432 | (** [address_space pty] returns the address space qualifier of the pointer type 433 | [pty]. See the method [llvm::PointerType::getAddressSpace]. *) 434 | (* 435 | val address_space : lltype -> int 436 | *) 437 | 438 | (** [vector_size ty] returns the element count of the vector type [ty]. 439 | See the method [llvm::VectorType::getNumElements]. *) 440 | (* 441 | val vector_size : lltype -> int 442 | *) 443 | 444 | (** {7 Operations on other types} *) 445 | 446 | (** [void_type c] creates a type of a function which does not return any 447 | value in the context [c]. See [llvm::Type::VoidTy]. *) 448 | (* 449 | val void_type : llcontext -> lltype 450 | *) 451 | 452 | (** [label_type c] creates a type of a basic block in the context [c]. See 453 | [llvm::Type::LabelTy]. *) 454 | (* 455 | val label_type : llcontext -> lltype 456 | *) 457 | 458 | (** [type_by_name m name] returns the specified type from the current module 459 | * if it exists. 460 | * See the method [llvm::Module::getTypeByName] *) 461 | (* 462 | val type_by_name : llmodule -> string -> lltype option 463 | *) 464 | 465 | (* {6 Values} *) 466 | 467 | (** [type_of v] returns the type of the value [v]. 468 | See the method [llvm::Value::getType]. *) 469 | val type_of : llvalue -> lltype 470 | 471 | (* 472 | val classify_value : llvalue -> ValueKind.t 473 | *) 474 | 475 | (** [value_name v] returns the name of the value [v]. For global values, this is 476 | the symbol name. For instructions and basic blocks, it is the SSA register 477 | name. It is meaningless for constants. 478 | See the method [llvm::Value::getName]. *) 479 | (* 480 | val value_name : llvalue -> string 481 | *) 482 | 483 | (** [set_value_name n v] sets the name of the value [v] to [n]. See the method 484 | [llvm::Value::setName]. *) 485 | (* 486 | val set_value_name : string -> llvalue -> unit 487 | *) 488 | 489 | (** [dump_value v] prints the .ll representation of the value [v] to standard 490 | error. See the method [llvm::Value::dump]. *) 491 | (* 492 | val dump_value : llvalue -> unit 493 | *) 494 | 495 | (** [replace_all_uses_with old new] replaces all uses of the value [old] 496 | * with the value [new]. See the method [llvm::Value::replaceAllUsesWith]. *) 497 | (* 498 | val replace_all_uses_with : llvalue -> llvalue -> unit 499 | *) 500 | 501 | (* {6 Uses} *) 502 | 503 | (** [use_begin v] returns the first position in the use list for the value [v]. 504 | [use_begin] and [use_succ] can e used to iterate over the use list in order. 505 | See the method [llvm::Value::use_begin]. *) 506 | (* 507 | val use_begin : llvalue -> lluse option 508 | *) 509 | 510 | (** [use_succ u] returns the use list position succeeding [u]. 511 | See the method [llvm::use_value_iterator::operator++]. *) 512 | (* 513 | val use_succ : lluse -> lluse option 514 | *) 515 | 516 | (** [user u] returns the user of the use [u]. 517 | See the method [llvm::Use::getUser]. *) 518 | (* 519 | val user : lluse -> llvalue 520 | *) 521 | 522 | (** [used_value u] returns the usee of the use [u]. 523 | See the method [llvm::Use::getUsedValue]. *) 524 | (* 525 | val used_value : lluse -> llvalue 526 | *) 527 | 528 | (** [iter_uses f v] applies function [f] to each of the users of the value [v] 529 | in order. Tail recursive. *) 530 | (* 531 | val iter_uses : (lluse -> unit) -> llvalue -> unit 532 | *) 533 | 534 | (** [fold_left_uses f init v] is [f (... (f init u1) ...) uN] where 535 | [u1,...,uN] are the users of the value [v]. Tail recursive. *) 536 | (* 537 | val fold_left_uses : ('a -> lluse -> 'a) -> 'a -> llvalue -> 'a 538 | *) 539 | 540 | (** [fold_right_uses f v init] is [f u1 (... (f uN init) ...)] where 541 | [u1,...,uN] are the users of the value [v]. Not tail recursive. *) 542 | (* 543 | val fold_right_uses : (lluse -> 'a -> 'a) -> llvalue -> 'a -> 'a 544 | *) 545 | 546 | (* {6 Users} *) 547 | 548 | (** [operand v i] returns the operand at index [i] for the value [v]. See the 549 | method [llvm::User::getOperand]. *) 550 | (* 551 | val operand : llvalue -> int -> llvalue 552 | *) 553 | 554 | (** [set_operand v i o] sets the operand of the value [v] at the index [i] to 555 | the value [o]. 556 | See the method [llvm::User::setOperand]. *) 557 | (* 558 | val set_operand : llvalue -> int -> llvalue -> unit 559 | *) 560 | 561 | (** [num_operands v] returns the number of operands for the value [v]. 562 | See the method [llvm::User::getNumOperands]. *) 563 | (* 564 | val num_operands : llvalue -> int 565 | *) 566 | 567 | (** {7 Operations on constants of (mostly) any type} *) 568 | 569 | (** [is_constant v] returns [true] if the value [v] is a constant, [false] 570 | otherwise. Similar to [llvm::isa]. *) 571 | (* 572 | val is_constant : llvalue -> bool 573 | *) 574 | 575 | (** [const_null ty] returns the constant null (zero) of the type [ty]. 576 | See the method [llvm::Constant::getNullValue]. *) 577 | (* 578 | val const_null : lltype -> llvalue 579 | *) 580 | 581 | (** [const_all_ones ty] returns the constant '-1' of the integer or vector type 582 | [ty]. See the method [llvm::Constant::getAllOnesValue]. *) 583 | (* 584 | val const_all_ones : (*int|vec*)lltype -> llvalue 585 | *) 586 | 587 | (** [const_pointer_null ty] returns the constant null (zero) pointer of the type 588 | [ty]. See the method [llvm::ConstantPointerNull::get]. *) 589 | (* 590 | val const_pointer_null : lltype -> llvalue 591 | *) 592 | 593 | (** [undef ty] returns the undefined value of the type [ty]. 594 | See the method [llvm::UndefValue::get]. *) 595 | (* 596 | val undef : lltype -> llvalue 597 | *) 598 | 599 | (** [is_null v] returns [true] if the value [v] is the null (zero) value. 600 | See the method [llvm::Constant::isNullValue]. *) 601 | (* 602 | val is_null : llvalue -> bool 603 | *) 604 | 605 | (** [is_undef v] returns [true] if the value [v] is an undefined value, [false] 606 | otherwise. Similar to [llvm::isa]. *) 607 | (* 608 | val is_undef : llvalue -> bool 609 | *) 610 | 611 | (* 612 | val constexpr_opcode : llvalue -> Opcode.t 613 | *) 614 | 615 | (** {7 Operations on instructions} *) 616 | 617 | (** [has_metadata i] returns whether or not the instruction [i] has any 618 | metadata attached to it. See the function 619 | [llvm::Instruction::hasMetadata]. *) 620 | (* 621 | val has_metadata : llvalue -> bool 622 | *) 623 | 624 | (** [metadata i kind] optionally returns the metadata associated with the 625 | kind [kind] in the instruction [i] See the function 626 | [llvm::Instruction::getMetadata]. *) 627 | (* 628 | val metadata : llvalue -> int -> llvalue option 629 | *) 630 | 631 | (** [set_metadata i kind md] sets the metadata [md] of kind [kind] in the 632 | instruction [i]. See the function [llvm::Instruction::setMetadata]. *) 633 | (* 634 | val set_metadata : llvalue -> int -> llvalue -> unit 635 | *) 636 | 637 | (** [clear_metadata i kind] clears the metadata of kind [kind] in the 638 | instruction [i]. See the function [llvm::Instruction::setMetadata]. *) 639 | (* 640 | val clear_metadata : llvalue -> int -> unit 641 | *) 642 | 643 | (** {7 Operations on metadata} *) 644 | 645 | (** [mdstring c s] returns the MDString of the string [s] in the context [c]. 646 | See the method [llvm::MDNode::get]. *) 647 | (* 648 | val mdstring : llcontext -> string -> llvalue 649 | *) 650 | 651 | (** [mdnode c elts] returns the MDNode containing the values [elts] in the 652 | context [c]. 653 | See the method [llvm::MDNode::get]. *) 654 | (* 655 | val mdnode : llcontext -> llvalue array -> llvalue 656 | *) 657 | 658 | (** [get_mdstring v] returns the MDString. 659 | * See the method [llvm::MDString::getString] *) 660 | (* 661 | val get_mdstring : llvalue -> string option 662 | *) 663 | 664 | (** [get_named_metadata m name] return all the MDNodes belonging to the named 665 | * metadata (if any). 666 | * See the method [llvm::NamedMDNode::getOperand]. *) 667 | (* 668 | val get_named_metadata : llmodule -> string -> llvalue array 669 | *) 670 | 671 | (** {7 Operations on scalar constants} *) 672 | 673 | (** [const_int ty i] returns the integer constant of type [ty] and value [i]. 674 | See the method [llvm::ConstantInt::get]. *) 675 | val const_int : lltype -> int -> llvalue 676 | 677 | (** [const_of_int64 ty i] returns the integer constant of type [ty] and value 678 | [i]. See the method [llvm::ConstantInt::get]. *) 679 | (* 680 | val const_of_int64 : lltype -> Int64.t -> bool -> llvalue 681 | *) 682 | 683 | (** [int64_of_const c] returns the int64 value of the [c] constant integer. 684 | * None is returned if this is not an integer constant, or bitwidth exceeds 64. 685 | * See the method [llvm::ConstantInt::getSExtValue].*) 686 | (* 687 | val int64_of_const : llvalue -> Int64.t option 688 | *) 689 | 690 | (** [const_int_of_string ty s r] returns the integer constant of type [ty] and 691 | * value [s], with the radix [r]. See the method [llvm::ConstantInt::get]. *) 692 | (* 693 | val const_int_of_string : lltype -> string -> int -> llvalue 694 | *) 695 | 696 | (** [const_float ty n] returns the floating point constant of type [ty] and 697 | value [n]. See the method [llvm::ConstantFP::get]. *) 698 | val const_float : lltype -> real -> llvalue 699 | 700 | (** [const_float_of_string ty s] returns the floating point constant of type 701 | [ty] and value [n]. See the method [llvm::ConstantFP::get]. *) 702 | (* 703 | val const_float_of_string : lltype -> string -> llvalue 704 | *) 705 | 706 | (** {7 Operations on composite constants} *) 707 | 708 | (** [const_string c s] returns the constant [i8] array with the values of the 709 | characters in the string [s] in the context [c]. The array is not 710 | null-terminated (but see {!const_stringz}). This value can in turn be used 711 | as the initializer for a global variable. See the method 712 | [llvm::ConstantArray::get]. *) 713 | val const_string : llcontext -> string -> llvalue 714 | 715 | (** [const_stringz c s] returns the constant [i8] array with the values of the 716 | characters in the string [s] and a null terminator in the context [c]. This 717 | value can in turn be used as the initializer for a global variable. 718 | See the method [llvm::ConstantArray::get]. *) 719 | val const_stringz : llcontext -> string -> llvalue 720 | 721 | (** [const_array ty elts] returns the constant array of type 722 | [array_type ty (Array.length elts)] and containing the values [elts]. 723 | This value can in turn be used as the initializer for a global variable. 724 | See the method [llvm::ConstantArray::get]. *) 725 | (* 726 | val const_array : lltype -> llvalue array -> llvalue 727 | *) 728 | 729 | (** [const_struct context elts] returns the structured constant of type 730 | [struct_type (Array.map type_of elts)] and containing the values [elts] 731 | in the context [context]. This value can in turn be used as the initializer 732 | for a global variable. See the method [llvm::ConstantStruct::getAnon]. *) 733 | (* 734 | val const_struct : llcontext -> llvalue array -> llvalue 735 | *) 736 | 737 | (** [const_named_struct namedty elts] returns the structured constant of type 738 | [namedty] (which must be a named structure type) and containing the values [elts]. 739 | This value can in turn be used as the initializer 740 | for a global variable. See the method [llvm::ConstantStruct::get]. *) 741 | (* 742 | val const_named_struct : lltype -> llvalue array -> llvalue 743 | *) 744 | 745 | (** [const_packed_struct context elts] returns the structured constant of 746 | type {!packed_struct_type} [(Array.map type_of elts)] and containing the 747 | values [elts] in the context [context]. This value can in turn be used as 748 | the initializer for a global variable. See the method 749 | [llvm::ConstantStruct::get]. *) 750 | (* 751 | val const_packed_struct : llcontext -> llvalue array -> llvalue 752 | *) 753 | 754 | (** [const_vector elts] returns the vector constant of type 755 | [vector_type (type_of elts.(0)) (Array.length elts)] and containing the 756 | values [elts]. See the method [llvm::ConstantVector::get]. *) 757 | (* 758 | val const_vector : llvalue array -> llvalue 759 | *) 760 | 761 | (** {7 Constant expressions} *) 762 | 763 | (** [align_of ty] returns the alignof constant for the type [ty]. This is 764 | equivalent to [const_ptrtoint (const_gep (const_null (pointer_type {i8,ty})) 765 | (const_int i32_type 0) (const_int i32_type 1)) i32_type], but considerably 766 | more readable. See the method [llvm::ConstantExpr::getAlignOf]. *) 767 | (* 768 | val align_of : lltype -> llvalue 769 | *) 770 | 771 | (** [size_of ty] returns the sizeof constant for the type [ty]. This is 772 | equivalent to [const_ptrtoint (const_gep (const_null (pointer_type ty)) 773 | (const_int i32_type 1)) i64_type], but considerably more readable. 774 | See the method [llvm::ConstantExpr::getSizeOf]. *) 775 | (* 776 | val size_of : lltype -> llvalue 777 | *) 778 | 779 | (** [const_neg c] returns the arithmetic negation of the constant [c]. 780 | See the method [llvm::ConstantExpr::getNeg]. *) 781 | (* 782 | val const_neg : llvalue -> llvalue 783 | *) 784 | 785 | (** [const_nsw_neg c] returns the arithmetic negation of the constant [c] with 786 | no signed wrapping. The result is undefined if the negation overflows. 787 | See the method [llvm::ConstantExpr::getNSWNeg]. *) 788 | (* 789 | val const_nsw_neg : llvalue -> llvalue 790 | *) 791 | 792 | (** [const_nuw_neg c] returns the arithmetic negation of the constant [c] with 793 | no unsigned wrapping. The result is undefined if the negation overflows. 794 | See the method [llvm::ConstantExpr::getNUWNeg]. *) 795 | (* 796 | val const_nuw_neg : llvalue -> llvalue 797 | *) 798 | 799 | (** [const_fneg c] returns the arithmetic negation of the constant float [c]. 800 | See the method [llvm::ConstantExpr::getFNeg]. *) 801 | (* 802 | val const_fneg : llvalue -> llvalue 803 | *) 804 | 805 | (** [const_not c] returns the bitwise inverse of the constant [c]. 806 | See the method [llvm::ConstantExpr::getNot]. *) 807 | (* 808 | val const_not : llvalue -> llvalue 809 | *) 810 | 811 | (** [const_add c1 c2] returns the constant sum of two constants. 812 | See the method [llvm::ConstantExpr::getAdd]. *) 813 | (* 814 | val const_add : llvalue -> llvalue -> llvalue 815 | *) 816 | 817 | (** [const_nsw_add c1 c2] returns the constant sum of two constants with no 818 | signed wrapping. The result is undefined if the sum overflows. 819 | See the method [llvm::ConstantExpr::getNSWAdd]. *) 820 | (* 821 | val const_nsw_add : llvalue -> llvalue -> llvalue 822 | *) 823 | 824 | (** [const_nuw_add c1 c2] returns the constant sum of two constants with no 825 | unsigned wrapping. The result is undefined if the sum overflows. 826 | See the method [llvm::ConstantExpr::getNSWAdd]. *) 827 | (* 828 | val const_nuw_add : llvalue -> llvalue -> llvalue 829 | *) 830 | 831 | (** [const_fadd c1 c2] returns the constant sum of two constant floats. 832 | See the method [llvm::ConstantExpr::getFAdd]. *) 833 | (* 834 | val const_fadd : llvalue -> llvalue -> llvalue 835 | *) 836 | 837 | (** [const_sub c1 c2] returns the constant difference, [c1 - c2], of two 838 | constants. See the method [llvm::ConstantExpr::getSub]. *) 839 | (* 840 | val const_sub : llvalue -> llvalue -> llvalue 841 | *) 842 | 843 | (** [const_nsw_sub c1 c2] returns the constant difference of two constants with 844 | no signed wrapping. The result is undefined if the sum overflows. 845 | See the method [llvm::ConstantExpr::getNSWSub]. *) 846 | (* 847 | val const_nsw_sub : llvalue -> llvalue -> llvalue 848 | *) 849 | 850 | (** [const_nuw_sub c1 c2] returns the constant difference of two constants with 851 | no unsigned wrapping. The result is undefined if the sum overflows. 852 | See the method [llvm::ConstantExpr::getNSWSub]. *) 853 | (* 854 | val const_nuw_sub : llvalue -> llvalue -> llvalue 855 | *) 856 | 857 | (** [const_fsub c1 c2] returns the constant difference, [c1 - c2], of two 858 | constant floats. See the method [llvm::ConstantExpr::getFSub]. *) 859 | (* 860 | val const_fsub : llvalue -> llvalue -> llvalue 861 | *) 862 | 863 | (** [const_mul c1 c2] returns the constant product of two constants. 864 | See the method [llvm::ConstantExpr::getMul]. *) 865 | (* 866 | val const_mul : llvalue -> llvalue -> llvalue 867 | *) 868 | 869 | (** [const_nsw_mul c1 c2] returns the constant product of two constants with 870 | no signed wrapping. The result is undefined if the sum overflows. 871 | See the method [llvm::ConstantExpr::getNSWMul]. *) 872 | (* 873 | val const_nsw_mul : llvalue -> llvalue -> llvalue 874 | *) 875 | 876 | (** [const_nuw_mul c1 c2] returns the constant product of two constants with 877 | no unsigned wrapping. The result is undefined if the sum overflows. 878 | See the method [llvm::ConstantExpr::getNSWMul]. *) 879 | (* 880 | val const_nuw_mul : llvalue -> llvalue -> llvalue 881 | *) 882 | 883 | (** [const_fmul c1 c2] returns the constant product of two constants floats. 884 | See the method [llvm::ConstantExpr::getFMul]. *) 885 | (* 886 | val const_fmul : llvalue -> llvalue -> llvalue 887 | *) 888 | 889 | (** [const_udiv c1 c2] returns the constant quotient [c1 / c2] of two unsigned 890 | integer constants. 891 | See the method [llvm::ConstantExpr::getUDiv]. *) 892 | (* 893 | val const_udiv : llvalue -> llvalue -> llvalue 894 | *) 895 | 896 | (** [const_sdiv c1 c2] returns the constant quotient [c1 / c2] of two signed 897 | integer constants. 898 | See the method [llvm::ConstantExpr::getSDiv]. *) 899 | (* 900 | val const_sdiv : llvalue -> llvalue -> llvalue 901 | *) 902 | 903 | (** [const_exact_sdiv c1 c2] returns the constant quotient [c1 / c2] of two 904 | signed integer constants. The result is undefined if the result is rounded 905 | or overflows. See the method [llvm::ConstantExpr::getExactSDiv]. *) 906 | (* 907 | val const_exact_sdiv : llvalue -> llvalue -> llvalue 908 | *) 909 | 910 | (** [const_fdiv c1 c2] returns the constant quotient [c1 / c2] of two floating 911 | point constants. 912 | See the method [llvm::ConstantExpr::getFDiv]. *) 913 | (* 914 | val const_fdiv : llvalue -> llvalue -> llvalue 915 | *) 916 | 917 | (** [const_urem c1 c2] returns the constant remainder [c1 MOD c2] of two 918 | unsigned integer constants. 919 | See the method [llvm::ConstantExpr::getURem]. *) 920 | (* 921 | val const_urem : llvalue -> llvalue -> llvalue 922 | *) 923 | (** [const_srem c1 c2] returns the constant remainder [c1 MOD c2] of two 924 | signed integer constants. 925 | See the method [llvm::ConstantExpr::getSRem]. *) 926 | (* 927 | val const_srem : llvalue -> llvalue -> llvalue 928 | *) 929 | 930 | (** [const_frem c1 c2] returns the constant remainder [c1 MOD c2] of two 931 | signed floating point constants. 932 | See the method [llvm::ConstantExpr::getFRem]. *) 933 | (* 934 | val const_frem : llvalue -> llvalue -> llvalue 935 | *) 936 | 937 | (** [const_and c1 c2] returns the constant bitwise [AND] of two integer 938 | constants. 939 | See the method [llvm::ConstantExpr::getAnd]. *) 940 | (* 941 | val const_and : llvalue -> llvalue -> llvalue 942 | *) 943 | 944 | (** [const_or c1 c2] returns the constant bitwise [OR] of two integer 945 | constants. 946 | See the method [llvm::ConstantExpr::getOr]. *) 947 | (* 948 | val const_or : llvalue -> llvalue -> llvalue 949 | *) 950 | 951 | (** [const_xor c1 c2] returns the constant bitwise [XOR] of two integer 952 | constants. 953 | See the method [llvm::ConstantExpr::getXor]. *) 954 | (* 955 | val const_xor : llvalue -> llvalue -> llvalue 956 | *) 957 | 958 | (** [const_icmp pred c1 c2] returns the constant comparison of two integer 959 | constants, [c1 pred c2]. 960 | See the method [llvm::ConstantExpr::getICmp]. *) 961 | (* 962 | val const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue 963 | *) 964 | 965 | (** [const_fcmp pred c1 c2] returns the constant comparison of two floating 966 | point constants, [c1 pred c2]. 967 | See the method [llvm::ConstantExpr::getFCmp]. *) 968 | (* 969 | val const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue 970 | *) 971 | 972 | (** [const_shl c1 c2] returns the constant integer [c1] left-shifted by the 973 | constant integer [c2]. 974 | See the method [llvm::ConstantExpr::getShl]. *) 975 | (* 976 | val const_shl : llvalue -> llvalue -> llvalue 977 | *) 978 | 979 | (** [const_lshr c1 c2] returns the constant integer [c1] right-shifted by the 980 | constant integer [c2] with zero extension. 981 | See the method [llvm::ConstantExpr::getLShr]. *) 982 | (* 983 | val const_lshr : llvalue -> llvalue -> llvalue 984 | *) 985 | 986 | (** [const_ashr c1 c2] returns the constant integer [c1] right-shifted by the 987 | constant integer [c2] with sign extension. 988 | See the method [llvm::ConstantExpr::getAShr]. *) 989 | (* 990 | val const_ashr : llvalue -> llvalue -> llvalue 991 | *) 992 | 993 | (** [const_gep pc indices] returns the constant [getElementPtr] of [p1] with the 994 | constant integers indices from the array [indices]. 995 | See the method [llvm::ConstantExpr::getGetElementPtr]. *) 996 | (* 997 | val const_gep : llvalue -> llvalue array -> llvalue 998 | *) 999 | 1000 | (** [const_in_bounds_gep pc indices] returns the constant [getElementPtr] of [p1] 1001 | with the constant integers indices from the array [indices]. 1002 | See the method [llvm::ConstantExpr::getInBoundsGetElementPtr]. *) 1003 | (* 1004 | val const_in_bounds_gep : llvalue -> llvalue array -> llvalue 1005 | *) 1006 | 1007 | (** [const_trunc c ty] returns the constant truncation of integer constant [c] 1008 | to the smaller integer type [ty]. 1009 | See the method [llvm::ConstantExpr::getTrunc]. *) 1010 | (* 1011 | val const_trunc : llvalue -> lltype -> llvalue 1012 | *) 1013 | 1014 | (** [const_sext c ty] returns the constant sign extension of integer constant 1015 | [c] to the larger integer type [ty]. 1016 | See the method [llvm::ConstantExpr::getSExt]. *) 1017 | (* 1018 | val const_sext : llvalue -> lltype -> llvalue 1019 | *) 1020 | 1021 | (** [const_zext c ty] returns the constant zero extension of integer constant 1022 | [c] to the larger integer type [ty]. 1023 | See the method [llvm::ConstantExpr::getZExt]. *) 1024 | (* 1025 | val const_zext : llvalue -> lltype -> llvalue 1026 | *) 1027 | 1028 | (** [const_fptrunc c ty] returns the constant truncation of floating point 1029 | constant [c] to the smaller floating point type [ty]. 1030 | See the method [llvm::ConstantExpr::getFPTrunc]. *) 1031 | (* 1032 | val const_fptrunc : llvalue -> lltype -> llvalue 1033 | *) 1034 | 1035 | (** [const_fpext c ty] returns the constant extension of floating point constant 1036 | [c] to the larger floating point type [ty]. 1037 | See the method [llvm::ConstantExpr::getFPExt]. *) 1038 | (* 1039 | val const_fpext : llvalue -> lltype -> llvalue 1040 | *) 1041 | 1042 | (** [const_uitofp c ty] returns the constant floating point conversion of 1043 | unsigned integer constant [c] to the floating point type [ty]. 1044 | See the method [llvm::ConstantExpr::getUIToFP]. *) 1045 | (* 1046 | val const_uitofp : llvalue -> lltype -> llvalue 1047 | *) 1048 | 1049 | (** [const_sitofp c ty] returns the constant floating point conversion of 1050 | signed integer constant [c] to the floating point type [ty]. 1051 | See the method [llvm::ConstantExpr::getSIToFP]. *) 1052 | (* 1053 | val const_sitofp : llvalue -> lltype -> llvalue 1054 | *) 1055 | 1056 | (** [const_fptoui c ty] returns the constant unsigned integer conversion of 1057 | floating point constant [c] to integer type [ty]. 1058 | See the method [llvm::ConstantExpr::getFPToUI]. *) 1059 | (* 1060 | val const_fptoui : llvalue -> lltype -> llvalue 1061 | *) 1062 | 1063 | (** [const_fptoui c ty] returns the constant unsigned integer conversion of 1064 | floating point constant [c] to integer type [ty]. 1065 | See the method [llvm::ConstantExpr::getFPToSI]. *) 1066 | (* 1067 | val const_fptosi : llvalue -> lltype -> llvalue 1068 | *) 1069 | 1070 | (** [const_ptrtoint c ty] returns the constant integer conversion of 1071 | pointer constant [c] to integer type [ty]. 1072 | See the method [llvm::ConstantExpr::getPtrToInt]. *) 1073 | (* 1074 | val const_ptrtoint : llvalue -> lltype -> llvalue 1075 | *) 1076 | 1077 | (** [const_inttoptr c ty] returns the constant pointer conversion of 1078 | integer constant [c] to pointer type [ty]. 1079 | See the method [llvm::ConstantExpr::getIntToPtr]. *) 1080 | (* 1081 | val const_inttoptr : llvalue -> lltype -> llvalue 1082 | *) 1083 | 1084 | (** [const_bitcast c ty] returns the constant bitwise conversion of constant [c] 1085 | to type [ty] of equal size. 1086 | See the method [llvm::ConstantExpr::getBitCast]. *) 1087 | (* 1088 | val const_bitcast : llvalue -> lltype -> llvalue 1089 | *) 1090 | 1091 | (** [const_zext_or_bitcast c ty] returns a constant zext or bitwise cast 1092 | conversion of constant [c] to type [ty]. 1093 | See the method [llvm::ConstantExpr::getZExtOrBitCast]. *) 1094 | (* 1095 | val const_zext_or_bitcast : llvalue -> lltype -> llvalue 1096 | *) 1097 | 1098 | (** [const_sext_or_bitcast c ty] returns a constant sext or bitwise cast 1099 | conversion of constant [c] to type [ty]. 1100 | See the method [llvm::ConstantExpr::getSExtOrBitCast]. *) 1101 | (* 1102 | val const_sext_or_bitcast : llvalue -> lltype -> llvalue 1103 | *) 1104 | 1105 | (** [const_trunc_or_bitcast c ty] returns a constant trunc or bitwise cast 1106 | conversion of constant [c] to type [ty]. 1107 | See the method [llvm::ConstantExpr::getTruncOrBitCast]. *) 1108 | (* 1109 | val const_trunc_or_bitcast : llvalue -> lltype -> llvalue 1110 | *) 1111 | 1112 | (** [const_pointercast c ty] returns a constant bitcast or a pointer-to-int 1113 | cast conversion of constant [c] to type [ty] of equal size. 1114 | See the method [llvm::ConstantExpr::getPointerCast]. *) 1115 | (* 1116 | val const_pointercast : llvalue -> lltype -> llvalue 1117 | *) 1118 | 1119 | (** [const_intcast c ty] returns a constant zext, bitcast, or trunc for integer 1120 | -> integer casts of constant [c] to type [ty]. 1121 | See the method [llvm::ConstantExpr::getIntCast]. *) 1122 | (* 1123 | val const_intcast : llvalue -> lltype -> llvalue 1124 | *) 1125 | 1126 | (** [const_fpcast c ty] returns a constant fpext, bitcast, or fptrunc for fp -> 1127 | fp casts of constant [c] to type [ty]. 1128 | See the method [llvm::ConstantExpr::getFPCast]. *) 1129 | (* 1130 | val const_fpcast : llvalue -> lltype -> llvalue 1131 | *) 1132 | 1133 | (** [const_select cond t f] returns the constant conditional which returns value 1134 | [t] if the boolean constant [cond] is true and the value [f] otherwise. 1135 | See the method [llvm::ConstantExpr::getSelect]. *) 1136 | (* 1137 | val const_select : llvalue -> llvalue -> llvalue -> llvalue 1138 | *) 1139 | 1140 | (** [const_extractelement vec i] returns the constant [i]th element of 1141 | constant vector [vec]. [i] must be a constant [i32] value unsigned less than 1142 | the size of the vector. 1143 | See the method [llvm::ConstantExpr::getExtractElement]. *) 1144 | (* 1145 | val const_extractelement : llvalue -> llvalue -> llvalue 1146 | *) 1147 | 1148 | (** [const_insertelement vec v i] returns the constant vector with the same 1149 | elements as constant vector [v] but the [i]th element replaced by the 1150 | constant [v]. [v] must be a constant value with the type of the vector 1151 | elements. [i] must be a constant [i32] value unsigned less than the size 1152 | of the vector. 1153 | See the method [llvm::ConstantExpr::getInsertElement]. *) 1154 | (* 1155 | val const_insertelement : llvalue -> llvalue -> llvalue -> llvalue 1156 | *) 1157 | 1158 | (** [const_shufflevector a b mask] returns a constant [shufflevector]. 1159 | See the LLVM Language Reference for details on the [shufflevector] 1160 | instruction. 1161 | See the method [llvm::ConstantExpr::getShuffleVector]. *) 1162 | (* 1163 | val const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue 1164 | *) 1165 | 1166 | (** [const_extractvalue agg idxs] returns the constant [idxs]th value of 1167 | constant aggregate [agg]. Each [idxs] must be less than the size of the 1168 | aggregate. See the method [llvm::ConstantExpr::getExtractValue]. *) 1169 | (* 1170 | val const_extractvalue : llvalue -> int array -> llvalue 1171 | *) 1172 | 1173 | (** [const_insertvalue agg val idxs] inserts the value [val] in the specified 1174 | indexs [idxs] in the aggegate [agg]. Each [idxs] must be less than the size 1175 | of the aggregate. See the method [llvm::ConstantExpr::getInsertValue]. *) 1176 | (* 1177 | val const_insertvalue : llvalue -> llvalue -> int array -> llvalue 1178 | *) 1179 | 1180 | (** [const_inline_asm ty asm con side align] inserts a inline assembly string. 1181 | See the method [llvm::InlineAsm::get]. *) 1182 | (* 1183 | val const_inline_asm : lltype -> string -> string -> bool -> bool -> 1184 | llvalue 1185 | *) 1186 | 1187 | (** [block_address f bb] returns the address of the basic block [bb] in the 1188 | function [f]. See the method [llvm::BasicBlock::get]. *) 1189 | (* 1190 | val block_address : llvalue -> llbasicblock -> llvalue 1191 | *) 1192 | 1193 | (** {7 Operations on global variables, functions, and aliases (globals)} *) 1194 | 1195 | (** [global_parent g] is the enclosing module of the global value [g]. 1196 | See the method [llvm::GlobalValue::getParent]. *) 1197 | (* 1198 | val global_parent : llvalue -> llmodule 1199 | *) 1200 | 1201 | (** [is_declaration g] returns [true] if the global value [g] is a declaration 1202 | only. Returns [false] otherwise. 1203 | See the method [llvm::GlobalValue::isDeclaration]. *) 1204 | (* 1205 | val is_declaration : llvalue -> bool 1206 | *) 1207 | 1208 | (** [linkage g] returns the linkage of the global value [g]. 1209 | See the method [llvm::GlobalValue::getLinkage]. *) 1210 | (* 1211 | val linkage : llvalue -> Linkage.t 1212 | *) 1213 | 1214 | (** [set_linkage l g] sets the linkage of the global value [g] to [l]. 1215 | See the method [llvm::GlobalValue::setLinkage]. *) 1216 | (* 1217 | val set_linkage : Linkage.t -> llvalue -> unit 1218 | *) 1219 | 1220 | (** [section g] returns the linker section of the global value [g]. 1221 | See the method [llvm::GlobalValue::getSection]. *) 1222 | (* 1223 | val section : llvalue -> string 1224 | *) 1225 | 1226 | (** [set_section s g] sets the linker section of the global value [g] to [s]. 1227 | See the method [llvm::GlobalValue::setSection]. *) 1228 | (* 1229 | val set_section : string -> llvalue -> unit 1230 | *) 1231 | 1232 | (** [visibility g] returns the linker visibility of the global value [g]. 1233 | See the method [llvm::GlobalValue::getVisibility]. *) 1234 | (* 1235 | val visibility : llvalue -> Visibility.t 1236 | *) 1237 | 1238 | (** [set_visibility v g] sets the linker visibility of the global value [g] to 1239 | [v]. See the method [llvm::GlobalValue::setVisibility]. *) 1240 | (* 1241 | val set_visibility : Visibility.t -> llvalue -> unit 1242 | *) 1243 | 1244 | (** [alignment g] returns the required alignment of the global value [g]. 1245 | See the method [llvm::GlobalValue::getAlignment]. *) 1246 | (* 1247 | val alignment : llvalue -> int 1248 | *) 1249 | 1250 | (** [set_alignment n g] sets the required alignment of the global value [g] to 1251 | [n] bytes. See the method [llvm::GlobalValue::setAlignment]. *) 1252 | (* 1253 | val set_alignment : int -> llvalue -> unit 1254 | *) 1255 | 1256 | (** {7 Operations on global variables} *) 1257 | 1258 | (** [declare_global ty name m] returns a new global variable of type [ty] and 1259 | with name [name] in module [m] in the default address space (0). If such a 1260 | global variable already exists, it is returned. If the type of the existing 1261 | global differs, then a bitcast to [ty] is returned. *) 1262 | (* 1263 | val declare_global : lltype -> string -> llmodule -> llvalue 1264 | *) 1265 | 1266 | (** [declare_qualified_global ty name addrspace m] returns a new global variable 1267 | of type [ty] and with name [name] in module [m] in the address space 1268 | [addrspace]. If such a global variable already exists, it is returned. If 1269 | the type of the existing global differs, then a bitcast to [ty] is 1270 | returned. *) 1271 | (* 1272 | val declare_qualified_global : lltype -> string -> int -> llmodule -> 1273 | llvalue 1274 | *) 1275 | 1276 | (** [define_global name init m] returns a new global with name [name] and 1277 | initializer [init] in module [m] in the default address space (0). If the 1278 | named global already exists, it is renamed. 1279 | See the constructor of [llvm::GlobalVariable]. *) 1280 | val define_global : string -> llvalue -> llmodule -> llvalue 1281 | 1282 | (** [define_qualified_global name init addrspace m] returns a new global with 1283 | name [name] and initializer [init] in module [m] in the address space 1284 | [addrspace]. If the named global already exists, it is renamed. 1285 | See the constructor of [llvm::GlobalVariable]. *) 1286 | (* 1287 | val define_qualified_global : string -> llvalue -> int -> llmodule -> 1288 | llvalue 1289 | *) 1290 | 1291 | (** [lookup_global name m] returns [Some g] if a global variable with name 1292 | [name] exists in module [m]. If no such global exists, returns [None]. 1293 | See the [llvm::GlobalVariable] constructor. *) 1294 | (* 1295 | val lookup_global : string -> llmodule -> llvalue option 1296 | *) 1297 | 1298 | (** [delete_global gv] destroys the global variable [gv]. 1299 | See the method [llvm::GlobalVariable::eraseFromParent]. *) 1300 | (* 1301 | val delete_global : llvalue -> unit 1302 | *) 1303 | 1304 | (** [global_begin m] returns the first position in the global variable list of 1305 | the module [m]. [global_begin] and [global_succ] can be used to iterate 1306 | over the global list in order. 1307 | See the method [llvm::Module::global_begin]. *) 1308 | (* 1309 | val global_begin : llmodule -> (llmodule, llvalue) llpos 1310 | *) 1311 | 1312 | (** [global_succ gv] returns the global variable list position succeeding 1313 | [Before gv]. 1314 | See the method [llvm::Module::global_iterator::operator++]. *) 1315 | (* 1316 | val global_succ : llvalue -> (llmodule, llvalue) llpos 1317 | *) 1318 | 1319 | (** [iter_globals f m] applies function [f] to each of the global variables of 1320 | module [m] in order. Tail recursive. *) 1321 | (* 1322 | val iter_globals : (llvalue -> unit) -> llmodule -> unit 1323 | *) 1324 | 1325 | (** [fold_left_globals f init m] is [f (... (f init g1) ...) gN] where 1326 | [g1,...,gN] are the global variables of module [m]. Tail recursive. *) 1327 | (* 1328 | val fold_left_globals : ('a -> llvalue -> 'a) -> 'a -> llmodule -> 'a 1329 | *) 1330 | 1331 | (** [global_end m] returns the last position in the global variable list of the 1332 | module [m]. [global_end] and [global_pred] can be used to iterate over the 1333 | global list in reverse. 1334 | See the method [llvm::Module::global_end]. *) 1335 | (* 1336 | val global_end : llmodule -> (llmodule, llvalue) llrev_pos 1337 | *) 1338 | 1339 | (** [global_pred gv] returns the global variable list position preceding 1340 | [After gv]. 1341 | See the method [llvm::Module::global_iterator::operator--]. *) 1342 | (* 1343 | val global_pred : llvalue -> (llmodule, llvalue) llrev_pos 1344 | *) 1345 | 1346 | (** [rev_iter_globals f m] applies function [f] to each of the global variables 1347 | of module [m] in reverse order. Tail recursive. *) 1348 | (* 1349 | val rev_iter_globals : (llvalue -> unit) -> llmodule -> unit 1350 | *) 1351 | 1352 | (** [fold_right_globals f m init] is [f g1 (... (f gN init) ...)] where 1353 | [g1,...,gN] are the global variables of module [m]. Tail recursive. *) 1354 | (* 1355 | val fold_right_globals : (llvalue -> 'a -> 'a) -> llmodule -> 'a -> 'a 1356 | *) 1357 | 1358 | (** [is_global_constant gv] returns [true] if the global variabile [gv] is a 1359 | constant. Returns [false] otherwise. 1360 | See the method [llvm::GlobalVariable::isConstant]. *) 1361 | (* 1362 | val is_global_constant : llvalue -> bool 1363 | *) 1364 | 1365 | (** [set_global_constant c gv] sets the global variable [gv] to be a constant if 1366 | [c] is [true] and not if [c] is [false]. 1367 | See the method [llvm::GlobalVariable::setConstant]. *) 1368 | (* 1369 | val set_global_constant : bool -> llvalue -> unit 1370 | *) 1371 | 1372 | (** [global_initializer gv] returns the initializer for the global variable 1373 | [gv]. See the method [llvm::GlobalVariable::getInitializer]. *) 1374 | (* 1375 | val global_initializer : llvalue -> llvalue 1376 | *) 1377 | 1378 | (** [set_initializer c gv] sets the initializer for the global variable 1379 | [gv] to the constant [c]. 1380 | See the method [llvm::GlobalVariable::setInitializer]. *) 1381 | (* 1382 | val set_initializer : llvalue -> llvalue -> unit 1383 | *) 1384 | 1385 | (** [remove_initializer gv] unsets the initializer for the global variable 1386 | [gv]. 1387 | See the method [llvm::GlobalVariable::setInitializer]. *) 1388 | (* 1389 | val remove_initializer : llvalue -> unit 1390 | *) 1391 | 1392 | (** [is_thread_local gv] returns [true] if the global variable [gv] is 1393 | thread-local and [false] otherwise. 1394 | See the method [llvm::GlobalVariable::isThreadLocal]. *) 1395 | (* 1396 | val is_thread_local : llvalue -> bool 1397 | *) 1398 | 1399 | (** [set_thread_local c gv] sets the global variable [gv] to be thread local if 1400 | [c] is [true] and not otherwise. 1401 | See the method [llvm::GlobalVariable::setThreadLocal]. *) 1402 | (* 1403 | val set_thread_local : bool -> llvalue -> unit 1404 | *) 1405 | 1406 | (** {7 Operations on aliases} *) 1407 | 1408 | (** [add_alias m t a n] inserts an alias in the module [m] with the type [t] and 1409 | the aliasee [a] with the name [n]. 1410 | See the constructor for [llvm::GlobalAlias]. *) 1411 | (* 1412 | val add_alias : llmodule -> lltype -> llvalue -> string -> llvalue 1413 | *) 1414 | 1415 | (** {7 Operations on functions} *) 1416 | 1417 | (** [declare_function name ty m] returns a new function of type [ty] and 1418 | with name [name] in module [m]. If such a function already exists, 1419 | it is returned. If the type of the existing function differs, then a bitcast 1420 | to [ty] is returned. *) 1421 | val declare_function : string -> lltype -> llmodule -> llvalue 1422 | 1423 | (** [define_function name ty m] creates a new function with name [name] and 1424 | type [ty] in module [m]. If the named function already exists, it is 1425 | renamed. An entry basic block is created in the function. 1426 | See the constructor of [llvm::GlobalVariable]. *) 1427 | val define_function : string -> lltype -> llmodule -> llvalue 1428 | 1429 | (** [lookup_function name m] returns [Some f] if a function with name 1430 | [name] exists in module [m]. If no such function exists, returns [None]. 1431 | See the method [llvm::Module] constructor. *) 1432 | (* 1433 | val lookup_function : string -> llmodule -> llvalue option 1434 | *) 1435 | 1436 | (** [delete_function f] destroys the function [f]. 1437 | See the method [llvm::Function::eraseFromParent]. *) 1438 | (* 1439 | val delete_function : llvalue -> unit 1440 | *) 1441 | 1442 | (** [function_begin m] returns the first position in the function list of the 1443 | module [m]. [function_begin] and [function_succ] can be used to iterate over 1444 | the function list in order. 1445 | See the method [llvm::Module::begin]. *) 1446 | (* 1447 | val function_begin : llmodule -> (llmodule, llvalue) llpos 1448 | *) 1449 | 1450 | (** [function_succ gv] returns the function list position succeeding 1451 | [Before gv]. 1452 | See the method [llvm::Module::iterator::operator++]. *) 1453 | (* 1454 | val function_succ : llvalue -> (llmodule, llvalue) llpos 1455 | *) 1456 | 1457 | (** [iter_functions f m] applies function [f] to each of the functions of module 1458 | [m] in order. Tail recursive. *) 1459 | (* 1460 | val iter_functions : (llvalue -> unit) -> llmodule -> unit 1461 | *) 1462 | 1463 | (** [fold_left_function f init m] is [f (... (f init f1) ...) fN] where 1464 | [f1,...,fN] are the functions of module [m]. Tail recursive. *) 1465 | (* 1466 | val fold_left_functions : ('a -> llvalue -> 'a) -> 'a -> llmodule -> 'a 1467 | *) 1468 | 1469 | (** [function_end m] returns the last position in the function list of 1470 | the module [m]. [function_end] and [function_pred] can be used to iterate 1471 | over the function list in reverse. 1472 | See the method [llvm::Module::end]. *) 1473 | (* 1474 | val function_end : llmodule -> (llmodule, llvalue) llrev_pos 1475 | *) 1476 | 1477 | (** [function_pred gv] returns the function list position preceding [After gv]. 1478 | See the method [llvm::Module::iterator::operator--]. *) 1479 | (* 1480 | val function_pred : llvalue -> (llmodule, llvalue) llrev_pos 1481 | *) 1482 | 1483 | (** [rev_iter_functions f fn] applies function [f] to each of the functions of 1484 | module [m] in reverse order. Tail recursive. *) 1485 | (* 1486 | val rev_iter_functions : (llvalue -> unit) -> llmodule -> unit 1487 | *) 1488 | 1489 | (** [fold_right_functions f m init] is [f (... (f init fN) ...) f1] where 1490 | [f1,...,fN] are the functions of module [m]. Tail recursive. *) 1491 | (* 1492 | val fold_right_functions : (llvalue -> 'a -> 'a) -> llmodule -> 'a -> 'a 1493 | *) 1494 | 1495 | (** [is_intrinsic f] returns true if the function [f] is an intrinsic. 1496 | See the method [llvm::Function::isIntrinsic]. *) 1497 | (* 1498 | val is_intrinsic : llvalue -> bool 1499 | *) 1500 | 1501 | (** [function_call_conv f] returns the calling convention of the function [f]. 1502 | See the method [llvm::Function::getCallingConv]. *) 1503 | (* 1504 | val function_call_conv : llvalue -> int 1505 | *) 1506 | 1507 | (** [set_function_call_conv cc f] sets the calling convention of the function 1508 | [f] to the calling convention numbered [cc]. 1509 | See the method [llvm::Function::setCallingConv]. *) 1510 | (* 1511 | val set_function_call_conv : int -> llvalue -> unit 1512 | *) 1513 | 1514 | (** [gc f] returns [Some name] if the function [f] has a garbage 1515 | collection algorithm specified and [None] otherwise. 1516 | See the method [llvm::Function::getGC]. *) 1517 | (* 1518 | val gc : llvalue -> string option 1519 | *) 1520 | 1521 | (** [set_gc gc f] sets the collection algorithm for the function [f] to 1522 | [gc]. See the method [llvm::Function::setGC]. *) 1523 | (* 1524 | val set_gc : string option -> llvalue -> unit 1525 | *) 1526 | 1527 | (** [add_function_attr f a] adds attribute [a] to the return type of function 1528 | [f]. *) 1529 | (* 1530 | val add_function_attr : llvalue -> Attribute.t -> unit 1531 | *) 1532 | 1533 | (** [function_attr f] returns the function attribute for the function [f]. 1534 | * See the method [llvm::Function::getAttributes] *) 1535 | (* 1536 | val function_attr : llvalue -> Attribute.t list 1537 | *) 1538 | 1539 | (** [remove_function_attr f a] removes attribute [a] from the return type of 1540 | function [f]. *) 1541 | (* 1542 | val remove_function_attr : llvalue -> Attribute.t -> unit 1543 | *) 1544 | 1545 | (** {7 Operations on params} *) 1546 | 1547 | (** [params f] returns the parameters of function [f]. 1548 | See the method [llvm::Function::getArgumentList]. *) 1549 | (* 1550 | val params : llvalue -> llvalue array 1551 | *) 1552 | 1553 | (** [param f n] returns the [n]th parameter of function [f]. 1554 | See the method [llvm::Function::getArgumentList]. *) 1555 | val param : llvalue -> int -> llvalue 1556 | 1557 | (** [param_attr p] returns the attributes of parameter [p]. 1558 | * See the methods [llvm::Function::getAttributes] and 1559 | * [llvm::Attributes::getParamAttributes] *) 1560 | (* 1561 | val param_attr : llvalue -> Attribute.t list 1562 | *) 1563 | 1564 | (** [param_parent p] returns the parent function that owns the parameter. 1565 | See the method [llvm::Argument::getParent]. *) 1566 | (* 1567 | val param_parent : llvalue -> llvalue 1568 | *) 1569 | 1570 | (** [param_begin f] returns the first position in the parameter list of the 1571 | function [f]. [param_begin] and [param_succ] can be used to iterate over 1572 | the parameter list in order. 1573 | See the method [llvm::Function::arg_begin]. *) 1574 | (* 1575 | val param_begin : llvalue -> (llvalue, llvalue) llpos 1576 | *) 1577 | 1578 | (** [param_succ bb] returns the parameter list position succeeding 1579 | [Before bb]. 1580 | See the method [llvm::Function::arg_iterator::operator++]. *) 1581 | (* 1582 | val param_succ : llvalue -> (llvalue, llvalue) llpos 1583 | *) 1584 | 1585 | (** [iter_params f fn] applies function [f] to each of the parameters 1586 | of function [fn] in order. Tail recursive. *) 1587 | (* 1588 | val iter_params : (llvalue -> unit) -> llvalue -> unit 1589 | *) 1590 | 1591 | (** [fold_left_params f init fn] is [f (... (f init b1) ...) bN] where 1592 | [b1,...,bN] are the parameters of function [fn]. Tail recursive. *) 1593 | (* 1594 | val fold_left_params : ('a -> llvalue -> 'a) -> 'a -> llvalue -> 'a 1595 | *) 1596 | 1597 | (** [param_end f] returns the last position in the parameter list of 1598 | the function [f]. [param_end] and [param_pred] can be used to iterate 1599 | over the parameter list in reverse. 1600 | See the method [llvm::Function::arg_end]. *) 1601 | (* 1602 | val param_end : llvalue -> (llvalue, llvalue) llrev_pos 1603 | *) 1604 | 1605 | (** [param_pred gv] returns the function list position preceding [After gv]. 1606 | See the method [llvm::Function::arg_iterator::operator--]. *) 1607 | (* 1608 | val param_pred : llvalue -> (llvalue, llvalue) llrev_pos 1609 | *) 1610 | 1611 | (** [rev_iter_params f fn] applies function [f] to each of the parameters 1612 | of function [fn] in reverse order. Tail recursive. *) 1613 | (* 1614 | val rev_iter_params : (llvalue -> unit) -> llvalue -> unit 1615 | *) 1616 | 1617 | (** [fold_right_params f fn init] is [f (... (f init bN) ...) b1] where 1618 | [b1,...,bN] are the parameters of function [fn]. Tail recursive. *) 1619 | (* 1620 | val fold_right_params : (llvalue -> 'a -> 'a) -> llvalue -> 'a -> 'a 1621 | *) 1622 | 1623 | (** [add_param p a] adds attribute [a] to parameter [p]. *) 1624 | (* 1625 | val add_param_attr : llvalue -> Attribute.t -> unit 1626 | *) 1627 | 1628 | (** [remove_param_attr p a] removes attribute [a] from parameter [p]. *) 1629 | (* 1630 | val remove_param_attr : llvalue -> Attribute.t -> unit 1631 | *) 1632 | 1633 | (** [set_param_alignment p a] set the alignment of parameter [p] to [a]. *) 1634 | (* 1635 | val set_param_alignment : llvalue -> int -> unit 1636 | *) 1637 | 1638 | (** {7 Operations on basic blocks} *) 1639 | 1640 | (** [basic_blocks fn] returns the basic blocks of the function [f]. 1641 | See the method [llvm::Function::getBasicBlockList]. *) 1642 | (* 1643 | val basic_blocks : llvalue -> llbasicblock array 1644 | *) 1645 | 1646 | (** [entry_block fn] returns the entry basic block of the function [f]. 1647 | See the method [llvm::Function::getEntryBlock]. *) 1648 | val entry_block : llvalue -> llbasicblock 1649 | 1650 | (** [delete_block bb] deletes the basic block [bb]. 1651 | See the method [llvm::BasicBlock::eraseFromParent]. *) 1652 | val delete_block : llbasicblock -> unit 1653 | 1654 | (** [append_block c name f] creates a new basic block named [name] at the end of 1655 | function [f] in the context [c]. 1656 | See the constructor of [llvm::BasicBlock]. *) 1657 | val append_block : llcontext -> string -> llvalue -> llbasicblock 1658 | 1659 | (** [insert_block c name bb] creates a new basic block named [name] before the 1660 | basic block [bb] in the context [c]. 1661 | See the constructor of [llvm::BasicBlock]. *) 1662 | (* 1663 | val insert_block : llcontext -> string -> llbasicblock -> llbasicblock 1664 | *) 1665 | 1666 | (** [block_parent bb] returns the parent function that owns the basic block. 1667 | See the method [llvm::BasicBlock::getParent]. *) 1668 | (* 1669 | val block_parent : llbasicblock -> llvalue 1670 | *) 1671 | 1672 | (** [block_begin f] returns the first position in the basic block list of the 1673 | function [f]. [block_begin] and [block_succ] can be used to iterate over 1674 | the basic block list in order. 1675 | See the method [llvm::Function::begin]. *) 1676 | (* 1677 | val block_begin : llvalue -> (llvalue, llbasicblock) llpos 1678 | *) 1679 | 1680 | (** [block_succ bb] returns the basic block list position succeeding 1681 | [Before bb]. 1682 | See the method [llvm::Function::iterator::operator++]. *) 1683 | (* 1684 | val block_succ : llbasicblock -> (llvalue, llbasicblock) llpos 1685 | *) 1686 | 1687 | (** [iter_blocks f fn] applies function [f] to each of the basic blocks 1688 | of function [fn] in order. Tail recursive. *) 1689 | (* 1690 | val iter_blocks : (llbasicblock -> unit) -> llvalue -> unit 1691 | *) 1692 | 1693 | (** [fold_left_blocks f init fn] is [f (... (f init b1) ...) bN] where 1694 | [b1,...,bN] are the basic blocks of function [fn]. Tail recursive. *) 1695 | (* 1696 | val fold_left_blocks : ('a -> llbasicblock -> 'a) -> 'a -> llvalue -> 'a 1697 | *) 1698 | 1699 | (** [block_end f] returns the last position in the basic block list of 1700 | the function [f]. [block_end] and [block_pred] can be used to iterate 1701 | over the basic block list in reverse. 1702 | See the method [llvm::Function::end]. *) 1703 | (* 1704 | val block_end : llvalue -> (llvalue, llbasicblock) llrev_pos 1705 | *) 1706 | 1707 | (** [block_pred gv] returns the function list position preceding [After gv]. 1708 | See the method [llvm::Function::iterator::operator--]. *) 1709 | (* 1710 | val block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos 1711 | *) 1712 | 1713 | (* 1714 | val block_terminator : llbasicblock -> llvalue option 1715 | *) 1716 | 1717 | (** [rev_iter_blocks f fn] applies function [f] to each of the basic blocks 1718 | of function [fn] in reverse order. Tail recursive. *) 1719 | (* 1720 | val rev_iter_blocks : (llbasicblock -> unit) -> llvalue -> unit 1721 | *) 1722 | 1723 | (** [fold_right_blocks f fn init] is [f (... (f init bN) ...) b1] where 1724 | [b1,...,bN] are the basic blocks of function [fn]. Tail recursive. *) 1725 | (* 1726 | val fold_right_blocks : (llbasicblock -> 'a -> 'a) -> llvalue -> 'a -> 'a 1727 | *) 1728 | 1729 | (** [value_of_block bb] losslessly casts [bb] to an [llvalue]. *) 1730 | (* 1731 | val value_of_block : llbasicblock -> llvalue 1732 | *) 1733 | 1734 | (** [value_is_block v] returns [true] if the value [v] is a basic block and 1735 | [false] otherwise. 1736 | Similar to [llvm::isa]. *) 1737 | (* 1738 | val value_is_block : llvalue -> bool 1739 | *) 1740 | 1741 | (** [block_of_value v] losslessly casts [v] to an [llbasicblock]. *) 1742 | (* 1743 | val block_of_value : llvalue -> llbasicblock 1744 | *) 1745 | 1746 | (** {7 Operations on instructions} *) 1747 | 1748 | (** [instr_parent i] is the enclosing basic block of the instruction [i]. 1749 | See the method [llvm::Instruction::getParent]. *) 1750 | (* 1751 | val instr_parent : llvalue -> llbasicblock 1752 | *) 1753 | 1754 | (** [instr_begin bb] returns the first position in the instruction list of the 1755 | basic block [bb]. [instr_begin] and [instr_succ] can be used to iterate over 1756 | the instruction list in order. 1757 | See the method [llvm::BasicBlock::begin]. *) 1758 | (* 1759 | val instr_begin : llbasicblock -> (llbasicblock, llvalue) llpos 1760 | *) 1761 | 1762 | (** [instr_succ i] returns the instruction list position succeeding [Before i]. 1763 | See the method [llvm::BasicBlock::iterator::operator++]. *) 1764 | (* 1765 | val instr_succ : llvalue -> (llbasicblock, llvalue) llpos 1766 | *) 1767 | 1768 | (** [iter_instrs f bb] applies function [f] to each of the instructions of basic 1769 | block [bb] in order. Tail recursive. *) 1770 | (* 1771 | val iter_instrs: (llvalue -> unit) -> llbasicblock -> unit 1772 | *) 1773 | 1774 | (** [fold_left_instrs f init bb] is [f (... (f init g1) ...) gN] where 1775 | [g1,...,gN] are the instructions of basic block [bb]. Tail recursive. *) 1776 | (* 1777 | val fold_left_instrs: ('a -> llvalue -> 'a) -> 'a -> llbasicblock -> 'a 1778 | *) 1779 | 1780 | (** [instr_end bb] returns the last position in the instruction list of the 1781 | basic block [bb]. [instr_end] and [instr_pred] can be used to iterate over 1782 | the instruction list in reverse. 1783 | See the method [llvm::BasicBlock::end]. *) 1784 | (* 1785 | val instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos 1786 | *) 1787 | 1788 | (** [instr_pred i] returns the instruction list position preceding [After i]. 1789 | See the method [llvm::BasicBlock::iterator::operator--]. *) 1790 | (* 1791 | val instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos 1792 | *) 1793 | 1794 | (** [fold_right_instrs f bb init] is [f (... (f init fN) ...) f1] where 1795 | [f1,...,fN] are the instructions of basic block [bb]. Tail recursive. *) 1796 | (* 1797 | val fold_right_instrs: (llvalue -> 'a -> 'a) -> llbasicblock -> 'a -> 'a 1798 | *) 1799 | 1800 | (* 1801 | val instr_opcode : llvalue -> Opcode.t 1802 | *) 1803 | 1804 | (* 1805 | val icmp_predicate : llvalue -> Icmp.t option 1806 | *) 1807 | 1808 | (** {7 Operations on call sites} *) 1809 | 1810 | (** [instruction_call_conv ci] is the calling convention for the call or invoke 1811 | instruction [ci], which may be one of the values from the module 1812 | {!CallConv}. See the method [llvm::CallInst::getCallingConv] and 1813 | [llvm::InvokeInst::getCallingConv]. *) 1814 | (* 1815 | val instruction_call_conv: llvalue -> int 1816 | *) 1817 | 1818 | (** [set_instruction_call_conv cc ci] sets the calling convention for the call 1819 | or invoke instruction [ci] to the integer [cc], which can be one of the 1820 | values from the module {!CallConv}. 1821 | See the method [llvm::CallInst::setCallingConv] 1822 | and [llvm::InvokeInst::setCallingConv]. *) 1823 | (* 1824 | val set_instruction_call_conv: int -> llvalue -> unit 1825 | *) 1826 | 1827 | (** [add_instruction_param_attr ci i a] adds attribute [a] to the [i]th 1828 | parameter of the call or invoke instruction [ci]. [i]=0 denotes the return 1829 | value. *) 1830 | (* 1831 | val add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit 1832 | *) 1833 | 1834 | (** [remove_instruction_param_attr ci i a] removes attribute [a] from the 1835 | [i]th parameter of the call or invoke instruction [ci]. [i]=0 denotes the 1836 | return value. *) 1837 | (* 1838 | val remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit 1839 | *) 1840 | 1841 | (** {Operations on call instructions (only)} *) 1842 | 1843 | (** [is_tail_call ci] is [true] if the call instruction [ci] is flagged as 1844 | eligible for tail call optimization, [false] otherwise. 1845 | See the method [llvm::CallInst::isTailCall]. *) 1846 | (* 1847 | val is_tail_call : llvalue -> bool 1848 | *) 1849 | 1850 | (** [set_tail_call tc ci] flags the call instruction [ci] as eligible for tail 1851 | call optimization if [tc] is [true], clears otherwise. 1852 | See the method [llvm::CallInst::setTailCall]. *) 1853 | (* 1854 | val set_tail_call : bool -> llvalue -> unit 1855 | *) 1856 | 1857 | (** {7 Operations on phi nodes} *) 1858 | 1859 | (** [add_incoming (v, bb) pn] adds the value [v] to the phi node [pn] for use 1860 | with branches from [bb]. See the method [llvm::PHINode::addIncoming]. *) 1861 | (* 1862 | val add_incoming : (llvalue * llbasicblock) -> llvalue -> unit 1863 | *) 1864 | 1865 | (** [incoming pn] returns the list of value-block pairs for phi node [pn]. 1866 | See the method [llvm::PHINode::getIncomingValue]. *) 1867 | (* 1868 | val incoming : llvalue -> (llvalue * llbasicblock) list 1869 | *) 1870 | 1871 | (** [delete_instruction i] deletes the instruction [i]. 1872 | * See the method [llvm::Instruction::eraseFromParent]. *) 1873 | (* 1874 | val delete_instruction : llvalue -> unit 1875 | *) 1876 | 1877 | (** {6 Instruction builders} *) 1878 | 1879 | (** [builder context] creates an instruction builder with no position in 1880 | the context [context]. It is invalid to use this builder until its position 1881 | is set with {!position_before} or {!position_at_end}. See the constructor 1882 | for [llvm::LLVMBuilder]. *) 1883 | (* 1884 | val builder : llcontext -> llbuilder 1885 | *) 1886 | 1887 | (** [builder_at c ip] creates an instruction builder positioned at [ip] with 1888 | respect to the context [c]. See the constructor for [llvm::LLVMBuilder]. *) 1889 | (* 1890 | val builder_at : llcontext -> (llbasicblock, llvalue) llpos -> llbuilder 1891 | *) 1892 | 1893 | (** [builder_before c ins] creates an instruction builder positioned before the 1894 | instruction [isn] with respect to the context [c]. See the constructor for 1895 | [llvm::LLVMBuilder]. *) 1896 | (* 1897 | val builder_before : llcontext -> llvalue -> llbuilder 1898 | *) 1899 | 1900 | (** [builder_at_end c bb] creates an instruction builder positioned at the end of 1901 | the basic block [bb] with respect to [c]. See the constructor for 1902 | [llvm::LLVMBuilder]. *) 1903 | val builder_at_end : llcontext -> llbasicblock -> llbuilder 1904 | 1905 | (** [position_builder ip bb] moves the instruction builder [bb] to the position 1906 | [ip]. 1907 | See the constructor for [llvm::LLVMBuilder]. *) 1908 | (* 1909 | val position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit 1910 | *) 1911 | 1912 | (** [position_before ins b] moves the instruction builder [b] to before the 1913 | instruction [isn]. See the method [llvm::LLVMBuilder::SetInsertPoint]. *) 1914 | (* 1915 | val position_before : llvalue -> llbuilder -> unit 1916 | *) 1917 | 1918 | (** [position_at_end bb b] moves the instruction builder [b] to the end of the 1919 | basic block [bb]. See the method [llvm::LLVMBuilder::SetInsertPoint]. *) 1920 | (* 1921 | val position_at_end : llbasicblock -> llbuilder -> unit 1922 | *) 1923 | 1924 | (** [insertion_block b] returns the basic block that the builder [b] is 1925 | positioned to insert into. Raises [Not_Found] if the instruction builder is 1926 | uninitialized. 1927 | See the method [llvm::LLVMBuilder::GetInsertBlock]. *) 1928 | (* 1929 | val insertion_block : llbuilder -> llbasicblock 1930 | *) 1931 | 1932 | (** [insert_into_builder i name b] inserts the specified instruction [i] at the 1933 | position specified by the instruction builder [b]. 1934 | See the method [llvm::LLVMBuilder::Insert]. *) 1935 | (* 1936 | val insert_into_builder : llvalue -> string -> llbuilder -> unit 1937 | *) 1938 | 1939 | (** {7 Metadata} *) 1940 | 1941 | (** [set_current_debug_location b md] sets the current debug location [md] in 1942 | the builder [b]. 1943 | See the method [llvm::IRBuilder::SetDebugLocation]. *) 1944 | (* 1945 | val set_current_debug_location : llbuilder -> llvalue -> unit 1946 | *) 1947 | 1948 | (** [clear_current_debug_location b] clears the current debug location in the 1949 | builder [b]. *) 1950 | (* 1951 | val clear_current_debug_location : llbuilder -> unit 1952 | *) 1953 | 1954 | (** [current_debug_location b] returns the current debug location, or None 1955 | if none is currently set. 1956 | See the method [llvm::IRBuilder::GetDebugLocation]. *) 1957 | (* 1958 | val current_debug_location : llbuilder -> llvalue option 1959 | *) 1960 | 1961 | (** [set_inst_debug_location b i] sets the current debug location of the builder 1962 | [b] to the instruction [i]. 1963 | See the method [llvm::IRBuilder::SetInstDebugLocation]. *) 1964 | (* 1965 | val set_inst_debug_location : llbuilder -> llvalue -> unit 1966 | *) 1967 | 1968 | (** {7 Terminators} *) 1969 | 1970 | (** [build_ret_void b] creates a 1971 | [ret void] 1972 | instruction at the position specified by the instruction builder [b]. 1973 | See the method [llvm::LLVMBuilder::CreateRetVoid]. *) 1974 | val build_ret_void : llbuilder -> llvalue 1975 | 1976 | (** [build_ret v b] creates a 1977 | [ret %v] 1978 | instruction at the position specified by the instruction builder [b]. 1979 | See the method [llvm::LLVMBuilder::CreateRet]. *) 1980 | val build_ret : llvalue -> llbuilder -> llvalue 1981 | 1982 | (** [build_aggregate_ret vs b] creates a 1983 | [ret {...} { %v1, %v2, ... } ] 1984 | instruction at the position specified by the instruction builder [b]. 1985 | See the method [llvm::LLVMBuilder::CreateAggregateRet]. *) 1986 | (* 1987 | val build_aggregate_ret : llvalue array -> llbuilder -> llvalue 1988 | *) 1989 | 1990 | (** [build_br bb b] creates a 1991 | [br %bb] 1992 | instruction at the position specified by the instruction builder [b]. 1993 | See the method [llvm::LLVMBuilder::CreateBr]. *) 1994 | val build_br : llbasicblock -> llbuilder -> llvalue 1995 | 1996 | (** [build_cond_br cond tbb fbb b] creates a 1997 | [br %cond, %tbb, %fbb] 1998 | instruction at the position specified by the instruction builder [b]. 1999 | See the method [llvm::LLVMBuilder::CreateCondBr]. *) 2000 | val build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder -> 2001 | llvalue 2002 | 2003 | (** [build_switch case elsebb count b] creates an empty 2004 | [switch %case, %elsebb] 2005 | instruction at the position specified by the instruction builder [b] with 2006 | space reserved for [count] cases. 2007 | See the method [llvm::LLVMBuilder::CreateSwitch]. *) 2008 | (* 2009 | val build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue 2010 | *) 2011 | 2012 | (** [build_malloc ty name b] creates an [malloc] 2013 | instruction at the position specified by the instruction builder [b]. 2014 | See the method [llvm::CallInst::CreateMalloc]. *) 2015 | (* 2016 | val build_malloc : lltype -> string -> llbuilder -> llvalue 2017 | *) 2018 | 2019 | (** [build_array_malloc ty val name b] creates an [array malloc] 2020 | instruction at the position specified by the instruction builder [b]. 2021 | See the method [llvm::CallInst::CreateArrayMalloc]. *) 2022 | (* 2023 | val build_array_malloc : lltype -> llvalue -> string -> llbuilder -> llvalue 2024 | *) 2025 | 2026 | (** [build_free p b] creates a [free] 2027 | instruction at the position specified by the instruction builder [b]. 2028 | See the method [llvm::LLVMBuilder::CreateFree]. *) 2029 | (* 2030 | val build_free : llvalue -> llbuilder -> llvalue 2031 | *) 2032 | 2033 | (** [add_case sw onval bb] causes switch instruction [sw] to branch to [bb] 2034 | when its input matches the constant [onval]. 2035 | See the method [llvm::SwitchInst::addCase]. **) 2036 | (* 2037 | val add_case : llvalue -> llvalue -> llbasicblock -> unit 2038 | *) 2039 | 2040 | (** [switch_default_dest sw] returns the default destination of the [switch] 2041 | * instruction. 2042 | * See the method [llvm:;SwitchInst::getDefaultDest]. **) 2043 | (* 2044 | val switch_default_dest : llvalue -> llbasicblock 2045 | *) 2046 | 2047 | (** [build_indirect_br addr count b] creates a 2048 | [indirectbr %addr] 2049 | instruction at the position specified by the instruction builder [b] with 2050 | space reserved for [count] destinations. 2051 | See the method [llvm::LLVMBuilder::CreateIndirectBr]. *) 2052 | (* 2053 | val build_indirect_br : llvalue -> int -> llbuilder -> llvalue 2054 | *) 2055 | 2056 | (** [add_destination br bb] adds the basic block [bb] as a possible branch 2057 | location for the indirectbr instruction [br]. 2058 | See the method [llvm::IndirectBrInst::addDestination]. **) 2059 | (* 2060 | val add_destination : llvalue -> llbasicblock -> unit 2061 | *) 2062 | 2063 | (** [build_invoke fn args tobb unwindbb name b] creates an 2064 | [%name = invoke %fn(args) to %tobb unwind %unwindbb] 2065 | instruction at the position specified by the instruction builder [b]. 2066 | See the method [llvm::LLVMBuilder::CreateInvoke]. *) 2067 | (* 2068 | val build_invoke : llvalue -> llvalue array -> llbasicblock -> 2069 | llbasicblock -> string -> llbuilder -> llvalue 2070 | *) 2071 | 2072 | (** [build_landingpad ty persfn numclauses name b] creates an 2073 | [landingpad] 2074 | instruction at the position specified by the instruction builder [b]. 2075 | See the method [llvm::LLVMBuilder::CreateLandingPad]. *) 2076 | (* 2077 | val build_landingpad : lltype -> llvalue -> int -> string -> llbuilder -> 2078 | llvalue 2079 | *) 2080 | 2081 | (** [set_cleanup lp] sets the cleanup flag in the [landingpad]instruction. 2082 | See the method [llvm::LandingPadInst::setCleanup]. *) 2083 | (* 2084 | val set_cleanup : llvalue -> bool -> unit 2085 | *) 2086 | 2087 | (** [add_clause lp clause] adds the clause to the [landingpad]instruction. 2088 | See the method [llvm::LandingPadInst::addClause]. *) 2089 | (* 2090 | val add_clause : llvalue -> llvalue -> unit 2091 | *) 2092 | 2093 | (* [build_resume exn b] builds a [resume exn] instruction 2094 | * at the position specified by the instruction builder [b]. 2095 | * See the method [llvm::LLVMBuilder::CreateResume] *) 2096 | (* 2097 | val build_resume : llvalue -> llbuilder -> llvalue 2098 | *) 2099 | 2100 | (** [build_unreachable b] creates an 2101 | [unreachable] 2102 | instruction at the position specified by the instruction builder [b]. 2103 | See the method [llvm::LLVMBuilder::CreateUnwind]. *) 2104 | (* 2105 | val build_unreachable : llbuilder -> llvalue 2106 | *) 2107 | 2108 | (** {7 Arithmetic} *) 2109 | 2110 | (** [build_add x y name b] creates a 2111 | [%name = add %x, %y] 2112 | instruction at the position specified by the instruction builder [b]. 2113 | See the method [llvm::LLVMBuilder::CreateAdd]. *) 2114 | val build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 2115 | 2116 | (** [build_nsw_add x y name b] creates a 2117 | [%name = nsw add %x, %y] 2118 | instruction at the position specified by the instruction builder [b]. 2119 | See the method [llvm::LLVMBuilder::CreateNSWAdd]. *) 2120 | (* 2121 | val build_nsw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 2122 | *) 2123 | 2124 | (** [build_nuw_add x y name b] creates a 2125 | [%name = nuw add %x, %y] 2126 | instruction at the position specified by the instruction builder [b]. 2127 | See the method [llvm::LLVMBuilder::CreateNUWAdd]. *) 2128 | (* 2129 | val build_nuw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 2130 | *) 2131 | 2132 | (** [build_fadd x y name b] creates a 2133 | [%name = fadd %x, %y] 2134 | instruction at the position specified by the instruction builder [b]. 2135 | See the method [llvm::LLVMBuilder::CreateFAdd]. *) 2136 | val build_fadd : llvalue -> llvalue -> string -> llbuilder -> llvalue 2137 | 2138 | (** [build_sub x y name b] creates a 2139 | [%name = sub %x, %y] 2140 | instruction at the position specified by the instruction builder [b]. 2141 | See the method [llvm::LLVMBuilder::CreateSub]. *) 2142 | val build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 2143 | 2144 | (** [build_nsw_sub x y name b] creates a 2145 | [%name = nsw sub %x, %y] 2146 | instruction at the position specified by the instruction builder [b]. 2147 | See the method [llvm::LLVMBuilder::CreateNSWSub]. *) 2148 | (* 2149 | val build_nsw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 2150 | *) 2151 | 2152 | (** [build_nuw_sub x y name b] creates a 2153 | [%name = nuw sub %x, %y] 2154 | instruction at the position specified by the instruction builder [b]. 2155 | See the method [llvm::LLVMBuilder::CreateNUWSub]. *) 2156 | (* 2157 | val build_nuw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 2158 | *) 2159 | 2160 | (** [build_fsub x y name b] creates a 2161 | [%name = fsub %x, %y] 2162 | instruction at the position specified by the instruction builder [b]. 2163 | See the method [llvm::LLVMBuilder::CreateFSub]. *) 2164 | val build_fsub : llvalue -> llvalue -> string -> llbuilder -> llvalue 2165 | 2166 | (** [build_mul x y name b] creates a 2167 | [%name = mul %x, %y] 2168 | instruction at the position specified by the instruction builder [b]. 2169 | See the method [llvm::LLVMBuilder::CreateMul]. *) 2170 | val build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 2171 | 2172 | (** [build_nsw_mul x y name b] creates a 2173 | [%name = nsw mul %x, %y] 2174 | instruction at the position specified by the instruction builder [b]. 2175 | See the method [llvm::LLVMBuilder::CreateNSWMul]. *) 2176 | (* 2177 | val build_nsw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 2178 | *) 2179 | 2180 | (** [build_nuw_mul x y name b] creates a 2181 | [%name = nuw mul %x, %y] 2182 | instruction at the position specified by the instruction builder [b]. 2183 | See the method [llvm::LLVMBuilder::CreateNUWMul]. *) 2184 | (* 2185 | val build_nuw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 2186 | *) 2187 | 2188 | (** [build_fmul x y name b] creates a 2189 | [%name = fmul %x, %y] 2190 | instruction at the position specified by the instruction builder [b]. 2191 | See the method [llvm::LLVMBuilder::CreateFMul]. *) 2192 | val build_fmul : llvalue -> llvalue -> string -> llbuilder -> llvalue 2193 | 2194 | (** [build_udiv x y name b] creates a 2195 | [%name = udiv %x, %y] 2196 | instruction at the position specified by the instruction builder [b]. 2197 | See the method [llvm::LLVMBuilder::CreateUDiv]. *) 2198 | val build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 2199 | 2200 | (** [build_sdiv x y name b] creates a 2201 | [%name = sdiv %x, %y] 2202 | instruction at the position specified by the instruction builder [b]. 2203 | See the method [llvm::LLVMBuilder::CreateSDiv]. *) 2204 | val build_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 2205 | 2206 | (** [build_exact_sdiv x y name b] creates a 2207 | [%name = exact sdiv %x, %y] 2208 | instruction at the position specified by the instruction builder [b]. 2209 | See the method [llvm::LLVMBuilder::CreateExactSDiv]. *) 2210 | (* 2211 | val build_exact_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 2212 | *) 2213 | 2214 | (** [build_fdiv x y name b] creates a 2215 | [%name = fdiv %x, %y] 2216 | instruction at the position specified by the instruction builder [b]. 2217 | See the method [llvm::LLVMBuilder::CreateFDiv]. *) 2218 | val build_fdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 2219 | 2220 | (** [build_urem x y name b] creates a 2221 | [%name = urem %x, %y] 2222 | instruction at the position specified by the instruction builder [b]. 2223 | See the method [llvm::LLVMBuilder::CreateURem]. *) 2224 | val build_urem : llvalue -> llvalue -> string -> llbuilder -> llvalue 2225 | 2226 | (** [build_SRem x y name b] creates a 2227 | [%name = srem %x, %y] 2228 | instruction at the position specified by the instruction builder [b]. 2229 | See the method [llvm::LLVMBuilder::CreateSRem]. *) 2230 | val build_srem : llvalue -> llvalue -> string -> llbuilder -> llvalue 2231 | 2232 | (** [build_frem x y name b] creates a 2233 | [%name = frem %x, %y] 2234 | instruction at the position specified by the instruction builder [b]. 2235 | See the method [llvm::LLVMBuilder::CreateFRem]. *) 2236 | val build_frem : llvalue -> llvalue -> string -> llbuilder -> llvalue 2237 | 2238 | (** [build_shl x y name b] creates a 2239 | [%name = shl %x, %y] 2240 | instruction at the position specified by the instruction builder [b]. 2241 | See the method [llvm::LLVMBuilder::CreateShl]. *) 2242 | val build_shl : llvalue -> llvalue -> string -> llbuilder -> llvalue 2243 | 2244 | (** [build_lshr x y name b] creates a 2245 | [%name = lshr %x, %y] 2246 | instruction at the position specified by the instruction builder [b]. 2247 | See the method [llvm::LLVMBuilder::CreateLShr]. *) 2248 | val build_lshr : llvalue -> llvalue -> string -> llbuilder -> llvalue 2249 | 2250 | (** [build_ashr x y name b] creates a 2251 | [%name = ashr %x, %y] 2252 | instruction at the position specified by the instruction builder [b]. 2253 | See the method [llvm::LLVMBuilder::CreateAShr]. *) 2254 | val build_ashr : llvalue -> llvalue -> string -> llbuilder -> llvalue 2255 | 2256 | (** [build_and x y name b] creates a 2257 | [%name = and %x, %y] 2258 | instruction at the position specified by the instruction builder [b]. 2259 | See the method [llvm::LLVMBuilder::CreateAnd]. *) 2260 | val build_and : llvalue -> llvalue -> string -> llbuilder -> llvalue 2261 | 2262 | (** [build_or x y name b] creates a 2263 | [%name = or %x, %y] 2264 | instruction at the position specified by the instruction builder [b]. 2265 | See the method [llvm::LLVMBuilder::CreateOr]. *) 2266 | val build_or : llvalue -> llvalue -> string -> llbuilder -> llvalue 2267 | 2268 | (** [build_xor x y name b] creates a 2269 | [%name = xor %x, %y] 2270 | instruction at the position specified by the instruction builder [b]. 2271 | See the method [llvm::LLVMBuilder::CreateXor]. *) 2272 | val build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue 2273 | 2274 | (** [build_neg x name b] creates a 2275 | [%name = sub 0, %x] 2276 | instruction at the position specified by the instruction builder [b]. 2277 | [-0.0] is used for floating point types to compute the correct sign. 2278 | See the method [llvm::LLVMBuilder::CreateNeg]. *) 2279 | val build_neg : llvalue -> string -> llbuilder -> llvalue 2280 | 2281 | (** [build_nsw_neg x name b] creates a 2282 | [%name = nsw sub 0, %x] 2283 | instruction at the position specified by the instruction builder [b]. 2284 | [-0.0] is used for floating point types to compute the correct sign. 2285 | See the method [llvm::LLVMBuilder::CreateNeg]. *) 2286 | (* 2287 | val build_nsw_neg : llvalue -> string -> llbuilder -> llvalue 2288 | *) 2289 | 2290 | (** [build_nuw_neg x name b] creates a 2291 | [%name = nuw sub 0, %x] 2292 | instruction at the position specified by the instruction builder [b]. 2293 | [-0.0] is used for floating point types to compute the correct sign. 2294 | See the method [llvm::LLVMBuilder::CreateNeg]. *) 2295 | (* 2296 | val build_nuw_neg : llvalue -> string -> llbuilder -> llvalue 2297 | *) 2298 | 2299 | (** [build_fneg x name b] creates a 2300 | [%name = fsub 0, %x] 2301 | instruction at the position specified by the instruction builder [b]. 2302 | [-0.0] is used for floating point types to compute the correct sign. 2303 | See the method [llvm::LLVMBuilder::CreateFNeg]. *) 2304 | val build_fneg : llvalue -> string -> llbuilder -> llvalue 2305 | 2306 | (** [build_xor x name b] creates a 2307 | [%name = xor %x, -1] 2308 | instruction at the position specified by the instruction builder [b]. 2309 | [-1] is the correct "all ones" value for the type of [x]. 2310 | See the method [llvm::LLVMBuilder::CreateXor]. *) 2311 | val build_not : llvalue -> string -> llbuilder -> llvalue 2312 | 2313 | (** {7 Memory} *) 2314 | 2315 | (** [build_alloca ty name b] creates a 2316 | [%name = alloca %ty] 2317 | instruction at the position specified by the instruction builder [b]. 2318 | See the method [llvm::LLVMBuilder::CreateAlloca]. *) 2319 | (* 2320 | val build_alloca : lltype -> string -> llbuilder -> llvalue 2321 | *) 2322 | 2323 | (** [build_array_alloca ty n name b] creates a 2324 | [%name = alloca %ty, %n] 2325 | instruction at the position specified by the instruction builder [b]. 2326 | See the method [llvm::LLVMBuilder::CreateAlloca]. *) 2327 | (* 2328 | val build_array_alloca : lltype -> llvalue -> string -> llbuilder -> 2329 | llvalue 2330 | *) 2331 | 2332 | (** [build_load v name b] creates a 2333 | [%name = load %v] 2334 | instruction at the position specified by the instruction builder [b]. 2335 | See the method [llvm::LLVMBuilder::CreateLoad]. *) 2336 | (* 2337 | val build_load : llvalue -> string -> llbuilder -> llvalue 2338 | *) 2339 | 2340 | (** [build_store v p b] creates a 2341 | [store %v, %p] 2342 | instruction at the position specified by the instruction builder [b]. 2343 | See the method [llvm::LLVMBuilder::CreateStore]. *) 2344 | (* 2345 | val build_store : llvalue -> llvalue -> llbuilder -> llvalue 2346 | *) 2347 | 2348 | (** [build_gep p indices name b] creates a 2349 | [%name = getelementptr %p, indices...] 2350 | instruction at the position specified by the instruction builder [b]. 2351 | See the method [llvm::LLVMBuilder::CreateGetElementPtr]. *) 2352 | val build_gep : llvalue -> llvalue list -> string -> llbuilder -> llvalue 2353 | 2354 | (** [build_in_bounds_gep p indices name b] creates a 2355 | [%name = gelementptr inbounds %p, indices...] 2356 | instruction at the position specified by the instruction builder [b]. 2357 | See the method [llvm::LLVMBuilder::CreateInBoundsGetElementPtr]. *) 2358 | (* 2359 | val build_in_bounds_gep : llvalue -> llvalue array -> string -> llbuilder -> 2360 | llvalue 2361 | *) 2362 | 2363 | (** [build_struct_gep p idx name b] creates a 2364 | [%name = getelementptr %p, 0, idx] 2365 | instruction at the position specified by the instruction builder [b]. 2366 | See the method [llvm::LLVMBuilder::CreateStructGetElementPtr]. *) 2367 | (* 2368 | val build_struct_gep : llvalue -> int -> string -> llbuilder -> 2369 | llvalue 2370 | *) 2371 | 2372 | (** [build_global_string str name b] creates a series of instructions that adds 2373 | a global string at the position specified by the instruction builder [b]. 2374 | See the method [llvm::LLVMBuilder::CreateGlobalString]. *) 2375 | (* 2376 | val build_global_string : string -> string -> llbuilder -> llvalue 2377 | *) 2378 | 2379 | (** [build_global_stringptr str name b] creates a series of instructions that 2380 | adds a global string pointer at the position specified by the instruction 2381 | builder [b]. 2382 | See the method [llvm::LLVMBuilder::CreateGlobalStringPtr]. *) 2383 | (* 2384 | val build_global_stringptr : string -> string -> llbuilder -> llvalue 2385 | *) 2386 | 2387 | (** {7 Casts} *) 2388 | 2389 | (** [build_trunc v ty name b] creates a 2390 | [%name = trunc %p to %ty] 2391 | instruction at the position specified by the instruction builder [b]. 2392 | See the method [llvm::LLVMBuilder::CreateTrunc]. *) 2393 | val build_trunc : llvalue -> lltype -> string -> llbuilder -> llvalue 2394 | 2395 | (** [build_zext v ty name b] creates a 2396 | [%name = zext %p to %ty] 2397 | instruction at the position specified by the instruction builder [b]. 2398 | See the method [llvm::LLVMBuilder::CreateZExt]. *) 2399 | val build_zext : llvalue -> lltype -> string -> llbuilder -> llvalue 2400 | 2401 | (** [build_sext v ty name b] creates a 2402 | [%name = sext %p to %ty] 2403 | instruction at the position specified by the instruction builder [b]. 2404 | See the method [llvm::LLVMBuilder::CreateSExt]. *) 2405 | val build_sext : llvalue -> lltype -> string -> llbuilder -> llvalue 2406 | 2407 | (** [build_fptoui v ty name b] creates a 2408 | [%name = fptoui %p to %ty] 2409 | instruction at the position specified by the instruction builder [b]. 2410 | See the method [llvm::LLVMBuilder::CreateFPToUI]. *) 2411 | val build_fptoui : llvalue -> lltype -> string -> llbuilder -> llvalue 2412 | 2413 | (** [build_fptosi v ty name b] creates a 2414 | [%name = fptosi %p to %ty] 2415 | instruction at the position specified by the instruction builder [b]. 2416 | See the method [llvm::LLVMBuilder::CreateFPToSI]. *) 2417 | val build_fptosi : llvalue -> lltype -> string -> llbuilder -> llvalue 2418 | 2419 | (** [build_uitofp v ty name b] creates a 2420 | [%name = uitofp %p to %ty] 2421 | instruction at the position specified by the instruction builder [b]. 2422 | See the method [llvm::LLVMBuilder::CreateUIToFP]. *) 2423 | val build_uitofp : llvalue -> lltype -> string -> llbuilder -> llvalue 2424 | 2425 | (** [build_sitofp v ty name b] creates a 2426 | [%name = sitofp %p to %ty] 2427 | instruction at the position specified by the instruction builder [b]. 2428 | See the method [llvm::LLVMBuilder::CreateSIToFP]. *) 2429 | val build_sitofp : llvalue -> lltype -> string -> llbuilder -> llvalue 2430 | 2431 | (** [build_fptrunc v ty name b] creates a 2432 | [%name = fptrunc %p to %ty] 2433 | instruction at the position specified by the instruction builder [b]. 2434 | See the method [llvm::LLVMBuilder::CreateFPTrunc]. *) 2435 | val build_fptrunc : llvalue -> lltype -> string -> llbuilder -> llvalue 2436 | 2437 | (** [build_fpext v ty name b] creates a 2438 | [%name = fpext %p to %ty] 2439 | instruction at the position specified by the instruction builder [b]. 2440 | See the method [llvm::LLVMBuilder::CreateFPExt]. *) 2441 | val build_fpext : llvalue -> lltype -> string -> llbuilder -> llvalue 2442 | 2443 | (** [build_ptrtoint v ty name b] creates a 2444 | [%name = prtotint %p to %ty] 2445 | instruction at the position specified by the instruction builder [b]. 2446 | See the method [llvm::LLVMBuilder::CreatePtrToInt]. *) 2447 | (* 2448 | val build_ptrtoint : llvalue -> lltype -> string -> llbuilder -> llvalue 2449 | *) 2450 | 2451 | (** [build_inttoptr v ty name b] creates a 2452 | [%name = inttoptr %p to %ty] 2453 | instruction at the position specified by the instruction builder [b]. 2454 | See the method [llvm::LLVMBuilder::CreateIntToPtr]. *) 2455 | (* 2456 | val build_inttoptr : llvalue -> lltype -> string -> llbuilder -> llvalue 2457 | *) 2458 | 2459 | (** [build_bitcast v ty name b] creates a 2460 | [%name = bitcast %p to %ty] 2461 | instruction at the position specified by the instruction builder [b]. 2462 | See the method [llvm::LLVMBuilder::CreateBitCast]. *) 2463 | (* 2464 | val build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue 2465 | *) 2466 | 2467 | (** [build_zext_or_bitcast v ty name b] creates a zext or bitcast 2468 | instruction at the position specified by the instruction builder [b]. 2469 | See the method [llvm::LLVMBuilder::CreateZExtOrBitCast]. *) 2470 | (* 2471 | val build_zext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 2472 | llvalue 2473 | *) 2474 | 2475 | (** [build_sext_or_bitcast v ty name b] creates a sext or bitcast 2476 | instruction at the position specified by the instruction builder [b]. 2477 | See the method [llvm::LLVMBuilder::CreateSExtOrBitCast]. *) 2478 | (* 2479 | val build_sext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 2480 | llvalue 2481 | *) 2482 | 2483 | (** [build_trunc_or_bitcast v ty name b] creates a trunc or bitcast 2484 | instruction at the position specified by the instruction builder [b]. 2485 | See the method [llvm::LLVMBuilder::CreateZExtOrBitCast]. *) 2486 | (* 2487 | val build_trunc_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 2488 | llvalue 2489 | *) 2490 | 2491 | (** [build_pointercast v ty name b] creates a bitcast or pointer-to-int 2492 | instruction at the position specified by the instruction builder [b]. 2493 | See the method [llvm::LLVMBuilder::CreatePointerCast]. *) 2494 | (* 2495 | val build_pointercast : llvalue -> lltype -> string -> llbuilder -> llvalue 2496 | *) 2497 | 2498 | (** [build_intcast v ty name b] creates a zext, bitcast, or trunc 2499 | instruction at the position specified by the instruction builder [b]. 2500 | See the method [llvm::LLVMBuilder::CreateIntCast]. *) 2501 | (* 2502 | val build_intcast : llvalue -> lltype -> string -> llbuilder -> llvalue 2503 | *) 2504 | 2505 | (** [build_fpcast v ty name b] creates a fpext, bitcast, or fptrunc 2506 | instruction at the position specified by the instruction builder [b]. 2507 | See the method [llvm::LLVMBuilder::CreateFPCast]. *) 2508 | (* 2509 | val build_fpcast : llvalue -> lltype -> string -> llbuilder -> llvalue 2510 | *) 2511 | 2512 | (** {7 Comparisons} *) 2513 | 2514 | (** [build_icmp pred x y name b] creates a 2515 | [%name = icmp %pred %x, %y] 2516 | instruction at the position specified by the instruction builder [b]. 2517 | See the method [llvm::LLVMBuilder::CreateICmp]. *) 2518 | val build_icmp : Icmp.t -> llvalue -> llvalue -> string -> 2519 | llbuilder -> llvalue 2520 | 2521 | (** [build_fcmp pred x y name b] creates a 2522 | [%name = fcmp %pred %x, %y] 2523 | instruction at the position specified by the instruction builder [b]. 2524 | See the method [llvm::LLVMBuilder::CreateFCmp]. *) 2525 | val build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> 2526 | llbuilder -> llvalue 2527 | 2528 | 2529 | (** {7 Miscellaneous instructions} *) 2530 | 2531 | (** [build_phi incoming name b] creates a 2532 | [%name = phi %incoming] 2533 | instruction at the position specified by the instruction builder [b]. 2534 | [incoming] is a list of [(llvalue, llbasicblock)] tuples. 2535 | See the method [llvm::LLVMBuilder::CreatePHI]. *) 2536 | val build_phi : (llvalue * llbasicblock) list -> string -> llbuilder -> 2537 | llvalue 2538 | 2539 | (** [build_call fn args name b] creates a 2540 | [%name = call %fn(args...)] 2541 | instruction at the position specified by the instruction builder [b]. 2542 | See the method [llvm::LLVMBuilder::CreateCall]. *) 2543 | val build_call : llvalue -> llvalue list -> string -> llbuilder -> llvalue 2544 | 2545 | (** [build_select cond thenv elsev name b] creates a 2546 | [%name = select %cond, %thenv, %elsev] 2547 | instruction at the position specified by the instruction builder [b]. 2548 | See the method [llvm::LLVMBuilder::CreateSelect]. *) 2549 | (* 2550 | val build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder -> 2551 | llvalue 2552 | *) 2553 | 2554 | (** [build_va_arg valist argty name b] creates a 2555 | [%name = va_arg %valist, %argty] 2556 | instruction at the position specified by the instruction builder [b]. 2557 | See the method [llvm::LLVMBuilder::CreateVAArg]. *) 2558 | (* 2559 | val build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue 2560 | *) 2561 | 2562 | (** [build_extractelement vec i name b] creates a 2563 | [%name = extractelement %vec, %i] 2564 | instruction at the position specified by the instruction builder [b]. 2565 | See the method [llvm::LLVMBuilder::CreateExtractElement]. *) 2566 | (* 2567 | val build_extractelement : llvalue -> llvalue -> string -> llbuilder -> 2568 | llvalue 2569 | *) 2570 | 2571 | (** [build_insertelement vec elt i name b] creates a 2572 | [%name = insertelement %vec, %elt, %i] 2573 | instruction at the position specified by the instruction builder [b]. 2574 | See the method [llvm::LLVMBuilder::CreateInsertElement]. *) 2575 | (* 2576 | val build_insertelement : llvalue -> llvalue -> llvalue -> string -> 2577 | llbuilder -> llvalue 2578 | *) 2579 | 2580 | (** [build_shufflevector veca vecb mask name b] creates a 2581 | [%name = shufflevector %veca, %vecb, %mask] 2582 | instruction at the position specified by the instruction builder [b]. 2583 | See the method [llvm::LLVMBuilder::CreateShuffleVector]. *) 2584 | (* 2585 | val build_shufflevector : llvalue -> llvalue -> llvalue -> string -> 2586 | llbuilder -> llvalue 2587 | *) 2588 | 2589 | (** [build_insertvalue agg idx name b] creates a 2590 | [%name = extractvalue %agg, %idx] 2591 | instruction at the position specified by the instruction builder [b]. 2592 | See the method [llvm::LLVMBuilder::CreateExtractValue]. *) 2593 | (* 2594 | val build_extractvalue : llvalue -> int -> string -> llbuilder -> llvalue 2595 | *) 2596 | 2597 | (** [build_insertvalue agg val idx name b] creates a 2598 | [%name = insertvalue %agg, %val, %idx] 2599 | instruction at the position specified by the instruction builder [b]. 2600 | See the method [llvm::LLVMBuilder::CreateInsertValue]. *) 2601 | (* 2602 | val build_insertvalue : llvalue -> llvalue -> int -> string -> llbuilder -> 2603 | llvalue 2604 | *) 2605 | 2606 | (** [build_is_null val name b] creates a 2607 | [%name = icmp eq %val, null] 2608 | instruction at the position specified by the instruction builder [b]. 2609 | See the method [llvm::LLVMBuilder::CreateIsNull]. *) 2610 | (* 2611 | val build_is_null : llvalue -> string -> llbuilder -> llvalue 2612 | *) 2613 | 2614 | (** [build_is_not_null val name b] creates a 2615 | [%name = icmp ne %val, null] 2616 | instruction at the position specified by the instruction builder [b]. 2617 | See the method [llvm::LLVMBuilder::CreateIsNotNull]. *) 2618 | (* 2619 | val build_is_not_null : llvalue -> string -> llbuilder -> llvalue 2620 | *) 2621 | 2622 | (** [build_ptrdiff lhs rhs name b] creates a series of instructions that measure 2623 | the difference between two pointer values at the position specified by the 2624 | instruction builder [b]. 2625 | See the method [llvm::LLVMBuilder::CreatePtrDiff]. *) 2626 | (* 2627 | val build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue 2628 | *) 2629 | 2630 | (** {6 Memory buffers} *) 2631 | 2632 | (* 2633 | structure MemoryBuffer : sig 2634 | (** [of_file p] is the memory buffer containing the contents of the file at 2635 | path [p]. If the file could not be read, then [IoError msg] is 2636 | raised. *) 2637 | val of_file : string -> llmemorybuffer 2638 | 2639 | (** [stdin ()] is the memory buffer containing the contents of standard input. 2640 | If standard input is empty, then [IoError msg] is raised. *) 2641 | val of_stdin : unit -> llmemorybuffer 2642 | 2643 | (** Disposes of a memory buffer. *) 2644 | val dispose : llmemorybuffer -> unit 2645 | end 2646 | *) 2647 | 2648 | (** {6 Pass Managers} *) 2649 | 2650 | (* 2651 | structure PassManager : sig 2652 | (** *) 2653 | type 'a t 2654 | type Module 2655 | type Function 2656 | 2657 | (** [PassManager.create ()] constructs a new whole-module pass pipeline. This 2658 | type of pipeline is suitable for link-time optimization and whole-module 2659 | transformations. 2660 | See the constructor of [llvm::PassManager]. *) 2661 | val create : unit -> Module t 2662 | 2663 | (** [PassManager.create_function m] constructs a new function-by-function 2664 | pass pipeline over the module [m]. It does not take ownership of [m]. 2665 | This type of pipeline is suitable for code generation and JIT compilation 2666 | tasks. 2667 | See the constructor of [llvm::FunctionPassManager]. *) 2668 | val create_function : llmodule -> Function t 2669 | 2670 | 2671 | (** [run_module m pm] initializes, executes on the module [m], and finalizes 2672 | all of the passes scheduled in the pass manager [pm]. Returns [true] if 2673 | any of the passes modified the module, [false] otherwise. 2674 | See the [llvm::PassManager::run] method. *) 2675 | val run_module : llmodule -> Module t -> bool 2676 | 2677 | 2678 | (** [initialize fpm] initializes all of the function passes scheduled in the 2679 | function pass manager [fpm]. Returns [true] if any of the passes modified 2680 | the module, [false] otherwise. 2681 | See the [llvm::FunctionPassManager::doInitialization] method. *) 2682 | val initialize : Function t -> bool 2683 | 2684 | (** [run_function f fpm] executes all of the function passes scheduled in the 2685 | function pass manager [fpm] over the function [f]. Returns [true] if any 2686 | of the passes modified [f], [false] otherwise. 2687 | See the [llvm::FunctionPassManager::run] method. *) 2688 | val run_function : llvalue -> Function t -> bool 2689 | 2690 | 2691 | (** [finalize fpm] finalizes all of the function passes scheduled in in the 2692 | function pass manager [fpm]. Returns [true] if any of the passes 2693 | modified the module, [false] otherwise. 2694 | See the [llvm::FunctionPassManager::doFinalization] method. *) 2695 | val finalize : Function t -> bool 2696 | 2697 | (** Frees the memory of a pass pipeline. For function pipelines, does not free 2698 | the module. 2699 | See the destructor of [llvm::BasePassManager]. *) 2700 | val dispose : 'a t -> unit 2701 | end 2702 | *) 2703 | 2704 | (** [write_bitcode_file m path] writes the bitcode for module [m] to the file at 2705 | [path]. Returns [true] if successful, [false] otherwise. *) 2706 | val write_bitcode_file : llmodule -> string -> bool 2707 | 2708 | structure GenericValue: sig 2709 | (** [GenericValue.t] is a boxed union type used to portably pass arguments to 2710 | and receive values from the execution engine. It supports only a limited 2711 | selection of types; for more complex argument types, it is necessary to 2712 | generate a stub function by hand or to pass parameters by reference. 2713 | See the struct [llvm::GenericValue]. *) 2714 | type t 2715 | 2716 | (** [of_float fpty n] boxes the float [n] in a float-valued generic value 2717 | according to the floating point type [fpty]. See the fields 2718 | [llvm::GenericValue::DoubleVal] and [llvm::GenericValue::FloatVal]. *) 2719 | val of_float : lltype -> real -> t 2720 | 2721 | (* 2722 | (** [of_pointer v] boxes the pointer value [v] in a generic value. See the 2723 | field [llvm::GenericValue::PointerVal]. *) 2724 | val of_pointer : 'a -> t 2725 | 2726 | (** [of_int32 n w] boxes the int32 [i] in a generic value with the bitwidth 2727 | [w]. See the field [llvm::GenericValue::IntVal]. *) 2728 | val of_int32 : lltype -> Int32.int -> t 2729 | *) 2730 | 2731 | (** [of_int n w] boxes the int [i] in a generic value with the bitwidth 2732 | [w]. See the field [llvm::GenericValue::IntVal]. *) 2733 | val of_int : lltype -> int -> t 2734 | 2735 | (* 2736 | (** [of_natint n w] boxes the native int [i] in a generic value with the 2737 | bitwidth [w]. See the field [llvm::GenericValue::IntVal]. *) 2738 | val of_nativeint : Llvm.lltype -> nativeint -> t 2739 | 2740 | (** [of_int64 n w] boxes the int64 [i] in a generic value with the bitwidth 2741 | [w]. See the field [llvm::GenericValue::IntVal]. *) 2742 | val of_int64 : Llvm.lltype -> int64 -> t 2743 | *) 2744 | 2745 | (** [as_float fpty gv] unboxes the floating point-valued generic value [gv] of 2746 | floating point type [fpty]. See the fields [llvm::GenericValue::DoubleVal] 2747 | and [llvm::GenericValue::FloatVal]. *) 2748 | val as_float : lltype -> t -> real 2749 | 2750 | (* 2751 | (** [as_pointer gv] unboxes the pointer-valued generic value [gv]. See the 2752 | field [llvm::GenericValue::PointerVal]. *) 2753 | val as_pointer : t -> 'a 2754 | 2755 | (** [as_int32 gv] unboxes the integer-valued generic value [gv] as an [int32]. 2756 | Is invalid if [gv] has a bitwidth greater than 32 bits. See the field 2757 | [llvm::GenericValue::IntVal]. *) 2758 | val as_int32 : t -> int32 2759 | *) 2760 | 2761 | (** [as_int gv] unboxes the integer-valued generic value [gv] as an [int]. 2762 | Is invalid if [gv] has a bitwidth greater than the host bit width (but the 2763 | most significant bit may be lost). See the field 2764 | [llvm::GenericValue::IntVal]. *) 2765 | val as_int : t -> int 2766 | 2767 | (* 2768 | (** [as_natint gv] unboxes the integer-valued generic value [gv] as a 2769 | [nativeint]. Is invalid if [gv] has a bitwidth greater than 2770 | [nativeint]. See the field [llvm::GenericValue::IntVal]. *) 2771 | val as_nativeint : t -> nativeint 2772 | 2773 | (** [as_int64 gv] returns the integer-valued generic value [gv] as an [int64]. 2774 | Is invalid if [gv] has a bitwidth greater than [int64]. See the field 2775 | [llvm::GenericValue::IntVal]. *) 2776 | val as_int64 : t -> int64 2777 | *) 2778 | end 2779 | 2780 | structure ExecutionEngine : sig 2781 | (** An execution engine is either a JIT compiler or an interpreter, capable of 2782 | directly loading an LLVM module and executing its functions without first 2783 | invoking a static compiler and generating a native executable. *) 2784 | type t 2785 | 2786 | (** [create m] creates a new execution engine, taking ownership of the 2787 | module [m] if successful. Creates a JIT if possible, else falls back to an 2788 | interpreter. Raises [Fail msg] if an error occurrs. The execution engine 2789 | is not garbage collected and must be destroyed with [dispose ee]. 2790 | See the function [llvm::EngineBuilder::create]. *) 2791 | val create : llmodule -> t 2792 | 2793 | (** [create_interpreter m] creates a new interpreter, taking ownership of the 2794 | module [m] if successful. Raises [Fail msg] if an error occurrs. The 2795 | execution engine is not garbage collected and must be destroyed with 2796 | [dispose ee]. 2797 | See the function [llvm::EngineBuilder::create]. *) 2798 | val create_interpreter : llmodule -> t 2799 | 2800 | (** [create_jit m optlevel] creates a new JIT (just-in-time compiler), taking 2801 | ownership of the module [m] if successful with the desired optimization 2802 | level [optlevel]. Raises [Fail msg] if an error occurrs. The execution 2803 | engine is not garbage collected and must be destroyed with [dispose ee]. 2804 | See the function [llvm::EngineBuilder::create]. *) 2805 | val create_jit : llmodule -> int -> t 2806 | 2807 | (** [dispose ee] releases the memory used by the execution engine and must be 2808 | invoked to avoid memory leaks. *) 2809 | val dispose : t -> unit 2810 | 2811 | (** [add_module m ee] adds the module [m] to the execution engine [ee]. *) 2812 | val add_module : llmodule -> t -> unit 2813 | 2814 | (* 2815 | (** [remove_module m ee] removes the module [m] from the execution engine 2816 | [ee], disposing of [m] and the module referenced by [mp]. Raises 2817 | [Fail msg] if an error occurs. *) 2818 | val remove_module : llmodule -> t -> llmodule 2819 | *) 2820 | 2821 | (** [find_function n ee] finds the function named [n] defined in any of the 2822 | modules owned by the execution engine [ee]. Returns [None] if the function 2823 | is not found and [Some f] otherwise. *) 2824 | val find_function : string -> t -> llvalue option 2825 | 2826 | (** [run_function f args ee] synchronously executes the function [f] with the 2827 | arguments [args], which must be compatible with the parameter types. *) 2828 | val run_function : llvalue -> GenericValue.t list -> t -> GenericValue.t 2829 | 2830 | (* 2831 | (** [run_static_ctors ee] executes the static constructors of each module in 2832 | the execution engine [ee]. *) 2833 | val run_static_ctors : t -> unit 2834 | 2835 | (** [run_static_dtors ee] executes the static destructors of each module in 2836 | the execution engine [ee]. *) 2837 | val run_static_dtors : t -> unit 2838 | 2839 | (** [run_function_as_main f args env ee] executes the function [f] as a main 2840 | function, passing it [argv] and [argc] according to the string array 2841 | [args], and [envp] as specified by the array [env]. Returns the integer 2842 | return value of the function. *) 2843 | val run_function_as_main : Llvm.llvalue -> string array -> 2844 | (string * string) array -> t -> int 2845 | 2846 | 2847 | (** [free_machine_code f ee] releases the memory in the execution engine [ee] 2848 | used to store the machine code for the function [f]. *) 2849 | val free_machine_code : llvalue -> t -> unit 2850 | 2851 | 2852 | (** [target_data ee] is the target data owned by the execution engine 2853 | [ee]. *) 2854 | val target_data : t -> Llvm_target.TargetData.t 2855 | *) 2856 | 2857 | val initialize : unit -> unit 2858 | val initialize_native_target : unit -> bool 2859 | end 2860 | 2861 | end 2862 | -------------------------------------------------------------------------------- /llvm_core.sml: -------------------------------------------------------------------------------- 1 | structure LlvmCore :> LLVM_CORE = struct 2 | 3 | fun die s = raise Fail ("LlvmCore." ^ s) 4 | 5 | type llcontext = foreignptr 6 | type llmodule = foreignptr 7 | type lltype = foreignptr 8 | type llvalue = foreignptr 9 | type lluse = foreignptr 10 | type llbasicblock = foreignptr 11 | type llbuilder = foreignptr 12 | type llmemorybuffer = foreignptr 13 | 14 | structure TypeKind = struct 15 | datatype t = Void | Half | Float | Double | X86fp80 | Fp128 | Ppc_fp128 | 16 | Label | Integer | Function | Struct | Array | Pointer | Vector | 17 | Metadata 18 | 19 | val toString = fn Void => "Void" | Half => "Half" | Float => "Float" | Double => "Double" 20 | | X86fp80 => "X86fp80" | Fp128 => "Fp128" | Ppc_fp128 => "Ppc_fp128" 21 | | Label => "Label" | Integer => "Integer" | Function => "Function" 22 | | Struct => "Struct" | Array => "Array" | Pointer => "Pointer" 23 | | Vector => "Vector" | Metadata => "Metadata" 24 | val fromInt = 25 | fn 0 => Void | 1 => Half | 2 => Float | 3 => Double | 4 => X86fp80 | 5 => Fp128 26 | | 6 => Ppc_fp128 | 7 => Label | 8 => Integer | 9 => Function | 10 => Struct 27 | | 11 => Array | 12 => Pointer | 13 => Vector | 14 => Metadata 28 | | n => die ("TypeKind.fromInt: unknown value " ^ Int.toString n) 29 | end 30 | 31 | structure Linkage = struct 32 | datatype t = External | Available_externally | Link_once | Link_once_odr | 33 | Weak | Weak_odr | Appending | Internal | Private | Dllimport | 34 | Dllexport | External_weak | Ghost | Common | Linker_private 35 | end 36 | 37 | structure Visibility = struct 38 | datatype t = Default | Hidden | Protected 39 | end 40 | 41 | structure CallConv = struct 42 | val c = 0 43 | val fast = 8 44 | val cold = 9 45 | val x86_stdcall = 64 46 | val x86_fastcall = 65 47 | end 48 | 49 | structure Attribute = struct 50 | datatype t = Zext | Sext | Noreturn | Inreg | Structret | Nounwind | 51 | Noalias | Byval | Nest | Readnone | Readonly | Noinline | 52 | Alwaysinline | Optsize | Ssp | Sspreq | Alignment of int | Nocapture | 53 | Noredzone | Noimplicitfloat | Naked | Inlinehint | 54 | Stackalignment of int | ReturnsTwice | UWTable | NonLazyBind 55 | end 56 | 57 | structure Icmp = struct 58 | datatype t = Eq | Ne | Ugt | Uge | Ult | Ule | Sgt | Sge | Slt | Sle 59 | val index = 60 | fn Eq => 0 | Ne => 1 | Ugt => 2 | Uge => 3 | Ult => 4 | Ule => 5 | Sgt => 6 | Sge => 7 | Slt => 8 | Sle => 9 61 | end 62 | 63 | structure Fcmp = struct 64 | datatype t = False | Oeq | Ogt | Oge | Olt | Ole | One | Ord | Uno | 65 | Ueq | Ugt | Uge | Ult | Ule | Une | True 66 | val index = 67 | fn False => 0 | Oeq => 1 | Ogt => 2 | Oge => 3 | Olt => 4 | Ole => 5 | One => 6 | Ord => 7 | Uno => 8 | 68 | Ueq => 9 | Ugt => 10 | Uge => 11 | Ult => 12 | Ule => 13 | Une => 14 | True => 15 69 | end 70 | 71 | structure Opcode = struct 72 | datatype t = 73 | (* not an instruction *) 74 | Invalid | 75 | 76 | (* Terminator Instructions *) 77 | Ret | Br | Switch | IndirectBr | Invoke | Invalid2 | 78 | Unreachable | 79 | 80 | (* Standard Binary Operators *) 81 | Add | FAdd | Sub | FSub | Mul | FMul | UDiv | SDiv | FDiv | 82 | URem | SRem | FRem | 83 | 84 | (* Logical Operators *) 85 | Shl | LShr | AShr | And | Or | Xor | 86 | 87 | (* Memory Operators *) 88 | Alloca | Load | Store | GetElementPtr | 89 | 90 | (* Cast Operators *) 91 | Trunc | ZExt | SExt | FPToUI | FPToSI | UIToFP | SIToFP | 92 | FPTrunc | FPExt | PtrToInt | IntToPtr | BitCast | 93 | 94 | (* Other Operators *) 95 | ICmp | FCmp | PHI | Call | Select | UserOp1 | UserOp2 | VAArg | 96 | ExtractElement | InsertElement | ShuffleVector | ExtractValue | 97 | InsertValue | Fence | AtomicCmpXchg | AtomicRMW | Resume | 98 | LandingPad | Unwind 99 | end 100 | 101 | structure ValueKind = struct 102 | datatype t = NullValue | Argument | BasicBlock | InlineAsm | MDNode | 103 | MDString | BlockAddress | ConstantAggregateZero | ConstantArray | 104 | ConstantExpr | ConstantFP | ConstantInt | ConstantPointerNull | 105 | ConstantStruct | ConstantVector | Function | GlobalAlias | 106 | GlobalVariable | UndefValue | Instruction of Opcode.t 107 | end 108 | 109 | (* 110 | datatype ('a, 'b) llpos = At_end of 'a | Before of 'b 111 | 112 | datatype ('a, 'b) llrev_pos = At_start of 'a | After of 'b 113 | *) 114 | 115 | exception IoError of string 116 | 117 | (*===-- Contexts ----------------------------------------------------------===*) 118 | val create_context : unit -> llcontext = fn () => prim("@LLVMContextCreate",()) 119 | val dispose_context : llcontext -> unit = fn C => prim("@LLVMContextDispose", C) 120 | val global_context : unit -> llcontext = fn () => prim("@LLVMGetGlobalContext",()) 121 | val mdkind_id : llcontext -> string -> int = fn C => fn Name => prim("@LLVMGetMDKindIDInContext",(C,Name,size Name)) 122 | 123 | (*===-- Modules -----------------------------------------------------------===*) 124 | val create_module : llcontext -> string -> llmodule = fn C => fn n => prim("@LLVMModuleCreateWithNameInContext", (n,C)) 125 | 126 | val dispose_module : llmodule -> unit = fn m => prim("@LLVMDisposeModule", m) 127 | 128 | (* 129 | external target_triple: llmodule -> string = "llvm_target_triple" 130 | external set_target_triple: string -> llmodule -> unit = "llvm_set_target_triple" 131 | external data_layout: llmodule -> string = "llvm_data_layout" 132 | external set_data_layout: string -> llmodule -> unit = "llvm_set_data_layout" 133 | external dump_module : llmodule -> unit = "llvm_dump_module" 134 | external set_module_inline_asm : llmodule -> string -> unit = "llvm_set_module_inline_asm" 135 | *) 136 | 137 | val module_context : llmodule -> llcontext = fn m => prim("@LLVMGetModuleContext", m) 138 | 139 | (*===-- Types -------------------------------------------------------------===*) 140 | 141 | val classify_type : lltype -> TypeKind.t = 142 | fn t => let val i : int = prim("@LLVMGetTypeKind", t) 143 | in TypeKind.fromInt i 144 | end 145 | val type_context : lltype -> llcontext = 146 | fn t => prim("@LLVMGetTypeContext", t) 147 | (* 148 | external type_is_sized : lltype -> bool = "llvm_type_is_sized" 149 | *) 150 | 151 | (*--... Operations on integer types ........................................--*) 152 | val i1_type : llcontext -> lltype = fn C => prim("@LLVMInt1TypeInContext",C) 153 | val i8_type : llcontext -> lltype = fn C => prim("@LLVMInt8TypeInContext",C) 154 | val i16_type : llcontext -> lltype = fn C => prim("@LLVMInt16TypeInContext",C) 155 | val i32_type : llcontext -> lltype = fn C => prim("@LLVMInt32TypeInContext",C) 156 | val i64_type : llcontext -> lltype = fn C => prim("@LLVMInt64TypeInContext",C) 157 | val integer_type : llcontext -> int -> lltype = fn C => fn width => prim("@LLVMIntTypeInContext", (C,width)) 158 | val integer_bitwidth : lltype -> int = fn t => prim("@LLVMGetIntTypeWidth", t) 159 | 160 | (*--... Operations on real types ...........................................--*) 161 | 162 | val float_type : llcontext -> lltype = 163 | fn c => prim("@LLVMFloatTypeInContext", c) 164 | val double_type : llcontext -> lltype = 165 | fn c => prim("@LLVMDoubleTypeInContext", c) 166 | (* 167 | external x86fp80_type : llcontext -> lltype = "llvm_x86fp80_type" 168 | external fp128_type : llcontext -> lltype = "llvm_fp128_type" 169 | external ppc_fp128_type : llcontext -> lltype = "llvm_ppc_fp128_type" 170 | *) 171 | 172 | (*--... Operations on function types .......................................--*) 173 | val function_type : lltype -> lltype list -> lltype = fn t => fn l => prim("mlkit_llvm_function_type",(t,l)) 174 | val var_arg_function_type : lltype -> lltype list -> lltype = fn t => fn l => prim("mlkit_llvm_var_arg_function_type",(t,l)) 175 | val is_var_arg : lltype -> bool = fn t => prim("@LLVMIsFunctionVarArg",t) 176 | val return_type : lltype -> lltype = fn t => prim("@LLVMGetReturnType",t) 177 | 178 | (* 179 | external param_types : lltype -> lltype array = "llvm_param_types" 180 | *) 181 | 182 | (*--... Operations on struct types .........................................--*) 183 | (* 184 | external struct_type : llcontext -> lltype array -> lltype = "llvm_struct_type" 185 | external packed_struct_type : llcontext -> lltype array -> lltype 186 | = "llvm_packed_struct_type" 187 | external struct_name : lltype -> string option = "llvm_struct_name" 188 | external named_struct_type : llcontext -> string -> lltype = 189 | "llvm_named_struct_type" 190 | external struct_set_body : lltype -> lltype array -> bool -> unit = 191 | "llvm_struct_set_body" 192 | external struct_element_types : lltype -> lltype array 193 | = "llvm_struct_element_types" 194 | external is_packed : lltype -> bool = "llvm_is_packed" 195 | external is_opaque : lltype -> bool = "llvm_is_opaque" 196 | *) 197 | 198 | (*--... Operations on pointer, vector, and array types .....................--*) 199 | 200 | (* 201 | external array_type : lltype -> int -> lltype = "llvm_array_type" 202 | *) 203 | val pointer_type : lltype -> lltype = fn t => prim("@LLVMPointerType", (t,0)) 204 | (* 205 | external qualified_pointer_type : lltype -> int -> lltype 206 | = "llvm_qualified_pointer_type" 207 | external vector_type : lltype -> int -> lltype = "llvm_vector_type" 208 | *) 209 | val element_type : lltype -> lltype = fn t => prim("@LLVMGetElementType", t) 210 | val array_length : lltype -> int = fn t => prim("@LLVMGetArrayLength", t) 211 | 212 | (* 213 | external address_space : lltype -> int = "llvm_address_space" 214 | external vector_size : lltype -> int = "llvm_vector_size" 215 | *) 216 | 217 | (*--... Operations on other types ..........................................--*) 218 | (* 219 | external void_type : llcontext -> lltype = "llvm_void_type" 220 | external label_type : llcontext -> lltype = "llvm_label_type" 221 | external type_by_name : llmodule -> string -> lltype option = "llvm_type_by_name" 222 | external classify_value : llvalue -> ValueKind.t = "llvm_classify_value" 223 | *) 224 | 225 | (*===-- Values ------------------------------------------------------------===*) 226 | val type_of : llvalue -> lltype = fn v => prim("@LLVMTypeOf", v) 227 | (* 228 | external value_name : llvalue -> string = "llvm_value_name" 229 | external set_value_name : string -> llvalue -> unit = "llvm_set_value_name" 230 | external dump_value : llvalue -> unit = "llvm_dump_value" 231 | external replace_all_uses_with : llvalue -> llvalue -> unit 232 | = "LLVMReplaceAllUsesWith" 233 | *) 234 | 235 | (*--... Operations on uses .................................................--*) 236 | (* 237 | external use_begin : llvalue -> lluse option = "llvm_use_begin" 238 | external use_succ : lluse -> lluse option = "llvm_use_succ" 239 | external user : lluse -> llvalue = "llvm_user" 240 | external used_value : lluse -> llvalue = "llvm_used_value" 241 | 242 | let iter_uses f v = 243 | let rec aux = function 244 | | None -> () 245 | | Some u -> 246 | f u; 247 | aux (use_succ u) 248 | in 249 | aux (use_begin v) 250 | 251 | let fold_left_uses f init v = 252 | let rec aux init u = 253 | match u with 254 | | None -> init 255 | | Some u -> aux (f init u) (use_succ u) 256 | in 257 | aux init (use_begin v) 258 | 259 | let fold_right_uses f v init = 260 | let rec aux u init = 261 | match u with 262 | | None -> init 263 | | Some u -> f u (aux (use_succ u) init) 264 | in 265 | aux (use_begin v) init 266 | *) 267 | 268 | (*--... Operations on users ................................................--*) 269 | (* 270 | external operand : llvalue -> int -> llvalue = "llvm_operand" 271 | external set_operand : llvalue -> int -> llvalue -> unit = "llvm_set_operand" 272 | external num_operands : llvalue -> int = "llvm_num_operands" 273 | *) 274 | 275 | (*--... Operations on constants of (mostly) any type .......................--*) 276 | (* 277 | external is_constant : llvalue -> bool = "llvm_is_constant" 278 | external const_null : lltype -> llvalue = "LLVMConstNull" 279 | external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes" 280 | external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull" 281 | external undef : lltype -> llvalue = "LLVMGetUndef" 282 | external is_null : llvalue -> bool = "llvm_is_null" 283 | external is_undef : llvalue -> bool = "llvm_is_undef" 284 | external constexpr_opcode : llvalue -> Opcode.t = "llvm_constexpr_get_opcode" 285 | *) 286 | 287 | (*--... Operations on instructions .........................................--*) 288 | (* 289 | external has_metadata : llvalue -> bool = "llvm_has_metadata" 290 | external metadata : llvalue -> int -> llvalue option = "llvm_metadata" 291 | external set_metadata : llvalue -> int -> llvalue -> unit = "llvm_set_metadata" 292 | external clear_metadata : llvalue -> int -> unit = "llvm_clear_metadata" 293 | *) 294 | 295 | (*--... Operations on metadata .......,.....................................--*) 296 | (* 297 | external mdstring : llcontext -> string -> llvalue = "llvm_mdstring" 298 | external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode" 299 | external get_mdstring : llvalue -> string option = "llvm_get_mdstring" 300 | external get_named_metadata : llmodule -> string -> llvalue array = "llvm_get_namedmd" 301 | *) 302 | 303 | (*--... Operations on scalar constants .....................................--*) 304 | val const_int : lltype -> int -> llvalue = 305 | fn t => fn i => prim("@mlkit_llvm_const_int",(t,i)) 306 | (* 307 | external const_of_int64 : lltype -> Int64.t -> bool -> llvalue 308 | = "llvm_const_of_int64" 309 | external int64_of_const : llvalue -> Int64.t option 310 | = "llvm_int64_of_const" 311 | external const_int_of_string : lltype -> string -> int -> llvalue 312 | = "llvm_const_int_of_string" 313 | *) 314 | val const_float : lltype -> real -> llvalue = 315 | fn t => fn d => prim("mlkit_llvm_const_float",(t,d)) 316 | (* 317 | external const_float_of_string : lltype -> string -> llvalue 318 | = "llvm_const_float_of_string" 319 | *) 320 | 321 | (*--... Operations on composite constants ..................................--*) 322 | val const_string : llcontext -> string -> llvalue = 323 | fn C => fn s => prim("@LLVMConstStringInContext",(C,s,size s,1)) 324 | val const_stringz : llcontext -> string -> llvalue = 325 | fn C => fn s => prim("@LLVMConstStringInContext",(C,s,size s,0)) 326 | (* 327 | external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array" 328 | external const_struct : llcontext -> llvalue array -> llvalue 329 | = "llvm_const_struct" 330 | external const_named_struct : lltype -> llvalue array -> llvalue 331 | = "llvm_const_named_struct" 332 | external const_packed_struct : llcontext -> llvalue array -> llvalue 333 | = "llvm_const_packed_struct" 334 | external const_vector : llvalue array -> llvalue = "llvm_const_vector" 335 | *) 336 | 337 | (*--... Constant expressions ...............................................--*) 338 | (* 339 | external align_of : lltype -> llvalue = "LLVMAlignOf" 340 | external size_of : lltype -> llvalue = "LLVMSizeOf" 341 | external const_neg : llvalue -> llvalue = "LLVMConstNeg" 342 | external const_nsw_neg : llvalue -> llvalue = "LLVMConstNSWNeg" 343 | external const_nuw_neg : llvalue -> llvalue = "LLVMConstNUWNeg" 344 | external const_fneg : llvalue -> llvalue = "LLVMConstFNeg" 345 | external const_not : llvalue -> llvalue = "LLVMConstNot" 346 | external const_add : llvalue -> llvalue -> llvalue = "LLVMConstAdd" 347 | external const_nsw_add : llvalue -> llvalue -> llvalue = "LLVMConstNSWAdd" 348 | external const_nuw_add : llvalue -> llvalue -> llvalue = "LLVMConstNUWAdd" 349 | external const_fadd : llvalue -> llvalue -> llvalue = "LLVMConstFAdd" 350 | external const_sub : llvalue -> llvalue -> llvalue = "LLVMConstSub" 351 | external const_nsw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNSWSub" 352 | external const_nuw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNUWSub" 353 | external const_fsub : llvalue -> llvalue -> llvalue = "LLVMConstFSub" 354 | external const_mul : llvalue -> llvalue -> llvalue = "LLVMConstMul" 355 | external const_nsw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNSWMul" 356 | external const_nuw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNUWMul" 357 | external const_fmul : llvalue -> llvalue -> llvalue = "LLVMConstFMul" 358 | external const_udiv : llvalue -> llvalue -> llvalue = "LLVMConstUDiv" 359 | external const_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstSDiv" 360 | external const_exact_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstExactSDiv" 361 | external const_fdiv : llvalue -> llvalue -> llvalue = "LLVMConstFDiv" 362 | external const_urem : llvalue -> llvalue -> llvalue = "LLVMConstURem" 363 | external const_srem : llvalue -> llvalue -> llvalue = "LLVMConstSRem" 364 | external const_frem : llvalue -> llvalue -> llvalue = "LLVMConstFRem" 365 | external const_and : llvalue -> llvalue -> llvalue = "LLVMConstAnd" 366 | external const_or : llvalue -> llvalue -> llvalue = "LLVMConstOr" 367 | external const_xor : llvalue -> llvalue -> llvalue = "LLVMConstXor" 368 | external const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue 369 | = "llvm_const_icmp" 370 | external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue 371 | = "llvm_const_fcmp" 372 | external const_shl : llvalue -> llvalue -> llvalue = "LLVMConstShl" 373 | external const_lshr : llvalue -> llvalue -> llvalue = "LLVMConstLShr" 374 | external const_ashr : llvalue -> llvalue -> llvalue = "LLVMConstAShr" 375 | external const_gep : llvalue -> llvalue array -> llvalue = "llvm_const_gep" 376 | external const_in_bounds_gep : llvalue -> llvalue array -> llvalue 377 | = "llvm_const_in_bounds_gep" 378 | external const_trunc : llvalue -> lltype -> llvalue = "LLVMConstTrunc" 379 | external const_sext : llvalue -> lltype -> llvalue = "LLVMConstSExt" 380 | external const_zext : llvalue -> lltype -> llvalue = "LLVMConstZExt" 381 | external const_fptrunc : llvalue -> lltype -> llvalue = "LLVMConstFPTrunc" 382 | external const_fpext : llvalue -> lltype -> llvalue = "LLVMConstFPExt" 383 | external const_uitofp : llvalue -> lltype -> llvalue = "LLVMConstUIToFP" 384 | external const_sitofp : llvalue -> lltype -> llvalue = "LLVMConstSIToFP" 385 | external const_fptoui : llvalue -> lltype -> llvalue = "LLVMConstFPToUI" 386 | external const_fptosi : llvalue -> lltype -> llvalue = "LLVMConstFPToSI" 387 | external const_ptrtoint : llvalue -> lltype -> llvalue = "LLVMConstPtrToInt" 388 | external const_inttoptr : llvalue -> lltype -> llvalue = "LLVMConstIntToPtr" 389 | external const_bitcast : llvalue -> lltype -> llvalue = "LLVMConstBitCast" 390 | external const_zext_or_bitcast : llvalue -> lltype -> llvalue 391 | = "LLVMConstZExtOrBitCast" 392 | external const_sext_or_bitcast : llvalue -> lltype -> llvalue 393 | = "LLVMConstSExtOrBitCast" 394 | external const_trunc_or_bitcast : llvalue -> lltype -> llvalue 395 | = "LLVMConstTruncOrBitCast" 396 | external const_pointercast : llvalue -> lltype -> llvalue 397 | = "LLVMConstPointerCast" 398 | external const_intcast : llvalue -> lltype -> llvalue = "LLVMConstIntCast" 399 | external const_fpcast : llvalue -> lltype -> llvalue = "LLVMConstFPCast" 400 | external const_select : llvalue -> llvalue -> llvalue -> llvalue 401 | = "LLVMConstSelect" 402 | external const_extractelement : llvalue -> llvalue -> llvalue 403 | = "LLVMConstExtractElement" 404 | external const_insertelement : llvalue -> llvalue -> llvalue -> llvalue 405 | = "LLVMConstInsertElement" 406 | external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue 407 | = "LLVMConstShuffleVector" 408 | external const_extractvalue : llvalue -> int array -> llvalue 409 | = "llvm_const_extractvalue" 410 | external const_insertvalue : llvalue -> llvalue -> int array -> llvalue 411 | = "llvm_const_insertvalue" 412 | external const_inline_asm : lltype -> string -> string -> bool -> bool -> 413 | llvalue 414 | = "llvm_const_inline_asm" 415 | external block_address : llvalue -> llbasicblock -> llvalue = "LLVMBlockAddress" 416 | *) 417 | 418 | (*--... Operations on global variables, functions, and aliases (globals) ...--*) 419 | (* 420 | external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent" 421 | external is_declaration : llvalue -> bool = "llvm_is_declaration" 422 | external linkage : llvalue -> Linkage.t = "llvm_linkage" 423 | external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage" 424 | external section : llvalue -> string = "llvm_section" 425 | external set_section : string -> llvalue -> unit = "llvm_set_section" 426 | external visibility : llvalue -> Visibility.t = "llvm_visibility" 427 | external set_visibility : Visibility.t -> llvalue -> unit = "llvm_set_visibility" 428 | external alignment : llvalue -> int = "llvm_alignment" 429 | external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" 430 | external is_global_constant : llvalue -> bool = "llvm_is_global_constant" 431 | external set_global_constant : bool -> llvalue -> unit 432 | = "llvm_set_global_constant" 433 | *) 434 | 435 | (*--... Operations on global variables .....................................--*) 436 | (* 437 | external declare_global : lltype -> string -> llmodule -> llvalue 438 | = "llvm_declare_global" 439 | external declare_qualified_global : lltype -> string -> int -> llmodule -> 440 | llvalue 441 | = "llvm_declare_qualified_global" 442 | *) 443 | val define_global : string -> llvalue -> llmodule -> llvalue = 444 | fn n => fn v => fn m => 445 | let val gv : llvalue = prim("@LLVMAddGlobal",(m,type_of v,n)) 446 | val () = prim("@LLVMSetInitializer",(gv,v)) 447 | in gv 448 | end 449 | (* 450 | external define_qualified_global : string -> llvalue -> int -> llmodule -> 451 | llvalue 452 | = "llvm_define_qualified_global" 453 | external lookup_global : string -> llmodule -> llvalue option 454 | = "llvm_lookup_global" 455 | external delete_global : llvalue -> unit = "llvm_delete_global" 456 | external global_initializer : llvalue -> llvalue = "LLVMGetInitializer" 457 | external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer" 458 | external remove_initializer : llvalue -> unit = "llvm_remove_initializer" 459 | external is_thread_local : llvalue -> bool = "llvm_is_thread_local" 460 | external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local" 461 | external global_begin : llmodule -> (llmodule, llvalue) llpos 462 | = "llvm_global_begin" 463 | external global_succ : llvalue -> (llmodule, llvalue) llpos 464 | = "llvm_global_succ" 465 | external global_end : llmodule -> (llmodule, llvalue) llrev_pos 466 | = "llvm_global_end" 467 | external global_pred : llvalue -> (llmodule, llvalue) llrev_pos 468 | = "llvm_global_pred" 469 | 470 | let rec iter_global_range f i e = 471 | if i = e then () else 472 | match i with 473 | | At_end _ -> raise (Invalid_argument "Invalid global variable range.") 474 | | Before bb -> 475 | f bb; 476 | iter_global_range f (global_succ bb) e 477 | 478 | let iter_globals f m = 479 | iter_global_range f (global_begin m) (At_end m) 480 | 481 | let rec fold_left_global_range f init i e = 482 | if i = e then init else 483 | match i with 484 | | At_end _ -> raise (Invalid_argument "Invalid global variable range.") 485 | | Before bb -> fold_left_global_range f (f init bb) (global_succ bb) e 486 | 487 | let fold_left_globals f init m = 488 | fold_left_global_range f init (global_begin m) (At_end m) 489 | 490 | let rec rev_iter_global_range f i e = 491 | if i = e then () else 492 | match i with 493 | | At_start _ -> raise (Invalid_argument "Invalid global variable range.") 494 | | After bb -> 495 | f bb; 496 | rev_iter_global_range f (global_pred bb) e 497 | 498 | let rev_iter_globals f m = 499 | rev_iter_global_range f (global_end m) (At_start m) 500 | 501 | let rec fold_right_global_range f i e init = 502 | if i = e then init else 503 | match i with 504 | | At_start _ -> raise (Invalid_argument "Invalid global variable range.") 505 | | After bb -> fold_right_global_range f (global_pred bb) e (f bb init) 506 | 507 | let fold_right_globals f m init = 508 | fold_right_global_range f (global_end m) (At_start m) init 509 | *) 510 | 511 | (*--... Operations on aliases ..............................................--*) 512 | (* 513 | external add_alias : llmodule -> lltype -> llvalue -> string -> llvalue 514 | = "llvm_add_alias" 515 | *) 516 | 517 | (*--... Operations on functions ............................................--*) 518 | val declare_function : string -> lltype -> llmodule -> llvalue = 519 | fn n => fn t => fn m => prim("@mlkit_llvm_declare_function",(n,t,m)) 520 | val define_function : string -> lltype -> llmodule -> llvalue = 521 | fn n => fn t => fn m => prim("@mlkit_llvm_define_function",(n,t,m)) 522 | (* 523 | external lookup_function : string -> llmodule -> llvalue option 524 | = "llvm_lookup_function" 525 | external delete_function : llvalue -> unit = "llvm_delete_function" 526 | external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic" 527 | external function_call_conv : llvalue -> int = "llvm_function_call_conv" 528 | external set_function_call_conv : int -> llvalue -> unit 529 | = "llvm_set_function_call_conv" 530 | external gc : llvalue -> string option = "llvm_gc" 531 | external set_gc : string option -> llvalue -> unit = "llvm_set_gc" 532 | external function_begin : llmodule -> (llmodule, llvalue) llpos 533 | = "llvm_function_begin" 534 | external function_succ : llvalue -> (llmodule, llvalue) llpos 535 | = "llvm_function_succ" 536 | external function_end : llmodule -> (llmodule, llvalue) llrev_pos 537 | = "llvm_function_end" 538 | external function_pred : llvalue -> (llmodule, llvalue) llrev_pos 539 | = "llvm_function_pred" 540 | 541 | let rec iter_function_range f i e = 542 | if i = e then () else 543 | match i with 544 | | At_end _ -> raise (Invalid_argument "Invalid function range.") 545 | | Before fn -> 546 | f fn; 547 | iter_function_range f (function_succ fn) e 548 | 549 | let iter_functions f m = 550 | iter_function_range f (function_begin m) (At_end m) 551 | 552 | let rec fold_left_function_range f init i e = 553 | if i = e then init else 554 | match i with 555 | | At_end _ -> raise (Invalid_argument "Invalid function range.") 556 | | Before fn -> fold_left_function_range f (f init fn) (function_succ fn) e 557 | 558 | let fold_left_functions f init m = 559 | fold_left_function_range f init (function_begin m) (At_end m) 560 | 561 | let rec rev_iter_function_range f i e = 562 | if i = e then () else 563 | match i with 564 | | At_start _ -> raise (Invalid_argument "Invalid function range.") 565 | | After fn -> 566 | f fn; 567 | rev_iter_function_range f (function_pred fn) e 568 | 569 | let rev_iter_functions f m = 570 | rev_iter_function_range f (function_end m) (At_start m) 571 | 572 | let rec fold_right_function_range f i e init = 573 | if i = e then init else 574 | match i with 575 | | At_start _ -> raise (Invalid_argument "Invalid function range.") 576 | | After fn -> fold_right_function_range f (function_pred fn) e (f fn init) 577 | 578 | let fold_right_functions f m init = 579 | fold_right_function_range f (function_end m) (At_start m) init 580 | 581 | external llvm_add_function_attr : llvalue -> int32 -> unit 582 | = "llvm_add_function_attr" 583 | external llvm_remove_function_attr : llvalue -> int32 -> unit 584 | = "llvm_remove_function_attr" 585 | external llvm_function_attr : llvalue -> int32 = "llvm_function_attr" 586 | 587 | let pack_attr (attr:Attribute.t) : int32 = 588 | match attr with 589 | Attribute.Zext -> Int32.shift_left 1l 0 590 | | Attribute.Sext -> Int32.shift_left 1l 1 591 | | Attribute.Noreturn -> Int32.shift_left 1l 2 592 | | Attribute.Inreg -> Int32.shift_left 1l 3 593 | | Attribute.Structret -> Int32.shift_left 1l 4 594 | | Attribute.Nounwind -> Int32.shift_left 1l 5 595 | | Attribute.Noalias -> Int32.shift_left 1l 6 596 | | Attribute.Byval -> Int32.shift_left 1l 7 597 | | Attribute.Nest -> Int32.shift_left 1l 8 598 | | Attribute.Readnone -> Int32.shift_left 1l 9 599 | | Attribute.Readonly -> Int32.shift_left 1l 10 600 | | Attribute.Noinline -> Int32.shift_left 1l 11 601 | | Attribute.Alwaysinline -> Int32.shift_left 1l 12 602 | | Attribute.Optsize -> Int32.shift_left 1l 13 603 | | Attribute.Ssp -> Int32.shift_left 1l 14 604 | | Attribute.Sspreq -> Int32.shift_left 1l 15 605 | | Attribute.Alignment n -> Int32.shift_left (Int32.of_int n) 16 606 | | Attribute.Nocapture -> Int32.shift_left 1l 21 607 | | Attribute.Noredzone -> Int32.shift_left 1l 22 608 | | Attribute.Noimplicitfloat -> Int32.shift_left 1l 23 609 | | Attribute.Naked -> Int32.shift_left 1l 24 610 | | Attribute.Inlinehint -> Int32.shift_left 1l 25 611 | | Attribute.Stackalignment n -> Int32.shift_left (Int32.of_int n) 26 612 | | Attribute.ReturnsTwice -> Int32.shift_left 1l 29 613 | | Attribute.UWTable -> Int32.shift_left 1l 30 614 | | Attribute.NonLazyBind -> Int32.shift_left 1l 31 615 | 616 | let unpack_attr (a : int32) : Attribute.t list = 617 | let l = ref [] in 618 | let check attr = 619 | Int32.logand (pack_attr attr) a in 620 | let checkattr attr = 621 | if (check attr) <> 0l then begin 622 | l := attr :: !l 623 | end 624 | in 625 | checkattr Attribute.Zext; 626 | checkattr Attribute.Sext; 627 | checkattr Attribute.Noreturn; 628 | checkattr Attribute.Inreg; 629 | checkattr Attribute.Structret; 630 | checkattr Attribute.Nounwind; 631 | checkattr Attribute.Noalias; 632 | checkattr Attribute.Byval; 633 | checkattr Attribute.Nest; 634 | checkattr Attribute.Readnone; 635 | checkattr Attribute.Readonly; 636 | checkattr Attribute.Noinline; 637 | checkattr Attribute.Alwaysinline; 638 | checkattr Attribute.Optsize; 639 | checkattr Attribute.Ssp; 640 | checkattr Attribute.Sspreq; 641 | let align = Int32.logand (Int32.shift_right_logical a 16) 31l in 642 | if align <> 0l then 643 | l := Attribute.Alignment (Int32.to_int align) :: !l; 644 | checkattr Attribute.Nocapture; 645 | checkattr Attribute.Noredzone; 646 | checkattr Attribute.Noimplicitfloat; 647 | checkattr Attribute.Naked; 648 | checkattr Attribute.Inlinehint; 649 | let stackalign = Int32.logand (Int32.shift_right_logical a 26) 7l in 650 | if stackalign <> 0l then 651 | l := Attribute.Stackalignment (Int32.to_int stackalign) :: !l; 652 | checkattr Attribute.ReturnsTwice; 653 | checkattr Attribute.UWTable; 654 | checkattr Attribute.NonLazyBind; 655 | !l;; 656 | 657 | let add_function_attr llval attr = 658 | llvm_add_function_attr llval (pack_attr attr) 659 | 660 | let remove_function_attr llval attr = 661 | llvm_remove_function_attr llval (pack_attr attr) 662 | 663 | let function_attr f = unpack_attr (llvm_function_attr f) 664 | *) 665 | 666 | (*--... Operations on params ...............................................--*) 667 | (* 668 | external params : llvalue -> llvalue array = "llvm_params" 669 | *) 670 | val param : llvalue -> int -> llvalue = fn v => fn i => prim("@LLVMGetParam",(v,i)) 671 | (* 672 | external llvm_param_attr : llvalue -> int32 = "llvm_param_attr" 673 | let param_attr p = unpack_attr (llvm_param_attr p) 674 | external param_parent : llvalue -> llvalue = "LLVMGetParamParent" 675 | external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin" 676 | external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ" 677 | external param_end : llvalue -> (llvalue, llvalue) llrev_pos = "llvm_param_end" 678 | external param_pred : llvalue -> (llvalue, llvalue) llrev_pos ="llvm_param_pred" 679 | 680 | let rec iter_param_range f i e = 681 | if i = e then () else 682 | match i with 683 | | At_end _ -> raise (Invalid_argument "Invalid parameter range.") 684 | | Before p -> 685 | f p; 686 | iter_param_range f (param_succ p) e 687 | 688 | let iter_params f fn = 689 | iter_param_range f (param_begin fn) (At_end fn) 690 | 691 | let rec fold_left_param_range f init i e = 692 | if i = e then init else 693 | match i with 694 | | At_end _ -> raise (Invalid_argument "Invalid parameter range.") 695 | | Before p -> fold_left_param_range f (f init p) (param_succ p) e 696 | 697 | let fold_left_params f init fn = 698 | fold_left_param_range f init (param_begin fn) (At_end fn) 699 | 700 | let rec rev_iter_param_range f i e = 701 | if i = e then () else 702 | match i with 703 | | At_start _ -> raise (Invalid_argument "Invalid parameter range.") 704 | | After p -> 705 | f p; 706 | rev_iter_param_range f (param_pred p) e 707 | 708 | let rev_iter_params f fn = 709 | rev_iter_param_range f (param_end fn) (At_start fn) 710 | 711 | let rec fold_right_param_range f init i e = 712 | if i = e then init else 713 | match i with 714 | | At_start _ -> raise (Invalid_argument "Invalid parameter range.") 715 | | After p -> fold_right_param_range f (f p init) (param_pred p) e 716 | 717 | let fold_right_params f fn init = 718 | fold_right_param_range f init (param_end fn) (At_start fn) 719 | 720 | external llvm_add_param_attr : llvalue -> int32 -> unit 721 | = "llvm_add_param_attr" 722 | external llvm_remove_param_attr : llvalue -> int32 -> unit 723 | = "llvm_remove_param_attr" 724 | 725 | let add_param_attr llval attr = 726 | llvm_add_param_attr llval (pack_attr attr) 727 | 728 | let remove_param_attr llval attr = 729 | llvm_remove_param_attr llval (pack_attr attr) 730 | 731 | external set_param_alignment : llvalue -> int -> unit 732 | = "llvm_set_param_alignment" 733 | *) 734 | (*--... Operations on basic blocks .........................................--*) 735 | (* 736 | external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" 737 | external value_is_block : llvalue -> bool = "llvm_value_is_block" 738 | external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" 739 | external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent" 740 | external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks" 741 | *) 742 | val entry_block : llvalue -> llbasicblock = fn v => prim("@LLVMGetEntryBasicBlock",v) 743 | val delete_block : llbasicblock -> unit = fn b => prim("@LLVMDeleteBasicBlock", b) 744 | val append_block : llcontext -> string -> llvalue -> llbasicblock = fn C => fn n => fn v => prim("@LLVMAppendBasicBlockInContext", (C,v,n)) 745 | (* 746 | external insert_block : llcontext -> string -> llbasicblock -> llbasicblock 747 | = "llvm_insert_block" 748 | external block_begin : llvalue -> (llvalue, llbasicblock) llpos 749 | = "llvm_block_begin" 750 | external block_succ : llbasicblock -> (llvalue, llbasicblock) llpos 751 | = "llvm_block_succ" 752 | external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos 753 | = "llvm_block_end" 754 | external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos 755 | = "llvm_block_pred" 756 | external block_terminator : llbasicblock -> llvalue option = 757 | "llvm_block_terminator" 758 | 759 | let rec iter_block_range f i e = 760 | if i = e then () else 761 | match i with 762 | | At_end _ -> raise (Invalid_argument "Invalid block range.") 763 | | Before bb -> 764 | f bb; 765 | iter_block_range f (block_succ bb) e 766 | 767 | let iter_blocks f fn = 768 | iter_block_range f (block_begin fn) (At_end fn) 769 | 770 | let rec fold_left_block_range f init i e = 771 | if i = e then init else 772 | match i with 773 | | At_end _ -> raise (Invalid_argument "Invalid block range.") 774 | | Before bb -> fold_left_block_range f (f init bb) (block_succ bb) e 775 | 776 | let fold_left_blocks f init fn = 777 | fold_left_block_range f init (block_begin fn) (At_end fn) 778 | 779 | let rec rev_iter_block_range f i e = 780 | if i = e then () else 781 | match i with 782 | | At_start _ -> raise (Invalid_argument "Invalid block range.") 783 | | After bb -> 784 | f bb; 785 | rev_iter_block_range f (block_pred bb) e 786 | 787 | let rev_iter_blocks f fn = 788 | rev_iter_block_range f (block_end fn) (At_start fn) 789 | 790 | let rec fold_right_block_range f init i e = 791 | if i = e then init else 792 | match i with 793 | | At_start _ -> raise (Invalid_argument "Invalid block range.") 794 | | After bb -> fold_right_block_range f (f bb init) (block_pred bb) e 795 | 796 | let fold_right_blocks f fn init = 797 | fold_right_block_range f init (block_end fn) (At_start fn) 798 | *) 799 | 800 | (*--... Operations on instructions .........................................--*) 801 | (* 802 | external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" 803 | external instr_begin : llbasicblock -> (llbasicblock, llvalue) llpos 804 | = "llvm_instr_begin" 805 | external instr_succ : llvalue -> (llbasicblock, llvalue) llpos 806 | = "llvm_instr_succ" 807 | external instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos 808 | = "llvm_instr_end" 809 | external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos 810 | = "llvm_instr_pred" 811 | 812 | external instr_opcode : llvalue -> Opcode.t = "llvm_instr_get_opcode" 813 | external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate" 814 | 815 | external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate" 816 | 817 | let rec iter_instrs_range f i e = 818 | if i = e then () else 819 | match i with 820 | | At_end _ -> raise (Invalid_argument "Invalid instruction range.") 821 | | Before i -> 822 | f i; 823 | iter_instrs_range f (instr_succ i) e 824 | 825 | let iter_instrs f bb = 826 | iter_instrs_range f (instr_begin bb) (At_end bb) 827 | 828 | let rec fold_left_instrs_range f init i e = 829 | if i = e then init else 830 | match i with 831 | | At_end _ -> raise (Invalid_argument "Invalid instruction range.") 832 | | Before i -> fold_left_instrs_range f (f init i) (instr_succ i) e 833 | 834 | let fold_left_instrs f init bb = 835 | fold_left_instrs_range f init (instr_begin bb) (At_end bb) 836 | 837 | let rec rev_iter_instrs_range f i e = 838 | if i = e then () else 839 | match i with 840 | | At_start _ -> raise (Invalid_argument "Invalid instruction range.") 841 | | After i -> 842 | f i; 843 | rev_iter_instrs_range f (instr_pred i) e 844 | 845 | let rev_iter_instrs f bb = 846 | rev_iter_instrs_range f (instr_end bb) (At_start bb) 847 | 848 | let rec fold_right_instr_range f i e init = 849 | if i = e then init else 850 | match i with 851 | | At_start _ -> raise (Invalid_argument "Invalid instruction range.") 852 | | After i -> fold_right_instr_range f (instr_pred i) e (f i init) 853 | 854 | let fold_right_instrs f bb init = 855 | fold_right_instr_range f (instr_end bb) (At_start bb) init 856 | *) 857 | 858 | (*--... Operations on call sites ...........................................--*) 859 | (* 860 | external instruction_call_conv: llvalue -> int 861 | = "llvm_instruction_call_conv" 862 | external set_instruction_call_conv: int -> llvalue -> unit 863 | = "llvm_set_instruction_call_conv" 864 | 865 | external llvm_add_instruction_param_attr : llvalue -> int -> int32 -> unit 866 | = "llvm_add_instruction_param_attr" 867 | external llvm_remove_instruction_param_attr : llvalue -> int -> int32 -> unit 868 | = "llvm_remove_instruction_param_attr" 869 | 870 | let add_instruction_param_attr llval i attr = 871 | llvm_add_instruction_param_attr llval i (pack_attr attr) 872 | 873 | let remove_instruction_param_attr llval i attr = 874 | llvm_remove_instruction_param_attr llval i (pack_attr attr) 875 | *) 876 | 877 | (*--... Operations on call instructions (only) .............................--*) 878 | (* 879 | external is_tail_call : llvalue -> bool = "llvm_is_tail_call" 880 | external set_tail_call : bool -> llvalue -> unit = "llvm_set_tail_call" 881 | *) 882 | 883 | (*--... Operations on phi nodes ............................................--*) 884 | (* 885 | external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit 886 | = "llvm_add_incoming" 887 | external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" 888 | 889 | external delete_instruction : llvalue -> unit = "llvm_delete_instruction" 890 | *) 891 | 892 | (*===-- Instruction builders ----------------------------------------------===*) 893 | val create_builder : llcontext -> llbuilder = fn C => prim("@LLVMCreateBuilderInContext",C) 894 | (* 895 | external builder : llcontext -> llbuilder = "llvm_builder" 896 | external position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit 897 | = "llvm_position_builder" 898 | external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block" 899 | external insert_into_builder : llvalue -> string -> llbuilder -> unit 900 | = "llvm_insert_into_builder" 901 | *) 902 | val position_builder_end : llbuilder -> llbasicblock -> unit = fn b => fn bb => prim("@LLVMPositionBuilderAtEnd", (b,bb)) 903 | 904 | fun builder_at_end context bb = 905 | let val b = create_builder context 906 | in position_builder_end b bb; 907 | b 908 | end 909 | 910 | val dispose_builder : llbuilder -> unit = fn b => prim("@LLVMDisposeBuilder", b) 911 | 912 | (* 913 | let builder_at context ip = 914 | let b = builder context in 915 | position_builder ip b; 916 | b 917 | 918 | let builder_before context i = builder_at context (Before i) 919 | let builder_at_end context bb = builder_at context (At_end bb) 920 | 921 | let position_before i = position_builder (Before i) 922 | let position_at_end bb = position_builder (At_end bb) 923 | *) 924 | 925 | (*--... Metadata ...........................................................--*) 926 | (* 927 | external set_current_debug_location : llbuilder -> llvalue -> unit 928 | = "llvm_set_current_debug_location" 929 | external clear_current_debug_location : llbuilder -> unit 930 | = "llvm_clear_current_debug_location" 931 | external current_debug_location : llbuilder -> llvalue option 932 | = "llvm_current_debug_location" 933 | external set_inst_debug_location : llbuilder -> llvalue -> unit 934 | = "llvm_set_inst_debug_location" 935 | *) 936 | 937 | (*--... Terminators ........................................................--*) 938 | val build_ret_void : llbuilder -> llvalue = fn b => prim("@LLVMBuildRetVoid",b) 939 | val build_ret : llvalue -> llbuilder -> llvalue = fn v => fn b => prim("@LLVMBuildRet", (b,v)) 940 | (* 941 | external build_aggregate_ret : llvalue array -> llbuilder -> llvalue 942 | = "llvm_build_aggregate_ret" 943 | *) 944 | val build_br : llbasicblock -> llbuilder -> llvalue = fn bb => fn b => prim("@LLVMBuildBr", (b,bb)) 945 | val build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue = 946 | fn v => fn bb1 => fn bb2 => fn b => prim("@LLVMBuildCondBr", (b,v,bb1,bb2)) 947 | (* 948 | external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue 949 | = "llvm_build_switch" 950 | external build_malloc : lltype -> string -> llbuilder -> llvalue = 951 | "llvm_build_malloc" 952 | external build_array_malloc : lltype -> llvalue -> string -> llbuilder -> 953 | llvalue = "llvm_build_array_malloc" 954 | external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free" 955 | external add_case : llvalue -> llvalue -> llbasicblock -> unit 956 | = "llvm_add_case" 957 | external switch_default_dest : llvalue -> llbasicblock = 958 | "LLVMGetSwitchDefaultDest" 959 | external build_indirect_br : llvalue -> int -> llbuilder -> llvalue 960 | = "llvm_build_indirect_br" 961 | external add_destination : llvalue -> llbasicblock -> unit 962 | = "llvm_add_destination" 963 | external build_invoke : llvalue -> llvalue array -> llbasicblock -> 964 | llbasicblock -> string -> llbuilder -> llvalue 965 | = "llvm_build_invoke_bc" "llvm_build_invoke_nat" 966 | external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder -> 967 | llvalue = "llvm_build_landingpad" 968 | external set_cleanup : llvalue -> bool -> unit = "llvm_set_cleanup" 969 | external add_clause : llvalue -> llvalue -> unit = "llvm_add_clause" 970 | external build_resume : llvalue -> llbuilder -> llvalue = "llvm_build_resume" 971 | external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable" 972 | *) 973 | 974 | (*--... Arithmetic .........................................................--*) 975 | val build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue = 976 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildAdd", (b,v1,v2,n)) 977 | (* 978 | external build_nsw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 979 | = "llvm_build_nsw_add" 980 | external build_nuw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue 981 | = "llvm_build_nuw_add" 982 | *) 983 | val build_fadd : llvalue -> llvalue -> string -> llbuilder -> llvalue = 984 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildFAdd", (b,v1,v2,n)) 985 | val build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue = 986 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildSub", (b,v1,v2,n)) 987 | (* 988 | external build_nsw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 989 | = "llvm_build_nsw_sub" 990 | external build_nuw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue 991 | = "llvm_build_nuw_sub" 992 | *) 993 | val build_fsub : llvalue -> llvalue -> string -> llbuilder -> llvalue = 994 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildFSub", (b,v1,v2,n)) 995 | val build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue = 996 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildMul", (b,v1,v2,n)) 997 | (* 998 | external build_nsw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 999 | = "llvm_build_nsw_mul" 1000 | external build_nuw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue 1001 | = "llvm_build_nuw_mul" 1002 | *) 1003 | val build_fmul : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1004 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildFMul", (b,v1,v2,n)) 1005 | val build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1006 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildUDiv", (b,v1,v2,n)) 1007 | val build_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1008 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildSDiv", (b,v1,v2,n)) 1009 | (* 1010 | external build_exact_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue 1011 | = "llvm_build_exact_sdiv" 1012 | *) 1013 | val build_fdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1014 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildFDiv", (b,v1,v2,n)) 1015 | val build_urem : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1016 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildURem", (b,v1,v2,n)) 1017 | val build_srem : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1018 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildSRem", (b,v1,v2,n)) 1019 | val build_frem : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1020 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildFRem", (b,v1,v2,n)) 1021 | val build_shl : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1022 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildShl", (b,v1,v2,n)) 1023 | val build_lshr : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1024 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildLShr", (b,v1,v2,n)) 1025 | val build_ashr : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1026 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildAShr", (b,v1,v2,n)) 1027 | val build_and : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1028 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildAnd", (b,v1,v2,n)) 1029 | val build_or : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1030 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildOr", (b,v1,v2,n)) 1031 | val build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue = 1032 | fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildXor", (b,v1,v2,n)) 1033 | val build_neg : llvalue -> string -> llbuilder -> llvalue = 1034 | fn v => fn n => fn b => prim("@LLVMBuildNeg", (b,v,n)) 1035 | (* 1036 | external build_nsw_neg : llvalue -> string -> llbuilder -> llvalue 1037 | = "llvm_build_nsw_neg" 1038 | external build_nuw_neg : llvalue -> string -> llbuilder -> llvalue 1039 | = "llvm_build_nuw_neg" 1040 | *) 1041 | val build_fneg : llvalue -> string -> llbuilder -> llvalue = 1042 | fn v => fn n => fn b => prim("@LLVMBuildFNeg", (b,v,n)) 1043 | 1044 | val build_not : llvalue -> string -> llbuilder -> llvalue = 1045 | fn v => fn n => fn b => prim("@LLVMBuildNot", (b,v,n)) 1046 | 1047 | (*--... Memory .............................................................--*) 1048 | (* 1049 | external build_alloca : lltype -> string -> llbuilder -> llvalue 1050 | = "llvm_build_alloca" 1051 | external build_array_alloca : lltype -> llvalue -> string -> llbuilder -> 1052 | llvalue = "llvm_build_array_alloca" 1053 | external build_load : llvalue -> string -> llbuilder -> llvalue 1054 | = "llvm_build_load" 1055 | external build_store : llvalue -> llvalue -> llbuilder -> llvalue 1056 | = "llvm_build_store" 1057 | *) 1058 | val build_gep : llvalue -> llvalue list -> string -> llbuilder -> llvalue = 1059 | fn v => fn vs => fn n => fn b => prim("mlkit_llvm_build_gep", (v,vs,n,b)) 1060 | (* 1061 | external build_in_bounds_gep : llvalue -> llvalue array -> string -> 1062 | llbuilder -> llvalue = "llvm_build_in_bounds_gep" 1063 | external build_struct_gep : llvalue -> int -> string -> llbuilder -> llvalue 1064 | = "llvm_build_struct_gep" 1065 | 1066 | external build_global_string : string -> string -> llbuilder -> llvalue 1067 | = "llvm_build_global_string" 1068 | external build_global_stringptr : string -> string -> llbuilder -> llvalue 1069 | = "llvm_build_global_stringptr" 1070 | *) 1071 | 1072 | (*--... Casts ..............................................................--*) 1073 | val build_trunc : llvalue -> lltype -> string -> llbuilder -> llvalue = 1074 | fn v => fn t => fn n => fn b => prim("@LLVMBuildTrunc", (b,v,t,n)) 1075 | val build_zext : llvalue -> lltype -> string -> llbuilder -> llvalue = 1076 | fn v => fn t => fn n => fn b => prim("@LLVMBuildZExt", (b,v,t,n)) 1077 | val build_sext : llvalue -> lltype -> string -> llbuilder -> llvalue = 1078 | fn v => fn t => fn n => fn b => prim("@LLVMBuildSExt", (b,v,t,n)) 1079 | val build_fptoui : llvalue -> lltype -> string -> llbuilder -> llvalue = 1080 | fn v => fn t => fn n => fn b => prim("@LLVMBuildFPToUI", (b,v,t,n)) 1081 | val build_fptosi : llvalue -> lltype -> string -> llbuilder -> llvalue = 1082 | fn v => fn t => fn n => fn b => prim("@LLVMBuildFPToSI", (b,v,t,n)) 1083 | val build_uitofp : llvalue -> lltype -> string -> llbuilder -> llvalue = 1084 | fn v => fn t => fn n => fn b => prim("@LLVMBuildUIToFP", (b,v,t,n)) 1085 | val build_sitofp : llvalue -> lltype -> string -> llbuilder -> llvalue = 1086 | fn v => fn t => fn n => fn b => prim("@LLVMBuildSIToFP", (b,v,t,n)) 1087 | val build_fptrunc : llvalue -> lltype -> string -> llbuilder -> llvalue = 1088 | fn v => fn t => fn n => fn b => prim("@LLVMBuildFPTrunc", (b,v,t,n)) 1089 | val build_fpext : llvalue -> lltype -> string -> llbuilder -> llvalue = 1090 | fn v => fn t => fn n => fn b => prim("@LLVMBuildFPExt", (b,v,t,n)) 1091 | (* 1092 | external build_ptrtoint : llvalue -> lltype -> string -> llbuilder -> llvalue 1093 | = "llvm_build_prttoint" 1094 | external build_inttoptr : llvalue -> lltype -> string -> llbuilder -> llvalue 1095 | = "llvm_build_inttoptr" 1096 | external build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue 1097 | = "llvm_build_bitcast" 1098 | external build_zext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 1099 | llvalue = "llvm_build_zext_or_bitcast" 1100 | external build_sext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 1101 | llvalue = "llvm_build_sext_or_bitcast" 1102 | external build_trunc_or_bitcast : llvalue -> lltype -> string -> llbuilder -> 1103 | llvalue = "llvm_build_trunc_or_bitcast" 1104 | external build_pointercast : llvalue -> lltype -> string -> llbuilder -> llvalue 1105 | = "llvm_build_pointercast" 1106 | external build_intcast : llvalue -> lltype -> string -> llbuilder -> llvalue 1107 | = "llvm_build_intcast" 1108 | external build_fpcast : llvalue -> lltype -> string -> llbuilder -> llvalue 1109 | = "llvm_build_fpcast" 1110 | *) 1111 | 1112 | (*--... Comparisons ........................................................--*) 1113 | fun mem (f:unit -> 'a) : unit -> 'a = 1114 | let val r : 'a option ref = ref NONE 1115 | in fn () => case !r of SOME v => v 1116 | | NONE => let val v = f() in r := SOME v; v end 1117 | end 1118 | 1119 | val LLVMIntEQ : unit -> int = 1120 | mem (fn () => prim("@mlkit_llvm_IntEQ",())) 1121 | 1122 | val build_icmp : Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue = 1123 | fn c => fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildICmp", (b,Icmp.index c + LLVMIntEQ(),v1,v2,n)) 1124 | 1125 | val build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue = 1126 | fn c => fn v1 => fn v2 => fn n => fn b => prim("@LLVMBuildFCmp", (b,Fcmp.index c,v1,v2,n)) 1127 | 1128 | (*--... Miscellaneous instructions .........................................--*) 1129 | val build_phi_node : lltype -> string -> llbuilder -> llvalue = 1130 | fn t => fn n => fn b => prim("@LLVMBuildPhi",(b,t,n)) 1131 | 1132 | val mlkit_add_incoming : llvalue -> llvalue -> llbasicblock -> unit = 1133 | fn node => fn v => fn bb => prim("@mlkit_add_incoming",(node,v,bb)) 1134 | 1135 | val build_phi : (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue = 1136 | fn nodes => fn n => fn b => 1137 | case nodes of 1138 | nil => die "build_phi: empty list" 1139 | | (v,_) :: _ => 1140 | let val node = build_phi_node (type_of v) n b 1141 | in List.app (fn (v,bb) => mlkit_add_incoming node v bb) nodes 1142 | ; node 1143 | end 1144 | 1145 | val build_call : llvalue -> llvalue list -> string -> llbuilder -> llvalue = 1146 | fn v => fn vs => fn n => fn b => prim("mlkit_llvm_build_call", (v,vs,n,b)) 1147 | 1148 | (* 1149 | external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder -> 1150 | llvalue = "llvm_build_select" 1151 | external build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue 1152 | = "llvm_build_va_arg" 1153 | external build_extractelement : llvalue -> llvalue -> string -> llbuilder -> 1154 | llvalue = "llvm_build_extractelement" 1155 | external build_insertelement : llvalue -> llvalue -> llvalue -> string -> 1156 | llbuilder -> llvalue = "llvm_build_insertelement" 1157 | external build_shufflevector : llvalue -> llvalue -> llvalue -> string -> 1158 | llbuilder -> llvalue = "llvm_build_shufflevector" 1159 | external build_extractvalue : llvalue -> int -> string -> llbuilder -> llvalue 1160 | = "llvm_build_extractvalue" 1161 | external build_insertvalue : llvalue -> llvalue -> int -> string -> llbuilder -> 1162 | llvalue = "llvm_build_insertvalue" 1163 | 1164 | external build_is_null : llvalue -> string -> llbuilder -> llvalue 1165 | = "llvm_build_is_null" 1166 | external build_is_not_null : llvalue -> string -> llbuilder -> llvalue 1167 | = "llvm_build_is_not_null" 1168 | external build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue 1169 | = "llvm_build_ptrdiff" 1170 | *) 1171 | 1172 | (*===-- Memory buffers ----------------------------------------------------===*) 1173 | (* 1174 | module MemoryBuffer = struct 1175 | external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file" 1176 | external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin" 1177 | external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose" 1178 | end 1179 | *) 1180 | 1181 | (*===-- Pass Manager ------------------------------------------------------===*) 1182 | (* 1183 | module PassManager = struct 1184 | type 'a t 1185 | type any = [ `Module | `Function ] 1186 | external create : unit -> [ `Module ] t = "llvm_passmanager_create" 1187 | external create_function : llmodule -> [ `Function ] t 1188 | = "LLVMCreateFunctionPassManager" 1189 | external run_module : llmodule -> [ `Module ] t -> bool 1190 | = "llvm_passmanager_run_module" 1191 | external initialize : [ `Function ] t -> bool = "llvm_passmanager_initialize" 1192 | external run_function : llvalue -> [ `Function ] t -> bool 1193 | = "llvm_passmanager_run_function" 1194 | external finalize : [ `Function ] t -> bool = "llvm_passmanager_finalize" 1195 | external dispose : [< any ] t -> unit = "llvm_passmanager_dispose" 1196 | end 1197 | *) 1198 | 1199 | (*===-- Non-Externs -------------------------------------------------------===*) 1200 | (* These functions are built using the externals, so must be declared late. *) 1201 | (* 1202 | let concat2 sep arr = 1203 | let s = ref "" in 1204 | if 0 < Array.length arr then begin 1205 | s := !s ^ arr.(0); 1206 | for i = 1 to (Array.length arr) - 1 do 1207 | s := !s ^ sep ^ arr.(i) 1208 | done 1209 | end; 1210 | !s 1211 | *) 1212 | fun string_of_lltype ty = 1213 | (* FIXME: stop infinite recursion! :) *) 1214 | case classify_type ty of 1215 | TypeKind.Integer => "i" ^ Int.toString (integer_bitwidth ty) 1216 | | TypeKind.Pointer => 1217 | let val ety = element_type ty 1218 | in (*case classify_type ety of 1219 | TypeKind.Struct => 1220 | (case struct_name ety of 1221 | None => (string_of_lltype ety) 1222 | | Some s => s) ^ "*" 1223 | | _ =>*) (string_of_lltype (element_type ty)) ^ "*" 1224 | end 1225 | (* 1226 | | TypeKind.Struct => 1227 | let val s = "{ " ^ (concat2 ", " ( 1228 | Array.map string_of_lltype (struct_element_types ty) 1229 | )) ^ " }" 1230 | in if is_packed ty then "<" ^ s ^ ">" else s 1231 | end 1232 | | TypeKind.Array => "[" ^ (string_of_int (array_length ty)) ^ 1233 | " x " ^ (string_of_lltype (element_type ty)) ^ "]" 1234 | | TypeKind.Vector => "<" ^ (string_of_int (vector_size ty)) ^ 1235 | " x " ^ (string_of_lltype (element_type ty)) ^ ">" 1236 | | TypeKind.Function => string_of_lltype (return_type ty) ^ 1237 | " (" ^ (concat2 ", " ( 1238 | Array.map string_of_lltype (param_types ty) 1239 | )) ^ ")" 1240 | *) 1241 | | TypeKind.Label => "label" 1242 | | TypeKind.Ppc_fp128 => "ppc_fp128" 1243 | | TypeKind.Fp128 => "fp128" 1244 | | TypeKind.X86fp80 => "x86_fp80" 1245 | | TypeKind.Double => "double" 1246 | | TypeKind.Float => "float" 1247 | | TypeKind.Half => "half" 1248 | | TypeKind.Void => "void" 1249 | | TypeKind.Metadata => "metadata" 1250 | | x => die ("string_of_lltype.unsupported type: " ^ TypeKind.toString x) 1251 | 1252 | val write_bitcode_file : llmodule -> string -> bool = fn m => fn f => prim("@mlkit_llvm_write_bitcode_file", (m,f)) 1253 | 1254 | structure GenericValue = struct 1255 | type t = foreignptr 1256 | 1257 | val of_float: lltype -> real -> t = 1258 | fn t => fn r => prim("mlkit_llvm_genericvalue_of_float", (t,r)) 1259 | (* 1260 | external of_pointer: 'a -> t 1261 | = "llvm_genericvalue_of_pointer" 1262 | external of_int32: Llvm.lltype -> int32 -> t 1263 | = "llvm_genericvalue_of_int32" 1264 | *) 1265 | val of_int: lltype -> int -> t = 1266 | fn t => fn i => prim("@mlkit_llvm_genericvalue_of_int", (t,i)) 1267 | (* 1268 | external of_nativeint: Llvm.lltype -> nativeint -> t 1269 | = "llvm_genericvalue_of_nativeint" 1270 | external of_int64: Llvm.lltype -> int64 -> t 1271 | = "llvm_genericvalue_of_int64" 1272 | *) 1273 | val as_float: lltype -> t -> real = 1274 | fn t => fn g => prim("mlkit_llvm_genericvalue_as_float",(t,g)) 1275 | (* 1276 | external as_pointer: t -> 'a 1277 | = "llvm_genericvalue_as_pointer" 1278 | external as_int32: t -> int32 1279 | = "llvm_genericvalue_as_int32" 1280 | *) 1281 | val as_int: t -> int = 1282 | fn t => prim("@mlkit_llvm_genericvalue_as_int", t) 1283 | (* 1284 | external as_nativeint: t -> nativeint 1285 | = "llvm_genericvalue_as_nativeint" 1286 | external as_int64: t -> int64 1287 | = "llvm_genericvalue_as_int64" 1288 | *) 1289 | end 1290 | 1291 | 1292 | structure ExecutionEngine = struct 1293 | type t = foreignptr 1294 | 1295 | val create: llmodule -> t = 1296 | fn m => prim("@mlkit_llvm_ee_create", m) 1297 | 1298 | val create_interpreter: llmodule -> t = 1299 | fn m => prim("@mlkit_llvm_ee_create_interpreter",m) 1300 | 1301 | val create_jit: llmodule -> int -> t = 1302 | fn m => fn i => prim("@mlkit_llvm_ee_create_jit",(m,i)) 1303 | 1304 | val dispose: t -> unit = 1305 | fn ee => prim("@LLVMDisposeExecutionEngine", ee) 1306 | 1307 | val add_module: llmodule -> t -> unit = 1308 | fn m => fn t => prim("@LLVMAddModule", (t,m)) 1309 | (* 1310 | val remove_module: llmodule -> t -> llmodule = 1311 | fn m => fn t => prim("@mlkit_llvm_ee_remove_module") 1312 | *) 1313 | 1314 | val find_function: string -> t -> llvalue option = 1315 | fn s => fn ee => 1316 | SOME(prim("@mlkit_llvm_ee_find_function", (s,ee))) 1317 | handle _ => NONE 1318 | 1319 | val run_function: llvalue -> GenericValue.t list -> t -> GenericValue.t = 1320 | fn f => fn args => fn ee => prim("mlkit_llvm_ee_run_function", (f, args, ee)) 1321 | (* 1322 | external run_static_ctors: t -> unit 1323 | = "llvm_ee_run_static_ctors" 1324 | external run_static_dtors: t -> unit 1325 | = "llvm_ee_run_static_dtors" 1326 | external run_function_as_main: Llvm.llvalue -> string array -> 1327 | (string * string) array -> t -> int 1328 | = "llvm_ee_run_function_as_main" 1329 | external free_machine_code: Llvm.llvalue -> t -> unit 1330 | = "llvm_ee_free_machine_code" 1331 | 1332 | external target_data: t -> Llvm_target.TargetData.t 1333 | = "LLVMGetExecutionEngineTargetData" 1334 | *) 1335 | 1336 | (* The following are not bound. Patches are welcome. 1337 | 1338 | get_target_data: t -> lltargetdata 1339 | add_global_mapping: llvalue -> llgenericvalue -> t -> unit 1340 | clear_all_global_mappings: t -> unit 1341 | update_global_mapping: llvalue -> llgenericvalue -> t -> unit 1342 | get_pointer_to_global_if_available: llvalue -> t -> llgenericvalue 1343 | get_pointer_to_global: llvalue -> t -> llgenericvalue 1344 | get_pointer_to_function: llvalue -> t -> llgenericvalue 1345 | get_pointer_to_function_or_stub: llvalue -> t -> llgenericvalue 1346 | get_global_value_at_address: llgenericvalue -> t -> llvalue option 1347 | store_value_to_memory: llgenericvalue -> llgenericvalue -> lltype -> unit 1348 | initialize_memory: llvalue -> llgenericvalue -> t -> unit 1349 | recompile_and_relink_function: llvalue -> t -> llgenericvalue 1350 | get_or_emit_global_variable: llvalue -> t -> llgenericvalue 1351 | disable_lazy_compilation: t -> unit 1352 | lazy_compilation_enabled: t -> bool 1353 | install_lazy_function_creator: (string -> llgenericvalue) -> t -> unit 1354 | *) 1355 | 1356 | val initialize : unit -> unit = fn () => prim("mlkit_llvm_initialize",()) 1357 | val initialize_native_target : unit -> bool = fn () => prim("@mlkit_llvm_initialize_native_target",()) 1358 | 1359 | end 1360 | 1361 | end 1362 | -------------------------------------------------------------------------------- /llvm_mlkit.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "llvm-c/ExecutionEngine.h" 3 | #include "llvm-c/BitWriter.h" 4 | #include "llvm-c/Core.h" 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | #include "List.h" 11 | #include "String.h" 12 | #include "Exception.h" 13 | #include "Region.h" 14 | #include "Tagging.h" 15 | 16 | /* lltype -> int -> llvalue */ 17 | /* MLKit auto conversion: YES */ 18 | LLVMValueRef mlkit_llvm_const_int(LLVMTypeRef IntTy, int N) { 19 | return LLVMConstInt(IntTy, (long long)N, 1); 20 | } 21 | 22 | /* lltype -> real -> llvalue */ 23 | /* MLKit auto conversion: NO */ 24 | LLVMValueRef mlkit_llvm_const_float(LLVMTypeRef RealTy, ssize_t d) { 25 | LLVMValueRef result; 26 | double value = get_d(d); 27 | RealTy = (LLVMTypeRef)untag_scalar(RealTy); 28 | result = LLVMConstReal(RealTy, value); 29 | result = (LLVMValueRef)tag_scalar(result); 30 | return result; 31 | } 32 | 33 | /* llvalue -> llvalue list -> string -> llbuilder -> llvalue */ 34 | /* MLKit auto conversion: NO */ 35 | LLVMValueRef mlkit_llvm_build_call(LLVMValueRef Fn, uintptr_t Params, 36 | String Name, LLVMBuilderRef B) { 37 | int n = 0; 38 | uintptr_t list = Params; 39 | LLVMValueRef * array; 40 | LLVMValueRef elemML; 41 | LLVMValueRef result; 42 | char *name = &(Name -> data); 43 | Fn = (LLVMValueRef)untag_scalar(Fn); 44 | B = (LLVMBuilderRef)untag_scalar(B); 45 | for (n = 0; isCONS(list); list = tl(list), n++); 46 | array = (LLVMValueRef *) malloc(sizeof(LLVMValueRef) * (n+1)); 47 | list = Params; 48 | for (n = 0; isCONS(list); list = tl(list), n++) { 49 | elemML = (LLVMValueRef) hd(list); 50 | elemML = (LLVMValueRef) untag_scalar(elemML); 51 | array[n] = elemML; 52 | } 53 | array[n] = NULL; 54 | result = LLVMBuildCall(B, Fn, array, n, name); 55 | result = (LLVMValueRef)tag_scalar(result); 56 | return result; 57 | } 58 | 59 | /* unit -> int */ 60 | /* MLKit auto conversion: YES */ 61 | int mlkit_llvm_IntEQ() { 62 | return LLVMIntEQ; 63 | } 64 | 65 | /* string -> lltype -> llmodule -> llvalue */ 66 | /* MLKit auto conversion: YES */ 67 | LLVMValueRef mlkit_llvm_define_function(char* Name, LLVMTypeRef Ty, LLVMModuleRef M) { 68 | LLVMValueRef Fn = LLVMAddFunction(M, Name, Ty); 69 | LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry"); 70 | return Fn; 71 | } 72 | 73 | /* string -> lltype -> llmodule -> llvalue */ 74 | /* MLKit auto conversion: YES */ 75 | LLVMValueRef mlkit_llvm_declare_function(char* Name, LLVMTypeRef Ty, LLVMModuleRef M) { 76 | LLVMValueRef Fn; 77 | if ((Fn = LLVMGetNamedFunction(M, Name))) { 78 | if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty) 79 | return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0)); 80 | return Fn; 81 | } 82 | return LLVMAddFunction(M, Name, Ty); 83 | } 84 | 85 | void mlkit_llvm_print_type(LLVMTypeRef Ty) { 86 | printf("%p\n",Ty); 87 | } 88 | 89 | 90 | /* lltype -> lltype list -> lltype */ 91 | /* MLKit auto conversion: NO */ 92 | LLVMTypeRef mlkit_llvm_function_type0(LLVMTypeRef RetTy, 93 | uintptr_t ParamTys, int kind) { 94 | LLVMTypeRef *tyArray; 95 | uintptr_t list = ParamTys; 96 | LLVMTypeRef result; 97 | LLVMTypeRef elemML; 98 | int n = 0; 99 | RetTy = (LLVMTypeRef)untag_scalar(RetTy); 100 | for (n = 0; isCONS(list); list = tl(list), n++); 101 | tyArray = (LLVMTypeRef *) malloc(sizeof(LLVMTypeRef) * (n+1)); 102 | list = ParamTys; 103 | for (n = 0; isCONS(list); list = tl(list), n++) { 104 | elemML = (LLVMTypeRef) hd(list); 105 | elemML = (LLVMTypeRef) untag_scalar(elemML); 106 | tyArray[n] = elemML; 107 | } 108 | tyArray[n] = NULL; 109 | result = LLVMFunctionType(RetTy, tyArray, n, kind); 110 | result = (LLVMTypeRef)tag_scalar(result); 111 | return result; 112 | } 113 | 114 | /* lltype -> lltype list -> lltype */ 115 | /* MLKit auto conversion: NO */ 116 | LLVMTypeRef mlkit_llvm_var_arg_function_type(LLVMTypeRef RetTy, uintptr_t ParamTys) { 117 | return mlkit_llvm_function_type0(RetTy, ParamTys, 1); 118 | } 119 | 120 | /* lltype -> lltype list -> lltype */ 121 | /* MLKit auto conversion: NO */ 122 | LLVMTypeRef mlkit_llvm_function_type(LLVMTypeRef RetTy, uintptr_t ParamTys) { 123 | return mlkit_llvm_function_type0(RetTy, ParamTys, 0); 124 | } 125 | 126 | /* llvalue -> llvalue list -> string -> llbuilder -> llvalue */ 127 | /* MLKit auto conversion: NO */ 128 | LLVMValueRef mlkit_llvm_build_gep(LLVMValueRef Pointer, uintptr_t Indices, 129 | String Name, LLVMBuilderRef B) { 130 | int n = 0; 131 | LLVMValueRef result; 132 | LLVMValueRef elemML; 133 | LLVMValueRef * array; 134 | uintptr_t list = Indices; 135 | Pointer = (LLVMValueRef)untag_scalar(Pointer); 136 | B = (LLVMBuilderRef)untag_scalar(B); 137 | for (n = 0; isCONS(list); list = tl(list), n++); 138 | array = (LLVMValueRef *) malloc(sizeof(LLVMValueRef) * (n+1)); 139 | list = Indices; 140 | for (n = 0; isCONS(list); list = tl(list), n++) { 141 | elemML = (LLVMValueRef) hd(list); 142 | elemML = (LLVMValueRef) untag_scalar(elemML); 143 | array[n] = elemML; 144 | } 145 | array[n] = NULL; 146 | result = LLVMBuildGEP(B, Pointer, array, n, &(Name -> data)); 147 | result = (LLVMValueRef)tag_scalar(result); 148 | return result; 149 | } 150 | 151 | /* llvalue -> llvalue -> llbasicblock -> unit */ 152 | /* MLKit auto conversion: YES */ 153 | void mlkit_add_incoming(LLVMValueRef PhiNode, LLVMValueRef value, LLVMBasicBlockRef bb) { 154 | LLVMAddIncoming(PhiNode, (LLVMValueRef*) &value, (LLVMBasicBlockRef*) &bb, 1); 155 | } 156 | 157 | /* llmodule -> string -> bool */ 158 | /* MLKit auto conversion: YES */ 159 | int mlkit_llvm_write_bitcode_file(LLVMModuleRef M, char* Path) { 160 | int res = LLVMWriteBitcodeToFile(M, Path); 161 | return res == 0; 162 | } 163 | 164 | /* GenericValue support */ 165 | 166 | /* lltype -> real -> t */ 167 | /* MLKit auto conversion: NO */ 168 | LLVMGenericValueRef mlkit_llvm_genericvalue_of_float(LLVMTypeRef Ty, ssize_t f) { 169 | LLVMGenericValueRef result; 170 | double d = get_d(f); 171 | Ty = (LLVMTypeRef) untag_scalar(Ty); 172 | result = LLVMCreateGenericValueOfFloat(Ty, d); 173 | result = (LLVMGenericValueRef) tag_scalar(result); 174 | return result; 175 | } 176 | 177 | /* lltype -> int -> t */ 178 | /* MLKit auto conversion: YES */ 179 | LLVMGenericValueRef mlkit_llvm_genericvalue_of_int(LLVMTypeRef Ty, int i) { 180 | return LLVMCreateGenericValueOfInt(Ty, i, 1); 181 | } 182 | 183 | /* lltype -> t -> real */ 184 | /* MLKit auto conversion: NO */ 185 | ssize_t mlkit_llvm_genericvalue_as_float(ssize_t d, LLVMTypeRef Ty, LLVMGenericValueRef g) { 186 | Ty = (LLVMTypeRef) untag_scalar(Ty); 187 | g = (LLVMGenericValueRef) untag_scalar(g); 188 | get_d(d) = LLVMGenericValueToFloat(Ty,g); 189 | set_dtag(d); 190 | return d; 191 | } 192 | 193 | /* t -> int */ 194 | /* MLKit auto conversion: YES */ 195 | int mlkit_llvm_genericvalue_as_int(LLVMGenericValueRef g) { 196 | if (LLVMGenericValueIntWidth(g) > 8 * sizeof(ssize_t)) { 197 | raise_exn((uintptr_t)&exn_OVERFLOW); 198 | } 199 | return LLVMGenericValueToInt(g, 1); 200 | } 201 | 202 | /* Execution Engine support */ 203 | 204 | /* llmodule -> t */ 205 | /* MLKit auto conversion: YES */ 206 | LLVMExecutionEngineRef mlkit_llvm_ee_create(LLVMModuleRef M) { 207 | LLVMExecutionEngineRef Engine; 208 | char *Error; 209 | if (LLVMCreateExecutionEngineForModule(&Engine, M, &Error)) { 210 | printf("mlkit_llvm_ee_create: %s\n", Error); 211 | raise_exn((uintptr_t)&exn_OVERFLOW); 212 | } 213 | return Engine; 214 | } 215 | 216 | /* llmodule -> t */ 217 | /* MLKit auto conversion: YES */ 218 | LLVMExecutionEngineRef mlkit_llvm_ee_create_interpreter(LLVMModuleRef M) { 219 | LLVMExecutionEngineRef Engine; 220 | char *Error; 221 | if (LLVMCreateInterpreterForModule(&Engine, M, &Error)) { 222 | printf("mlkit_llvm_ee_create_interpreter: %s\n", Error); 223 | raise_exn((uintptr_t)&exn_OVERFLOW); 224 | } 225 | return Engine; 226 | } 227 | 228 | /* llmodule -> int -> t */ 229 | /* MLKit auto conversion: YES */ 230 | LLVMExecutionEngineRef mlkit_llvm_ee_create_jit(LLVMModuleRef M, int optlevel) { 231 | LLVMExecutionEngineRef Engine; 232 | char *Error; 233 | if (LLVMCreateJITCompilerForModule(&Engine, M, optlevel, &Error)) { 234 | printf("mlkit_llvm_ee_create_jit: %s\n", Error); 235 | raise_exn((uintptr_t)&exn_OVERFLOW); 236 | } 237 | return Engine; 238 | } 239 | 240 | /* string -> t -> llvalue */ 241 | /* MLKit auto conversion: YES */ 242 | LLVMValueRef mlkit_llvm_ee_find_function(char *Name, LLVMExecutionEngineRef EE) { 243 | LLVMValueRef Found; 244 | if (LLVMFindFunction(EE, Name, &Found)) { 245 | raise_exn((uintptr_t)&exn_OVERFLOW); 246 | } 247 | return Found; 248 | } 249 | 250 | /* llvalue -> GenericValue.t list -> t -> GenericValue.t */ 251 | /* MLKit auto conversion: NO */ 252 | LLVMGenericValueRef mlkit_llvm_ee_run_function(LLVMValueRef f, uintptr_t args, LLVMExecutionEngineRef ee) { 253 | LLVMGenericValueRef result, elemML, *array; 254 | int n = 0; 255 | uintptr_t list = args; 256 | f = (LLVMValueRef) untag_scalar(f); 257 | ee = (LLVMExecutionEngineRef) untag_scalar(ee); 258 | 259 | for (n = 0; isCONS(list); list = tl(list), n++); 260 | array = (LLVMGenericValueRef *) malloc(sizeof(LLVMGenericValueRef) * (n+1)); 261 | list = args; 262 | for (n = 0; isCONS(list); list = tl(list), n++) { 263 | elemML = (LLVMGenericValueRef) hd(list); 264 | elemML = (LLVMGenericValueRef) untag_scalar(elemML); 265 | array[n] = elemML; 266 | } 267 | array[n] = NULL; 268 | 269 | result = LLVMRunFunction(ee, f, n, array); 270 | result = (LLVMGenericValueRef) tag_scalar(result); 271 | return result; 272 | } 273 | 274 | /* Force the LLVM interpreter and JIT to be linked in. */ 275 | void mlkit_llvm_initialize(void) { 276 | LLVMLinkInInterpreter(); 277 | LLVMLinkInJIT(); 278 | } 279 | 280 | /* unit -> bool */ 281 | /* MLKit auto conversion: YES */ 282 | int mlkit_llvm_initialize_native_target() { 283 | return LLVMInitializeNativeTarget(); 284 | } 285 | -------------------------------------------------------------------------------- /test/miniml/miniml.mlb: -------------------------------------------------------------------------------- 1 | local 2 | $(SML_LIB)/basis/basis.mlb 3 | ../../llvm.mlb 4 | in 5 | miniml.sml 6 | end -------------------------------------------------------------------------------- /test/miniml/miniml.sml: -------------------------------------------------------------------------------- 1 | (* A Simple ML-like language ported to Standard ML from OCaml; see 2 | http://groups.google.com/group/fa.caml/msg/5aee553df34548e2 3 | *) 4 | 5 | datatype prim = Add | Sub | Leq 6 | 7 | datatype expr = 8 | Int of int 9 | | Var of string 10 | | BinOp of prim * expr * expr 11 | | If of expr * expr * expr 12 | | Apply of expr * expr 13 | 14 | datatype defn = 15 | LetRec of string * string * expr 16 | 17 | structure L = LlvmCore 18 | 19 | fun ty c = L.i64_type c 20 | 21 | type state = 22 | { context: L.llcontext, 23 | func: L.llvalue, 24 | blk: L.llbasicblock, 25 | vars: (string * L.llvalue) list } 26 | 27 | fun bb (state:state) = L.builder_at_end (#context state) (#blk state) 28 | 29 | fun new_block (state:state) name = L.append_block (#context state) name (#func state) 30 | 31 | fun find (state:state) v = 32 | case List.find (fn y => v = #1 y) (#vars state) of 33 | SOME v => #2 v 34 | | NONE => raise Fail ("Unknown variable " ^ v) 35 | 36 | fun cont (v, state) dest_blk = 37 | let val _ = L.build_br dest_blk (bb state) 38 | in (v, state) 39 | end 40 | 41 | fun expr (state:state) = 42 | fn Int n => (L.const_int (ty (#context state)) n, state) 43 | | Var x => (find state x, state) 44 | | BinOp(p, f, g) => 45 | let val (f, state) = expr state f 46 | val (g, state) = expr state g 47 | val (build, name) = 48 | case p of 49 | Add => (L.build_add, "add") 50 | | Sub => (L.build_sub, "sub") 51 | | Leq => (L.build_icmp L.Icmp.Sle, "leq") 52 | in (build f g name (bb state), state) 53 | end 54 | | If(p, t, f) => 55 | let val t_blk = new_block state "pass" 56 | val f_blk = new_block state "fail" 57 | val k_blk = new_block state "cont" 58 | val (cond, state) = expr state p 59 | val _ = L.build_cond_br cond t_blk f_blk (bb state) 60 | val state = {func=(#func state),blk=t_blk,vars=(#vars state),context=(#context state)} 61 | val (t, state) = cont (expr state t) k_blk 62 | val state = {func=(#func state),blk=f_blk,vars=(#vars state),context=(#context state)} 63 | val (f, state) = cont (expr state f) k_blk 64 | in (L.build_phi [(t, t_blk), (f, f_blk)] "join" (bb state), state) 65 | end 66 | | Apply(f, arg) => 67 | let val (f, state) = expr state f 68 | val (arg, state) = expr state arg 69 | in (L.build_call f [arg] "apply" (bb state), state) 70 | end 71 | 72 | fun defn context m (LetRec(f, arg, body), vars) = 73 | let val t = ty context 74 | val fty = L.function_type t [t] 75 | val func = L.define_function f fty m 76 | val vars' = (arg, L.param func 0) :: (f, func) :: vars 77 | val state = {func=func, blk = L.entry_block func, vars=vars', context=context} 78 | val (body, state) = expr state body 79 | val _ = L.build_ret body (bb state) 80 | in (f, func) :: vars 81 | end 82 | 83 | fun int c n = L.const_int (ty c) n 84 | 85 | fun mk_module (program,run) = 86 | let val c = L.create_context() 87 | val m = L.create_module c "themodule" 88 | val string = L.pointer_type (L.i8_type c) 89 | val printf = L.declare_function "printf" (L.var_arg_function_type (ty c) [string]) m 90 | val main = L.define_function "main" (L.function_type (ty c) []) m 91 | val blk = L.entry_block main 92 | val bb = L.builder_at_end c blk 93 | fun str s = L.define_global "buf" (L.const_stringz c s) m 94 | val int_spec = L.build_gep (str "Running MiniML function...\nResult = %d\n") [int c 0, int c 0] "int_spec" bb 95 | val vars = List.foldl (defn c m) [] program 96 | val state = {func=main,blk=blk,vars=vars,context=c} 97 | val (n, _) = expr state run 98 | val _ = L.build_call printf [int_spec, n] "" bb 99 | val _ = L.build_ret (int c 0) bb 100 | in (m,c,main) 101 | end 102 | 103 | fun compile prog filename = 104 | let val (m,c,_) = mk_module prog 105 | in if not (L.write_bitcode_file m filename) then () 106 | else (L.dispose_module m; 107 | L.dispose_context c) 108 | end 109 | 110 | structure GV = L.GenericValue 111 | structure EE = L.ExecutionEngine 112 | 113 | fun run create_engine prog = 114 | let val (m,c,main) = mk_module prog 115 | val ee = create_engine m 116 | in EE.run_function main [] ee; () 117 | end 118 | 119 | local 120 | fun add a b = BinOp(Add,a,b) 121 | fun sub a b = BinOp(Sub,a,b) 122 | fun iff c a b = If(c,a,b) 123 | fun leq a b = BinOp(Leq,a,b) 124 | fun i n = Int n 125 | fun $ s = Var s 126 | fun apply n b = Apply(Var n,b) 127 | in 128 | val ex1 = 129 | ([LetRec("fib", "n", iff (leq ($"n") (i 2)) 130 | (i 1) 131 | (add (apply ("fib") (sub ($"n") (i 1))) 132 | (apply ("fib") (sub ($"n") (i 2))))) 133 | ], 134 | apply "fib" (i 40)) 135 | end 136 | 137 | val () = 138 | case CommandLine.arguments() of 139 | ["-jit"] => (EE.initialize_native_target(); run (fn m => EE.create_jit m 3) ex1) 140 | | ["-interp"] => run EE.create_interpreter ex1 141 | | [filename] => compile ex1 filename 142 | | _ => print ("Usage: " ^ CommandLine.name() ^ " \n") 143 | -------------------------------------------------------------------------------- /test/unittest/unittest.mlb: -------------------------------------------------------------------------------- 1 | local 2 | $(SML_LIB)/basis/basis.mlb 3 | ../../llvm.mlb 4 | in 5 | unittest.sml 6 | end -------------------------------------------------------------------------------- /test/unittest/unittest.sml: -------------------------------------------------------------------------------- 1 | (* Simple unit tests for the MLKit llvm bindings *) 2 | 3 | (* Auxiliary functions for test cases *) 4 | 5 | signature UTEST = sig 6 | val start : string -> string -> unit 7 | val finish : unit -> unit 8 | val tst : string -> (unit -> bool) -> unit 9 | end 10 | 11 | structure UTest : UTEST = struct 12 | 13 | val counts = {ok=ref 0, wrong=ref 0, exn=ref 0} 14 | fun incr l = 15 | let val r = l counts 16 | in r := !r + 1 17 | end 18 | fun ok() = (incr #ok; "OK") 19 | fun wrong() = (incr #wrong; "WRONG") 20 | fun exn() = (incr #exn; "EXN") 21 | fun check f = (if f () then ok() else wrong()) handle e => (exn() ^ General.exnMessage e) 22 | 23 | (* 24 | fun range (from, to) p = 25 | let open Int32 26 | in (from > to) orelse (p from) andalso (range (from+1, to) p) 27 | end 28 | 29 | fun checkrange bounds = check o range bounds 30 | *) 31 | 32 | fun tst0 s s' = print (s ^ " \t" ^ s' ^ "\n") 33 | fun tst s f = tst0 s (check f) 34 | 35 | (* fun tstrange s bounds = (tst s) o range bounds *) 36 | 37 | val data : (string*string) option ref = ref NONE 38 | fun start f s = 39 | (data := SOME (f,s); 40 | #ok counts := 0; 41 | #wrong counts := 0; 42 | #exn counts := 0; 43 | print ("[File " ^ f ^ ": Testing " ^ s ^ "...]\n")) 44 | 45 | fun finish () = 46 | let val ok = ! (#ok counts) 47 | val wrong = ! (#wrong counts) 48 | val exn = ! (#exn counts) 49 | in 50 | case !data of 51 | NONE => print "[Test not properly started]\n" 52 | | SOME (f,s) => 53 | (print ("[Finished testing file " ^ f ^ " - " ^ s ^ "]\n"); 54 | if wrong = 0 andalso exn = 0 then 55 | print ("[All " ^ Int.toString ok ^ " tests succeeded]\n") 56 | else 57 | print ("[Tests failed - [ok: " ^ Int.toString ok ^ ", wrong: " ^ Int.toString wrong ^ ", exn: " ^ Int.toString exn ^ "]\n") 58 | ) 59 | end 60 | end 61 | 62 | local 63 | val is_debug = false 64 | in 65 | fun debug s = if is_debug then print s 66 | else () 67 | end 68 | 69 | open UTest 70 | 71 | val () = UTest.start "unittest.sml" "structure LlvmCore" 72 | 73 | structure L = LlvmCore 74 | 75 | fun ty c = L.i64_type c 76 | 77 | val _ = tst "context_create" (fn () => (L.create_context(); true)) 78 | val _ = tst "context_create2" (fn () => let val c1 = L.create_context() 79 | val c2 = L.create_context() 80 | in c1 <> c2 81 | end) 82 | val _ = tst "context_dispose" (fn () => let val c = L.create_context() 83 | val () = L.dispose_context c 84 | in true 85 | end) 86 | (* seg fault 87 | val _ = tst "context_dispose2" (fn () => let val c = L.create_context() 88 | val () = L.dispose_context c 89 | val () = L.dispose_context c 90 | in true 91 | end) 92 | *) 93 | 94 | val _ = tst "context_global" (fn () => (L.global_context(); true)) 95 | 96 | fun tstc s f = 97 | tst s (fn () => let val c = L.create_context() 98 | val r = f c 99 | val () = L.dispose_context c 100 | in r 101 | end) 102 | 103 | val _ = tstc "module_create" (fn c => (L.create_module c "MyModule"; true)) 104 | val _ = tstc "module_create2" (fn c => (L.create_module c "My Module"; true)) 105 | val _ = tstc "module_create3" (fn c => (L.create_module c "A"; L.create_module c "A"; true)) 106 | val _ = tstc "module_dispose" (fn c => let val m = L.create_module c "A" 107 | val () = L.dispose_module m 108 | in true 109 | end) 110 | val _ = tstc "module_context" (fn c => let val m = L.create_module c "A" 111 | val c' = L.module_context m 112 | val r = c = c' 113 | val () = L.dispose_module m 114 | in r 115 | end) 116 | 117 | (* Types *) 118 | 119 | fun tst_itype (s, f, n) = 120 | tstc ("type_" ^ s) (fn c => let val t = f c 121 | in L.integer_bitwidth t = n andalso L.integer_type c n = t 122 | end) 123 | 124 | val () = List.app tst_itype [("i1", L.i1_type, 1), 125 | ("i8", L.i8_type, 8), 126 | ("i16", L.i16_type, 16), 127 | ("i32", L.i32_type, 32), 128 | ("i64", L.i64_type, 64) 129 | ] 130 | 131 | fun pr_ty(ty:L.lltype): unit = prim("@mlkit_llvm_print_type", ty) 132 | 133 | val _ = tstc "type_fun" (fn c => let val i32 = L.i32_type c 134 | (*val () = pr_ty i32*) 135 | val i16 = L.i16_type c 136 | val t = L.function_type i32 [] 137 | val r = L.return_type t 138 | in r = i32 andalso r <> i16 andalso not(L.is_var_arg t) 139 | end) 140 | 141 | val _ = tstc "type_var_arg_fun" (fn c => let val i32 = L.i32_type c 142 | val i16 = L.i16_type c 143 | val t = L.var_arg_function_type i32 [] 144 | val r = L.return_type t 145 | in r = i32 andalso r <> i16 andalso L.is_var_arg t 146 | end) 147 | (*MEMO: is_var_arg on non-function types *) 148 | 149 | val _ = tstc "type_pointer" (fn c => let val i32 = L.i32_type c 150 | val pi32 = L.pointer_type i32 151 | in pi32 <> i32 152 | end) 153 | 154 | val _ = tstc "const_int" (fn c => let val i32 = L.i32_type c 155 | val v = L.const_int i32 456 156 | val t = L.type_of v 157 | in t = i32 158 | end) 159 | 160 | val _ = tstc "const_string" (fn c => let val v = L.const_string c "hello" 161 | val t = L.type_of v 162 | val te = L.element_type t 163 | val sz = L.array_length t 164 | in te = L.i8_type c andalso sz = 5 165 | end) 166 | 167 | val _ = tstc "const_stringz" (fn c => let val v = L.const_stringz c "hello" 168 | val t = L.type_of v 169 | val te = L.element_type t 170 | val sz = L.array_length t 171 | in te = L.i8_type c andalso sz = 6 172 | end) 173 | 174 | val _ = tstc "define_global_string" (fn c => let val m = L.create_module c "A" 175 | val v = L.const_string c "hello" 176 | val g = L.define_global "MyGlobalString" v m 177 | val t = L.type_of g 178 | in t = L.pointer_type (L.type_of v) 179 | end) 180 | val _ = tstc "define_global_int" (fn c => let val m = L.create_module c "A" 181 | val i32 = L.i32_type c 182 | val v = L.const_int i32 456 183 | val g = L.define_global "MyGlobalInt" v m 184 | val t = L.type_of g 185 | in t = L.pointer_type i32 186 | end) 187 | 188 | val _ = tstc "declare_function" (fn c => let val m = L.create_module c "A" 189 | val i32 = L.i32_type c 190 | val t = L.function_type i32 [i32] 191 | val v = L.declare_function "myf" t m 192 | val t2 = L.type_of v 193 | in t2 = L.pointer_type t 194 | end) 195 | 196 | val _ = tstc "define_function" (fn c => let val m = L.create_module c "A" 197 | val i32 = L.i32_type c 198 | val t = L.function_type i32 [i32] 199 | val v = L.declare_function "myf" t m 200 | val t2 = L.type_of v 201 | in t2 = L.pointer_type t 202 | end) 203 | 204 | (* MEMO: test function param *) 205 | 206 | (* Basic Blocks *) 207 | 208 | fun tstf0 s tf f = 209 | tstc s (fn c => let val m = L.create_module c "A" 210 | val t = tf c 211 | val v = L.define_function "myf" t m 212 | val r = f (c,m,t,v) 213 | val () = L.dispose_module m 214 | in r 215 | end) 216 | 217 | fun tf_i2i c = 218 | let val i32 = L.i32_type c in L.function_type i32 [i32] end 219 | 220 | fun tf_ii2i c = 221 | let val i32 = L.i32_type c in L.function_type i32 [i32,i32] end 222 | 223 | fun tf_dd2d c = 224 | let val d = L.double_type c in L.function_type d [d,d] end 225 | 226 | fun tf_i2d c = L.function_type (L.double_type c) [L.i32_type c] 227 | fun tf_d2i c = L.function_type (L.i32_type c) [L.double_type c] 228 | 229 | fun tstf s f = tstf0 s tf_i2i f 230 | 231 | val _ = tstf "entry_block" (fn (c,m,t,f) => 232 | let val b = L.entry_block f 233 | in true 234 | end) 235 | 236 | val _ = tstf "append_block" (fn (c,m,t,f) => 237 | let val b = L.append_block c "newblock" f 238 | in true 239 | end) 240 | 241 | val _ = tstf "delete_block" (fn (c,m,t,f) => 242 | let val b = L.append_block c "newblock" f 243 | val () = L.delete_block b 244 | in true 245 | end) 246 | 247 | (* Builders *) 248 | 249 | val _ = tstf "builder_at_end" (fn (c,m,t,f) => 250 | let val b = L.append_block c "newblock" f 251 | val bb = L.builder_at_end c b 252 | val () = L.delete_block b 253 | in true 254 | end) 255 | 256 | (* Instructions *) 257 | 258 | fun tstb0 s tf f = 259 | tstf0 s tf (fn (c,m,t,vf) => 260 | let val b = L.entry_block vf 261 | val bb = L.builder_at_end c b 262 | val r = f(c,m,t,vf,b,bb) 263 | val () = L.delete_block b 264 | in r 265 | end) 266 | 267 | fun tstb s f = tstb0 s tf_i2i f 268 | 269 | val _ = tstb "build_ret_void" (fn (c,m,t,f,b,bb) => 270 | let val v = L.build_ret_void bb 271 | in true 272 | end) 273 | 274 | val _ = tstb "build_ret" (fn (c,m,t,f,b,bb) => 275 | let val i32 = L.i32_type c 276 | val v = L.const_int i32 454 277 | val v2 = L.build_ret v bb 278 | in true 279 | end) 280 | 281 | val _ = tstb "build_br" (fn (c,m,t,f,b,bb) => 282 | let val v = L.build_br b bb 283 | in true 284 | end) 285 | 286 | val _ = tstb "build_cond_br" (fn (c,m,t,f,b,bb) => 287 | let val i32 = L.i32_type c 288 | val v = L.const_int i32 454 289 | val vc = L.build_icmp L.Icmp.Eq v v "cond" bb 290 | val b1 = L.append_block c "b1" f 291 | val b2 = L.append_block c "b2" f 292 | val v2 = L.build_cond_br vc b1 b2 bb 293 | in true 294 | end) 295 | 296 | fun tstbin s binop = 297 | tstb s (fn (c,m,t,f,b,bb) => 298 | let val i32 = L.i32_type c 299 | val v = L.const_int i32 454 300 | val v2 = binop v v "res" bb 301 | val v3 = L.build_ret v2 bb 302 | in true 303 | end) 304 | 305 | fun tstun s unop = 306 | tstb s (fn (c,m,t,f,b,bb) => 307 | let val i32 = L.i32_type c 308 | val v = L.const_int i32 454 309 | val v2 = unop v "res" bb 310 | val v3 = L.build_ret v2 bb 311 | in true 312 | end) 313 | 314 | val _ = tstbin "build_add" L.build_add 315 | val _ = tstbin "build_sub" L.build_sub 316 | val _ = tstbin "build_mul" L.build_mul 317 | val _ = tstbin "build_shl" L.build_shl 318 | val _ = tstbin "build_lshr" L.build_lshr 319 | val _ = tstbin "build_ashr" L.build_ashr 320 | val _ = tstbin "build_and" L.build_and 321 | val _ = tstbin "build_or" L.build_or 322 | val _ = tstbin "build_xor" L.build_xor 323 | val _ = tstun "build_neg" L.build_neg 324 | val _ = tstun "build_not" L.build_not 325 | 326 | val _ = tstb "build_gep" (fn (c,m,t,f,b,bb) => 327 | let val i32 = L.i32_type c 328 | val v = L.const_int i32 454 329 | val v2 = L.build_gep v [] "res" bb 330 | in true 331 | end) 332 | 333 | val _ = 334 | let open L.Icmp 335 | in List.app 336 | (fn (s,c) => tstbin ("build_icmp_" ^ s) (L.build_icmp c)) 337 | [("Eq",Eq),("Ne",Ne),("Ugt",Ugt),("Uge",Uge),("Ult",Ult), 338 | ("Ule",Ule),("Sgt",Sgt),("Sge",Sge),("Slt",Slt),("Sle",Sle)] 339 | end 340 | 341 | fun tstbinf s binop = 342 | tstb s (fn (c,m,t,f,b,bb) => 343 | let val d = L.double_type c 344 | val v = L.const_float d 34.23 345 | val v2 = binop v v "res" bb 346 | val v3 = L.build_ret v2 bb 347 | in true 348 | end) 349 | 350 | fun tstunf s unop = 351 | tstb s (fn (c,m,t,f,b,bb) => 352 | let val d = L.double_type c 353 | val v = L.const_float d 34.23 354 | val v2 = unop v "res" bb 355 | val v3 = L.build_ret v2 bb 356 | in true 357 | end) 358 | 359 | val _ = 360 | let open L.Fcmp 361 | in List.app 362 | (fn (s,c) => tstbinf ("build_fcmp_" ^ s) (L.build_fcmp c)) 363 | [("False",False),("Oeq",Oeq),("Ogt",Ogt),("Oge",Oge),("Olt",Olt), 364 | ("Ole",Ole),("One",One),("Ord",Ord),("Uno",Uno), 365 | ("Ueq",Ueq),("Ugt",Ugt),("Uge",Uge),("Ult",Ult), 366 | ("Ule",Ule),("Une",Une),("True",True)] 367 | end 368 | 369 | val _ = tstbinf "build_fadd" L.build_fadd 370 | val _ = tstbinf "build_fsub" L.build_fsub 371 | val _ = tstbinf "build_fmul" L.build_fmul 372 | val _ = tstbinf "build_fdiv" L.build_fdiv 373 | val _ = tstbinf "build_frem" L.build_frem 374 | val _ = tstunf "build_fneg" L.build_fneg 375 | 376 | val _ = tstb "build_phi" (fn (c,m,t,f,b,bb) => 377 | let val i32 = L.i32_type c 378 | val v = L.const_int i32 454 379 | val v1 = L.build_add v v "v1" bb 380 | val b1 = L.append_block c "b1" f 381 | val b2 = L.append_block c "b2" f 382 | val bb2 = L.builder_at_end c b2 383 | val _ = L.build_br b1 bb 384 | val v2 = L.build_mul v v "v2" bb2 385 | val _ = L.build_br b1 bb2 386 | val bb1 = L.builder_at_end c b1 387 | val v3 = L.build_phi [(v1,b),(v2,b2)] "phi" bb1 388 | in true 389 | end) 390 | 391 | val _ = tstb "build_call" (fn (c,m,t,f,b,bb) => 392 | let val i32 = L.i32_type c 393 | val v1 = L.const_int i32 454 394 | val v = L.build_call f [v1] "res" bb 395 | in true 396 | end) 397 | 398 | val _ = tstb "write_bitcode_file" (fn (c,m,t,f,b,bb) => 399 | let val i32 = L.i32_type c 400 | val v0 = L.param f 0 401 | val v = L.const_int i32 454 402 | val v2 = L.build_mul v0 v "v2" bb 403 | val _ = L.build_ret v2 bb 404 | in L.write_bitcode_file m "test.bc" 405 | end) 406 | 407 | val _ = tstc "string_of_lltype" (fn c => let val i32 = L.i32_type c 408 | val d = L.double_type c 409 | val pd = L.pointer_type d 410 | in List.all (fn (t,s) => L.string_of_lltype t = s) 411 | [(i32,"i32"), 412 | (d,"double"), 413 | (pd,"double*") 414 | ] 415 | end) 416 | 417 | structure GV = L.GenericValue 418 | structure EE = L.ExecutionEngine 419 | 420 | val _ = tstb "execution_engine" 421 | (fn (c,m,t,f,b,bb) => 422 | let val i32 = L.i32_type c 423 | val v0 = L.param f 0 424 | val v1 = L.const_int i32 45 425 | val v2 = L.build_mul v0 v1 "v2" bb 426 | val _ = L.build_ret v2 bb 427 | val ee = EE.create m 428 | val arg = GV.of_int i32 23 429 | in case L.ExecutionEngine.find_function "myf" ee of 430 | SOME f2 => 431 | let val r = EE.run_function f [arg] ee 432 | val res = GV.as_int r = 45 * 23 andalso f = f2 433 | (* val () = EE.dispose ee *) 434 | in res 435 | end 436 | | NONE => raise Fail "cannot find function" 437 | end) 438 | 439 | fun pp_t s t = 440 | print (s ^ ": " ^ L.string_of_lltype t ^ "\n") 441 | 442 | fun tst_ii2i (p,create_engine) (s, g, a0, a1, e) = 443 | tstb0 (p ^ "-" ^ s) tf_ii2i 444 | (fn (c,m,t,f,b,bb) => 445 | let val i32 = L.i32_type c 446 | val v0 = L.param f 0 447 | val v1 = L.param f 1 448 | val v2 = g v0 v1 "v2" bb 449 | val _ = L.build_ret v2 bb 450 | val ee = create_engine m 451 | val arg0 = GV.of_int i32 a0 452 | val arg1 = GV.of_int i32 a1 453 | val r = EE.run_function f [arg0,arg1] ee 454 | in GV.as_int r = e 455 | end) 456 | 457 | fun unary (s,f,a,r) = 458 | (s, fn v0 => fn _ => f v0, a, 333, r) 459 | 460 | val test_cases_ii2i = 461 | [("add1",L.build_add,2,3,5), 462 | ("add2",L.build_add,2,~3,~1), 463 | ("add3",L.build_add,2,0,2), 464 | ("sub1",L.build_sub,2,3,~1), 465 | ("sub2",L.build_sub,2,~3,5), 466 | ("sub3",L.build_sub,2,0,2), 467 | ("mul1",L.build_mul,2,3,6), 468 | ("mul2",L.build_mul,2,~3,~6), 469 | ("mul3",L.build_mul,2,0,0), 470 | ("shl1",L.build_shl,2,1,4), 471 | ("shl2",L.build_shl,5,2,20), 472 | ("shl3",L.build_shl,323,0,323), 473 | ("lshr1",L.build_lshr,5,1,2), 474 | ("lshr2",L.build_lshr,27,2,6), 475 | ("lshr3",L.build_lshr,28,0,28), 476 | ("ashr1",L.build_ashr,5,1,2), 477 | ("ashr2",L.build_ashr,27,2,6), 478 | ("ashr3",L.build_ashr,28,0,28), 479 | ("and1",L.build_and,2,1,0), 480 | ("and2",L.build_and,5,4,4), 481 | ("and3",L.build_and,7,9,1), 482 | ("or1",L.build_or,2,1,3), 483 | ("or2",L.build_or,5,2,7), 484 | ("or3",L.build_or,5,1,5), 485 | ("xor1",L.build_xor,2,1,3), 486 | ("xor2",L.build_xor,5,2,7), 487 | ("xor3",L.build_xor,5,1,4), 488 | ("not",fn v0 => fn v1 => fn n => fn bb => 489 | let val tmp = L.build_not v0 "tmp" bb 490 | in L.build_and tmp v1 n bb 491 | end, 5, 7, 2), 492 | unary ("neg1",L.build_neg,5,~5), 493 | unary ("neg2",L.build_neg,~5,5), 494 | unary ("neg3",L.build_neg,0,0) 495 | ] 496 | 497 | fun run_tsts tst cases = 498 | (List.app (tst ("interp", EE.create_interpreter)) cases; 499 | List.app (tst ("hybrid", EE.create)) cases; 500 | List.app (tst ("jit", fn m => EE.create_jit m 3)) cases) 501 | 502 | val _ = EE.initialize_native_target() 503 | val _ = run_tsts tst_ii2i test_cases_ii2i 504 | 505 | fun eq (a:real) b = 506 | let val r = a <= b andalso b <= a 507 | val () = debug (Real.toString a ^ " == " ^ Real.toString b ^ " = " ^ Bool.toString r ^ "\n") 508 | in r 509 | end 510 | 511 | fun tst_dd2d (p,create_engine) (s, g, a0, a1, e) = 512 | tstb0 (p ^ "-" ^ s) tf_dd2d 513 | (fn (c,m,t,f,b,bb) => 514 | let val d = L.double_type c 515 | val v0 = L.param f 0 516 | val v1 = L.param f 1 517 | val v2 = g v0 v1 "v2" bb 518 | val _ = L.build_ret v2 bb 519 | val ee = create_engine m 520 | val arg0 = GV.of_float d a0 521 | val arg1 = GV.of_float d a1 522 | val r = EE.run_function f [arg0,arg1] ee 523 | in eq (GV.as_float d r) e 524 | end) 525 | 526 | fun funary (s,f,a,r) = 527 | (s, fn v0 => fn _ => f v0, a, 333.0, r) 528 | 529 | val test_cases_dd2d = 530 | [("fadd1",L.build_fadd,2.0,3.0,5.0), 531 | ("fadd2",L.build_fadd,2.0,~3.0,~1.0), 532 | ("fadd3",L.build_fadd,2.0,0.0,2.0), 533 | ("fsub1",L.build_fsub,2.0,3.0,~1.0), 534 | ("fsub2",L.build_fsub,2.0,~3.0,5.0), 535 | ("fsub3",L.build_fsub,2.0,0.0,2.0), 536 | ("fmul1",L.build_fmul,2.0,3.0,6.0), 537 | ("fmul2",L.build_fmul,2.0,~3.0,~6.0), 538 | ("fmul3",L.build_fmul,2.0,0.0,0.0), 539 | ("fdiv1",L.build_fdiv,6.0,3.0,2.0), 540 | ("fdiv2",L.build_fdiv,8.0,~0.5,~16.0), 541 | ("fdiv3",L.build_fdiv,0.0,2.0,0.0), 542 | ("frem1",L.build_frem,6.0,3.0,0.0), 543 | ("frem2",L.build_frem,8.0,3.0,2.0), 544 | ("frem3",L.build_frem,0.0,2.0,0.0), 545 | funary ("fneg1",L.build_fneg,5.0,~5.0), 546 | funary ("fneg2",L.build_fneg,~5.0,5.0), 547 | funary ("fneg3",L.build_fneg,0.0,0.0) 548 | ] 549 | 550 | val _ = run_tsts tst_dd2d test_cases_dd2d 551 | 552 | fun tst_i2d (p,create_engine) (s, g, a, e) = 553 | tstb0 (p ^ "-" ^ s) tf_i2d 554 | (fn (c,m,t,f,b,bb) => 555 | let val d = L.double_type c 556 | val i32 = L.i32_type c 557 | val v0 = L.param f 0 558 | val v2 = g c v0 "v2" bb 559 | val _ = L.build_ret v2 bb 560 | val ee = create_engine m 561 | val arg = GV.of_int i32 a 562 | val r = EE.run_function f [arg] ee 563 | in eq (GV.as_float d r) e 564 | end) 565 | 566 | val test_cases_i2d = 567 | [("sitofp1", fn c => fn v => L.build_sitofp v (L.double_type c), 3, 3.0), 568 | (* ("sitofp2", fn c => fn v => L.build_sitofp v (L.double_type c), ~3, ~3.0), *) 569 | ("uitofp1", fn c => fn v => L.build_uitofp v (L.double_type c), 3, 3.0) 570 | (* ("uitofp2", fn c => fn v => L.build_uitofp v (L.double_type c), ~3, 3.0) *) 571 | ] 572 | 573 | val _ = run_tsts tst_i2d test_cases_i2d 574 | 575 | fun tst_d2i (p,create_engine) (s, g, a, e) = 576 | tstb0 (p ^ "-" ^ s) tf_d2i 577 | (fn (c,m,t,f,b,bb) => 578 | let val d = L.double_type c 579 | val i32 = L.i32_type c 580 | val v0 = L.param f 0 581 | val v2 = g c v0 "v2" bb 582 | val _ = L.build_ret v2 bb 583 | val ee = create_engine m 584 | val arg = GV.of_float d a 585 | val r = EE.run_function f [arg] ee 586 | in GV.as_int r = e 587 | end) 588 | 589 | val _ = run_tsts tst_d2i 590 | [("fptosi1", fn c => fn v => L.build_fptosi v (L.i32_type c), 3.0, 3), 591 | ("fptoui1", fn c => fn v => L.build_fptosi v (L.i32_type c), 3.0, 3) 592 | ] 593 | 594 | val () = finish() 595 | --------------------------------------------------------------------------------