diff --git a/sledge/vendor/README.org b/sledge/vendor/README.org index 46e2ae353..8dce11418 100644 --- a/sledge/vendor/README.org +++ b/sledge/vendor/README.org @@ -5,6 +5,6 @@ subject to their own copyright and licensing terms. Source: https://github.com/kit-ty-kate/llvm-dune License: Apache-2.0 WITH LLVM-exception, see https://llvm.org/LICENSE.txt -- llvm-dune/llvm-project/libcxxabi: - Source: https://github.com/llvm/llvm-project/tree/release/11.x/libcxxabi +- llvm-dune/llvm-project: + Source: https://github.com/llvm/llvm-project/tree/release/11.x License: Apache-2.0 WITH LLVM-exception, see https://llvm.org/LICENSE.txt diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/CMakeLists.txt new file mode 100644 index 000000000..20583682c --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/CMakeLists.txt @@ -0,0 +1,11 @@ +add_subdirectory(llvm) +add_subdirectory(all_backends) +add_subdirectory(analysis) +add_subdirectory(backends) +add_subdirectory(bitreader) +add_subdirectory(bitwriter) +add_subdirectory(irreader) +add_subdirectory(linker) +add_subdirectory(target) +add_subdirectory(transforms) +add_subdirectory(executionengine) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/README.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/README.txt new file mode 100644 index 000000000..68216b679 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/README.txt @@ -0,0 +1,29 @@ +This directory contains LLVM bindings for the OCaml programming language +(http://ocaml.org). + +Prerequisites +------------- + +* OCaml 4.00.0+. +* ctypes 0.4+. +* oUnit 2+ (only required for tests). +* CMake (to build LLVM). + +Building the bindings +--------------------- + +If all dependencies are present, the bindings will be built and installed +as a part of the default CMake configuration, with no further action. +They will only work with the specific OCaml compiler detected during the build. + +The bindings can also be built out-of-tree, i.e. targeting a preinstalled +LLVM. To do this, configure the LLVM build tree as follows: + + $ cmake -DLLVM_OCAML_OUT_OF_TREE=TRUE \ + -DCMAKE_INSTALL_PREFIX=[OCaml install prefix] \ + [... any other options] + +then build and install it as: + + $ make ocaml_all + $ cmake -P bindings/ocaml/cmake_install.cmake diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/CMakeLists.txt new file mode 100644 index 000000000..716a49cc3 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_all_backends + OCAML llvm_all_backends + OCAMLDEP llvm + C all_backends_ocaml + LLVM ${LLVM_TARGETS_TO_BUILD}) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/all_backends_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/all_backends_ocaml.c new file mode 100644 index 000000000..ae4b496cb --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/all_backends_ocaml.c @@ -0,0 +1,32 @@ +/*===-- all_backends_ocaml.c - LLVM OCaml Glue ------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Target.h" +#include "caml/alloc.h" +#include "caml/fail.h" +#include "caml/memory.h" +#include "caml/custom.h" + +/* unit -> unit */ +CAMLprim value llvm_initialize_all(value Unit) { + LLVMInitializeAllTargetInfos(); + LLVMInitializeAllTargets(); + LLVMInitializeAllTargetMCs(); + LLVMInitializeAllAsmPrinters(); + LLVMInitializeAllAsmParsers(); + return Val_unit; +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/llvm_all_backends.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/llvm_all_backends.ml new file mode 100644 index 000000000..b4df7cde2 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/llvm_all_backends.ml @@ -0,0 +1,9 @@ +(*===-- llvm_all_backends.ml - LLVM OCaml Interface -----------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +external initialize : unit -> unit = "llvm_initialize_all" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/llvm_all_backends.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/llvm_all_backends.mli new file mode 100644 index 000000000..62a515b93 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/all_backends/llvm_all_backends.mli @@ -0,0 +1,10 @@ +(*===-- llvm_all_backends.mli - LLVM OCaml Interface ----------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Initialize all the backends targets *) +val initialize : unit -> unit diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/CMakeLists.txt new file mode 100644 index 000000000..f8ca84ddb --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_analysis + OCAML llvm_analysis + OCAMLDEP llvm + C analysis_ocaml + LLVM analysis) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/analysis_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/analysis_ocaml.c new file mode 100644 index 000000000..af98e651e --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/analysis_ocaml.c @@ -0,0 +1,72 @@ +/*===-- analysis_ocaml.c - LLVM OCaml Glue ----------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Analysis.h" +#include "llvm-c/Core.h" +#include "caml/alloc.h" +#include "caml/mlvalues.h" +#include "caml/memory.h" + +/* Llvm.llmodule -> string option */ +CAMLprim value llvm_verify_module(LLVMModuleRef M) { + CAMLparam0(); + CAMLlocal2(String, Option); + + char *Message; + int Result = LLVMVerifyModule(M, LLVMReturnStatusAction, &Message); + + if (0 == Result) { + Option = Val_int(0); + } else { + Option = alloc(1, 0); + String = copy_string(Message); + Store_field(Option, 0, String); + } + + LLVMDisposeMessage(Message); + + CAMLreturn(Option); +} + +/* Llvm.llvalue -> bool */ +CAMLprim value llvm_verify_function(LLVMValueRef Fn) { + return Val_bool(LLVMVerifyFunction(Fn, LLVMReturnStatusAction) == 0); +} + +/* Llvm.llmodule -> unit */ +CAMLprim value llvm_assert_valid_module(LLVMModuleRef M) { + LLVMVerifyModule(M, LLVMAbortProcessAction, 0); + return Val_unit; +} + +/* Llvm.llvalue -> unit */ +CAMLprim value llvm_assert_valid_function(LLVMValueRef Fn) { + LLVMVerifyFunction(Fn, LLVMAbortProcessAction); + return Val_unit; +} + +/* Llvm.llvalue -> unit */ +CAMLprim value llvm_view_function_cfg(LLVMValueRef Fn) { + LLVMViewFunctionCFG(Fn); + return Val_unit; +} + +/* Llvm.llvalue -> unit */ +CAMLprim value llvm_view_function_cfg_only(LLVMValueRef Fn) { + LLVMViewFunctionCFGOnly(Fn); + return Val_unit; +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/llvm_analysis.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/llvm_analysis.ml new file mode 100644 index 000000000..a8e5f4ef0 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/llvm_analysis.ml @@ -0,0 +1,21 @@ +(*===-- llvm_analysis.ml - LLVM OCaml Interface ---------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + + +external verify_module : Llvm.llmodule -> string option = "llvm_verify_module" + +external verify_function : Llvm.llvalue -> bool = "llvm_verify_function" + +external assert_valid_module : Llvm.llmodule -> unit + = "llvm_assert_valid_module" + +external assert_valid_function : Llvm.llvalue -> unit + = "llvm_assert_valid_function" +external view_function_cfg : Llvm.llvalue -> unit = "llvm_view_function_cfg" +external view_function_cfg_only : Llvm.llvalue -> unit + = "llvm_view_function_cfg_only" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/llvm_analysis.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/llvm_analysis.mli new file mode 100644 index 000000000..cf323b547 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/analysis/llvm_analysis.mli @@ -0,0 +1,45 @@ +(*===-- llvm_analysis.mli - LLVM OCaml Interface --------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Intermediate representation analysis. + + This interface provides an OCaml API for LLVM IR analyses, the classes in + the Analysis library. *) + +(** [verify_module m] returns [None] if the module [m] is valid, and + [Some reason] if it is invalid. [reason] is a string containing a + human-readable validation report. See [llvm::verifyModule]. *) +external verify_module : Llvm.llmodule -> string option = "llvm_verify_module" + +(** [verify_function f] returns [None] if the function [f] is valid, and + [Some reason] if it is invalid. [reason] is a string containing a + human-readable validation report. See [llvm::verifyFunction]. *) +external verify_function : Llvm.llvalue -> bool = "llvm_verify_function" + +(** [verify_module m] returns if the module [m] is valid, but prints a + validation report to [stderr] and aborts the program if it is invalid. See + [llvm::verifyModule]. *) +external assert_valid_module : Llvm.llmodule -> unit + = "llvm_assert_valid_module" + +(** [verify_function f] returns if the function [f] is valid, but prints a + validation report to [stderr] and aborts the program if it is invalid. See + [llvm::verifyFunction]. *) +external assert_valid_function : Llvm.llvalue -> unit + = "llvm_assert_valid_function" + +(** [view_function_cfg f] opens up a ghostscript window displaying the CFG of + the current function with the code for each basic block inside. + See [llvm::Function::viewCFG]. *) +external view_function_cfg : Llvm.llvalue -> unit = "llvm_view_function_cfg" + +(** [view_function_cfg_only f] works just like [view_function_cfg], but does not + include the contents of basic blocks into the nodes. + See [llvm::Function::viewCFGOnly]. *) +external view_function_cfg_only : Llvm.llvalue -> unit + = "llvm_view_function_cfg_only" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/CMakeLists.txt new file mode 100644 index 000000000..18d62a857 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/CMakeLists.txt @@ -0,0 +1,27 @@ +foreach(TARGET ${LLVM_TARGETS_TO_BUILD}) + set(OCAML_LLVM_TARGET ${TARGET}) + + foreach( ext ml mli ) + configure_file( + "${CMAKE_CURRENT_SOURCE_DIR}/llvm_backend.${ext}.in" + "${CMAKE_CURRENT_BINARY_DIR}/llvm_${TARGET}.${ext}") + endforeach() + + configure_file( + "${CMAKE_CURRENT_SOURCE_DIR}/backend_ocaml.c" + "${CMAKE_CURRENT_BINARY_DIR}/${TARGET}_ocaml.c") + + add_ocaml_library(llvm_${TARGET} + OCAML llvm_${TARGET} + C ${TARGET}_ocaml + CFLAGS -DTARGET=${TARGET} + LLVM ${TARGET} + NOCOPY) + + configure_file( + "${CMAKE_CURRENT_SOURCE_DIR}/META.llvm_backend.in" + "${LLVM_LIBRARY_DIR}/ocaml/META.llvm_${TARGET}") + + install(FILES "${LLVM_LIBRARY_DIR}/ocaml/META.llvm_${TARGET}" + DESTINATION "${LLVM_OCAML_INSTALL_PATH}") +endforeach() diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/META.llvm_backend.in b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/META.llvm_backend.in new file mode 100644 index 000000000..bd23abe0c --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/META.llvm_backend.in @@ -0,0 +1,7 @@ +name = "llvm_@TARGET@" +version = "@PACKAGE_VERSION@" +description = "@TARGET@ Backend for LLVM" +requires = "llvm" +archive(byte) = "llvm_@TARGET@.cma" +archive(native) = "llvm_@TARGET@.cmxa" +directory = "llvm" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/backend_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/backend_ocaml.c new file mode 100644 index 000000000..16e68c541 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/backend_ocaml.c @@ -0,0 +1,38 @@ +/*===-- backend_ocaml.c - LLVM OCaml Glue -----------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Target.h" +#include "caml/alloc.h" +#include "caml/memory.h" + +/* TODO: Figure out how to call these only for targets which support them. + * LLVMInitialize ## target ## AsmPrinter(); + * LLVMInitialize ## target ## AsmParser(); + * LLVMInitialize ## target ## Disassembler(); + */ + +#define INITIALIZER1(target) \ + CAMLprim value llvm_initialize_ ## target(value Unit) { \ + LLVMInitialize ## target ## TargetInfo(); \ + LLVMInitialize ## target ## Target(); \ + LLVMInitialize ## target ## TargetMC(); \ + return Val_unit; \ + } + +#define INITIALIZER(target) INITIALIZER1(target) + +INITIALIZER(TARGET) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/llvm_backend.ml.in b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/llvm_backend.ml.in new file mode 100644 index 000000000..b80cc75c7 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/llvm_backend.ml.in @@ -0,0 +1,9 @@ +(*===-- llvm_backend.ml.in - LLVM OCaml Interface -------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +external initialize : unit -> unit = "llvm_initialize_@TARGET@" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/llvm_backend.mli.in b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/llvm_backend.mli.in new file mode 100644 index 000000000..25b0f8982 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/backends/llvm_backend.mli.in @@ -0,0 +1,18 @@ +(*===-- llvm_backend.mli.in - LLVM OCaml Interface ------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** @TARGET@ Initialization. + + This interface provides an OCaml API for initialization of + the @TARGET@ LLVM target. By referencing this module, you will cause + OCaml to load or link in the LLVM libraries corresponding to the target. + By calling [initialize], you will register components of this target + in the target registry, which is necessary in order to emit assembly, + object files, and so on. *) + +external initialize : unit -> unit = "llvm_initialize_@TARGET@" \ No newline at end of file diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/CMakeLists.txt new file mode 100644 index 000000000..8d1610320 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_bitreader + OCAML llvm_bitreader + OCAMLDEP llvm + C bitreader_ocaml + LLVM bitreader) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/bitreader_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/bitreader_ocaml.c new file mode 100644 index 000000000..1af554e24 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/bitreader_ocaml.c @@ -0,0 +1,42 @@ +/*===-- bitwriter_ocaml.c - LLVM OCaml Glue ---------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/BitReader.h" +#include "llvm-c/Core.h" +#include "caml/alloc.h" +#include "caml/fail.h" +#include "caml/memory.h" +#include "caml/callback.h" + +void llvm_raise(value Prototype, char *Message); + +/* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */ +CAMLprim LLVMModuleRef llvm_get_module(LLVMContextRef C, LLVMMemoryBufferRef MemBuf) { + LLVMModuleRef M; + + if (LLVMGetBitcodeModuleInContext2(C, MemBuf, &M)) + llvm_raise(*caml_named_value("Llvm_bitreader.Error"), LLVMCreateMessage("")); + + return M; +} + +/* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */ +CAMLprim LLVMModuleRef llvm_parse_bitcode(LLVMContextRef C, LLVMMemoryBufferRef MemBuf) { + LLVMModuleRef M; + + if (LLVMParseBitcodeInContext2(C, MemBuf, &M)) + llvm_raise(*caml_named_value("Llvm_bitreader.Error"), LLVMCreateMessage("")); + + return M; +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/llvm_bitreader.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/llvm_bitreader.ml new file mode 100644 index 000000000..601089fa5 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/llvm_bitreader.ml @@ -0,0 +1,18 @@ +(*===-- llvm_bitreader.ml - LLVM OCaml Interface --------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +exception Error of string + +let () = Callback.register_exception "Llvm_bitreader.Error" (Error "") + +external get_module + : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule + = "llvm_get_module" +external parse_bitcode + : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule + = "llvm_parse_bitcode" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/llvm_bitreader.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/llvm_bitreader.mli new file mode 100644 index 000000000..def8b84fe --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitreader/llvm_bitreader.mli @@ -0,0 +1,26 @@ +(*===-- llvm_bitreader.mli - LLVM OCaml Interface -------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Bitcode reader. + + This interface provides an OCaml API for the LLVM bitcode reader, the + classes in the Bitreader library. *) + +exception Error of string + +(** [get_module context mb] reads the bitcode for a new module [m] from the + memory buffer [mb] in the context [context]. Returns [m] if successful, or + raises [Error msg] otherwise, where [msg] is a description of the error + encountered. See the function [llvm::getBitcodeModule]. *) +val get_module : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule + +(** [parse_bitcode context mb] parses the bitcode for a new module [m] from the + memory buffer [mb] in the context [context]. Returns [m] if successful, or + raises [Error msg] otherwise, where [msg] is a description of the error + encountered. See the function [llvm::ParseBitcodeFile]. *) +val parse_bitcode : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/CMakeLists.txt new file mode 100644 index 000000000..5a14498cb --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_bitwriter + OCAML llvm_bitwriter + OCAMLDEP llvm + C bitwriter_ocaml + LLVM bitwriter) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/bitwriter_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/bitwriter_ocaml.c new file mode 100644 index 000000000..6856d7547 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/bitwriter_ocaml.c @@ -0,0 +1,48 @@ +/*===-- bitwriter_ocaml.c - LLVM OCaml Glue ---------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/BitWriter.h" +#include "llvm-c/Core.h" +#include "caml/alloc.h" +#include "caml/mlvalues.h" +#include "caml/memory.h" + +/* Llvm.llmodule -> string -> bool */ +CAMLprim value llvm_write_bitcode_file(LLVMModuleRef M, value Path) { + int Result = LLVMWriteBitcodeToFile(M, String_val(Path)); + return Val_bool(Result == 0); +} + +/* ?unbuffered:bool -> Llvm.llmodule -> Unix.file_descr -> bool */ +CAMLprim value llvm_write_bitcode_to_fd(value U, LLVMModuleRef M, value FD) { + int Unbuffered; + int Result; + + if (U == Val_int(0)) { + Unbuffered = 0; + } else { + Unbuffered = Bool_val(Field(U, 0)); + } + + Result = LLVMWriteBitcodeToFD(M, Int_val(FD), 0, Unbuffered); + return Val_bool(Result == 0); +} + +/* Llvm.llmodule -> Llvm.llmemorybuffer */ +CAMLprim LLVMMemoryBufferRef llvm_write_bitcode_to_memory_buffer(LLVMModuleRef M) { + return LLVMWriteBitcodeToMemoryBuffer(M); +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/llvm_bitwriter.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/llvm_bitwriter.ml new file mode 100644 index 000000000..3750a02dc --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/llvm_bitwriter.ml @@ -0,0 +1,27 @@ +(*===-- llvm_bitwriter.ml - LLVM OCaml Interface --------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------=== + * + * This interface provides an OCaml API for the LLVM intermediate + * representation, the classes in the VMCore library. + * + *===----------------------------------------------------------------------===*) + +external write_bitcode_file + : Llvm.llmodule -> string -> bool + = "llvm_write_bitcode_file" + +external write_bitcode_to_fd + : ?unbuffered:bool -> Llvm.llmodule -> Unix.file_descr -> bool + = "llvm_write_bitcode_to_fd" + +external write_bitcode_to_memory_buffer + : Llvm.llmodule -> Llvm.llmemorybuffer + = "llvm_write_bitcode_to_memory_buffer" + +let output_bitcode ?unbuffered channel m = + write_bitcode_to_fd ?unbuffered m (Unix.descr_of_out_channel channel) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/llvm_bitwriter.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/llvm_bitwriter.mli new file mode 100644 index 000000000..b8cc59c0f --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/bitwriter/llvm_bitwriter.mli @@ -0,0 +1,36 @@ +(*===-- llvm_bitwriter.mli - LLVM OCaml Interface -------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Bitcode writer. + + This interface provides an OCaml API for the LLVM bitcode writer, the + classes in the Bitwriter library. *) + +(** [write_bitcode_file m path] writes the bitcode for module [m] to the file at + [path]. Returns [true] if successful, [false] otherwise. *) +external write_bitcode_file + : Llvm.llmodule -> string -> bool + = "llvm_write_bitcode_file" + +(** [write_bitcode_to_fd ~unbuffered fd m] writes the bitcode for module + [m] to the channel [c]. If [unbuffered] is [true], after every write the fd + will be flushed. Returns [true] if successful, [false] otherwise. *) +external write_bitcode_to_fd + : ?unbuffered:bool -> Llvm.llmodule -> Unix.file_descr -> bool + = "llvm_write_bitcode_to_fd" + +(** [write_bitcode_to_memory_buffer m] returns a memory buffer containing + the bitcode for module [m]. *) +external write_bitcode_to_memory_buffer + : Llvm.llmodule -> Llvm.llmemorybuffer + = "llvm_write_bitcode_to_memory_buffer" + +(** [output_bitcode ~unbuffered c m] writes the bitcode for module [m] + to the channel [c]. If [unbuffered] is [true], after every write the fd + will be flushed. Returns [true] if successful, [false] otherwise. *) +val output_bitcode : ?unbuffered:bool -> out_channel -> Llvm.llmodule -> bool diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/CMakeLists.txt new file mode 100644 index 000000000..ae9af088c --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/CMakeLists.txt @@ -0,0 +1,6 @@ +add_ocaml_library(llvm_executionengine + OCAML llvm_executionengine + OCAMLDEP llvm llvm_target + C executionengine_ocaml + LLVM executionengine mcjit native + PKG ctypes) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/executionengine_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/executionengine_ocaml.c new file mode 100644 index 000000000..c83a8cadf --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/executionengine_ocaml.c @@ -0,0 +1,127 @@ +/*===-- executionengine_ocaml.c - LLVM OCaml Glue ---------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include +#include +#include "llvm-c/Core.h" +#include "llvm-c/ExecutionEngine.h" +#include "llvm-c/Target.h" +#include "caml/alloc.h" +#include "caml/custom.h" +#include "caml/fail.h" +#include "caml/memory.h" +#include "caml/callback.h" + +void llvm_raise(value Prototype, char *Message); + +/* unit -> bool */ +CAMLprim value llvm_ee_initialize(value Unit) { + LLVMLinkInMCJIT(); + + return Val_bool(!LLVMInitializeNativeTarget() && + !LLVMInitializeNativeAsmParser() && + !LLVMInitializeNativeAsmPrinter()); +} + +/* llmodule -> llcompileroption -> ExecutionEngine.t */ +CAMLprim LLVMExecutionEngineRef llvm_ee_create(value OptRecordOpt, LLVMModuleRef M) { + value OptRecord; + LLVMExecutionEngineRef MCJIT; + char *Error; + struct LLVMMCJITCompilerOptions Options; + + LLVMInitializeMCJITCompilerOptions(&Options, sizeof(Options)); + if (OptRecordOpt != Val_int(0)) { + OptRecord = Field(OptRecordOpt, 0); + Options.OptLevel = Int_val(Field(OptRecord, 0)); + Options.CodeModel = Int_val(Field(OptRecord, 1)); + Options.NoFramePointerElim = Int_val(Field(OptRecord, 2)); + Options.EnableFastISel = Int_val(Field(OptRecord, 3)); + Options.MCJMM = NULL; + } + + if (LLVMCreateMCJITCompilerForModule(&MCJIT, M, &Options, + sizeof(Options), &Error)) + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); + return MCJIT; +} + +/* ExecutionEngine.t -> unit */ +CAMLprim value llvm_ee_dispose(LLVMExecutionEngineRef EE) { + LLVMDisposeExecutionEngine(EE); + return Val_unit; +} + +/* llmodule -> ExecutionEngine.t -> unit */ +CAMLprim value llvm_ee_add_module(LLVMModuleRef M, LLVMExecutionEngineRef EE) { + LLVMAddModule(EE, M); + return Val_unit; +} + +/* llmodule -> ExecutionEngine.t -> llmodule */ +CAMLprim value llvm_ee_remove_module(LLVMModuleRef M, LLVMExecutionEngineRef EE) { + LLVMModuleRef RemovedModule; + char *Error; + if (LLVMRemoveModule(EE, M, &RemovedModule, &Error)) + llvm_raise(*caml_named_value("Llvm_executionengine.Error"), Error); + return Val_unit; +} + +/* ExecutionEngine.t -> unit */ +CAMLprim value llvm_ee_run_static_ctors(LLVMExecutionEngineRef EE) { + LLVMRunStaticConstructors(EE); + return Val_unit; +} + +/* ExecutionEngine.t -> unit */ +CAMLprim value llvm_ee_run_static_dtors(LLVMExecutionEngineRef EE) { + LLVMRunStaticDestructors(EE); + return Val_unit; +} + +extern value llvm_alloc_data_layout(LLVMTargetDataRef TargetData); + +/* ExecutionEngine.t -> Llvm_target.DataLayout.t */ +CAMLprim value llvm_ee_get_data_layout(LLVMExecutionEngineRef EE) { + value DataLayout; + LLVMTargetDataRef OrigDataLayout; + char* TargetDataCStr; + + OrigDataLayout = LLVMGetExecutionEngineTargetData(EE); + TargetDataCStr = LLVMCopyStringRepOfTargetData(OrigDataLayout); + DataLayout = llvm_alloc_data_layout(LLVMCreateTargetData(TargetDataCStr)); + LLVMDisposeMessage(TargetDataCStr); + + return DataLayout; +} + +/* Llvm.llvalue -> int64 -> llexecutionengine -> unit */ +CAMLprim value llvm_ee_add_global_mapping(LLVMValueRef Global, value Ptr, + LLVMExecutionEngineRef EE) { + LLVMAddGlobalMapping(EE, Global, (void*) (Int64_val(Ptr))); + return Val_unit; +} + +CAMLprim value llvm_ee_get_global_value_address(value Name, + LLVMExecutionEngineRef EE) { + return caml_copy_int64((int64_t) LLVMGetGlobalValueAddress(EE, String_val(Name))); +} + +CAMLprim value llvm_ee_get_function_address(value Name, + LLVMExecutionEngineRef EE) { + return caml_copy_int64((int64_t) LLVMGetFunctionAddress(EE, String_val(Name))); +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/llvm_executionengine.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/llvm_executionengine.ml new file mode 100644 index 000000000..5b202e2ea --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/llvm_executionengine.ml @@ -0,0 +1,71 @@ +(*===-- llvm_executionengine.ml - LLVM OCaml Interface --------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +exception Error of string + +let () = Callback.register_exception "Llvm_executionengine.Error" (Error "") + +external initialize : unit -> bool + = "llvm_ee_initialize" + +type llexecutionengine + +type llcompileroptions = { + opt_level: int; + code_model: Llvm_target.CodeModel.t; + no_framepointer_elim: bool; + enable_fast_isel: bool; +} + +let default_compiler_options = { + opt_level = 0; + code_model = Llvm_target.CodeModel.JITDefault; + no_framepointer_elim = false; + enable_fast_isel = false } + +external create : ?options:llcompileroptions -> Llvm.llmodule -> llexecutionengine + = "llvm_ee_create" +external dispose : llexecutionengine -> unit + = "llvm_ee_dispose" +external add_module : Llvm.llmodule -> llexecutionengine -> unit + = "llvm_ee_add_module" +external remove_module : Llvm.llmodule -> llexecutionengine -> unit + = "llvm_ee_remove_module" +external run_static_ctors : llexecutionengine -> unit + = "llvm_ee_run_static_ctors" +external run_static_dtors : llexecutionengine -> unit + = "llvm_ee_run_static_dtors" +external data_layout : llexecutionengine -> Llvm_target.DataLayout.t + = "llvm_ee_get_data_layout" +external add_global_mapping_ : Llvm.llvalue -> nativeint -> llexecutionengine -> unit + = "llvm_ee_add_global_mapping" +external get_global_value_address_ : string -> llexecutionengine -> nativeint + = "llvm_ee_get_global_value_address" +external get_function_address_ : string -> llexecutionengine -> nativeint + = "llvm_ee_get_function_address" + +let add_global_mapping llval ptr ee = + add_global_mapping_ llval (Ctypes.raw_address_of_ptr (Ctypes.to_voidp ptr)) ee + +let get_global_value_address name typ ee = + let vptr = get_global_value_address_ name ee in + if Nativeint.to_int vptr <> 0 then + let open Ctypes in !@ (coerce (ptr void) (ptr typ) (ptr_of_raw_address vptr)) + else + raise (Error ("Value " ^ name ^ " not found")) + +let get_function_address name typ ee = + let fptr = get_function_address_ name ee in + if Nativeint.to_int fptr <> 0 then + let open Ctypes in coerce (ptr void) typ (ptr_of_raw_address fptr) + else + raise (Error ("Function " ^ name ^ " not found")) + +(* The following are not bound. Patches are welcome. +target_machine : llexecutionengine -> Llvm_target.TargetMachine.t + *) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/llvm_executionengine.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/llvm_executionengine.mli new file mode 100644 index 000000000..3c5a1c06a --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/executionengine/llvm_executionengine.mli @@ -0,0 +1,92 @@ +(*===-- llvm_executionengine.mli - LLVM OCaml Interface -------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** JIT Interpreter. + + This interface provides an OCaml API for LLVM execution engine (JIT/ + interpreter), the classes in the [ExecutionEngine] library. *) + +exception Error of string + +(** [initialize ()] initializes the backend corresponding to the host. + Returns [true] if initialization is successful; [false] indicates + that there is no such backend or it is unable to emit object code + via MCJIT. *) +val initialize : unit -> bool + +(** An execution engine is either a JIT compiler or an interpreter, capable of + directly loading an LLVM module and executing its functions without first + invoking a static compiler and generating a native executable. *) +type llexecutionengine + +(** MCJIT compiler options. See [llvm::TargetOptions]. *) +type llcompileroptions = { + opt_level: int; + code_model: Llvm_target.CodeModel.t; + no_framepointer_elim: bool; + enable_fast_isel: bool; +} + +(** Default MCJIT compiler options: + [{ opt_level = 0; code_model = CodeModel.JIT_default; + no_framepointer_elim = false; enable_fast_isel = false }] *) +val default_compiler_options : llcompileroptions + +(** [create m optlevel] creates a new MCJIT just-in-time compiler, taking + ownership of the module [m] if successful with the desired optimization + level [optlevel]. Raises [Error msg] if an error occurrs. The execution + engine is not garbage collected and must be destroyed with [dispose ee]. + + Run {!initialize} before using this function. + + See the function [llvm::EngineBuilder::create]. *) +val create : ?options:llcompileroptions -> Llvm.llmodule -> llexecutionengine + +(** [dispose ee] releases the memory used by the execution engine and must be + invoked to avoid memory leaks. *) +val dispose : llexecutionengine -> unit + +(** [add_module m ee] adds the module [m] to the execution engine [ee]. *) +val add_module : Llvm.llmodule -> llexecutionengine -> unit + +(** [remove_module m ee] removes the module [m] from the execution engine + [ee]. Raises [Error msg] if an error occurs. *) +val remove_module : Llvm.llmodule -> llexecutionengine -> unit + +(** [run_static_ctors ee] executes the static constructors of each module in + the execution engine [ee]. *) +val run_static_ctors : llexecutionengine -> unit + +(** [run_static_dtors ee] executes the static destructors of each module in + the execution engine [ee]. *) +val run_static_dtors : llexecutionengine -> unit + +(** [data_layout ee] is the data layout of the execution engine [ee]. *) +val data_layout : llexecutionengine -> Llvm_target.DataLayout.t + +(** [add_global_mapping gv ptr ee] tells the execution engine [ee] that + the global [gv] is at the specified location [ptr], which must outlive + [gv] and [ee]. + All uses of [gv] in the compiled code will refer to [ptr]. *) +val add_global_mapping : Llvm.llvalue -> 'a Ctypes.ptr -> llexecutionengine -> unit + +(** [get_global_value_address id typ ee] returns a pointer to the + identifier [id] as type [typ], which will be a pointer type for a + value, and which will be live as long as [id] and [ee] + are. Caution: this function finalizes, i.e. forces code + generation, all loaded modules. Further modifications to the + modules will not have any effect. *) +val get_global_value_address : string -> 'a Ctypes.typ -> llexecutionengine -> 'a + +(** [get_function_address fn typ ee] returns a pointer to the function + [fn] as type [typ], which will be a pointer type for a function + (e.g. [(int -> int) typ]), and which will be live as long as [fn] + and [ee] are. Caution: this function finalizes, i.e. forces code + generation, all loaded modules. Further modifications to the + modules will not have any effect. *) +val get_function_address : string -> 'a Ctypes.typ -> llexecutionengine -> 'a diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/CMakeLists.txt new file mode 100644 index 000000000..87d269b48 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_irreader + OCAML llvm_irreader + OCAMLDEP llvm + C irreader_ocaml + LLVM irreader) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/irreader_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/irreader_ocaml.c new file mode 100644 index 000000000..63a339edb --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/irreader_ocaml.c @@ -0,0 +1,35 @@ +/*===-- irreader_ocaml.c - LLVM OCaml Glue ----------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/IRReader.h" +#include "caml/alloc.h" +#include "caml/fail.h" +#include "caml/memory.h" +#include "caml/callback.h" + +void llvm_raise(value Prototype, char *Message); + +/* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */ +CAMLprim value llvm_parse_ir(LLVMContextRef C, + LLVMMemoryBufferRef MemBuf) { + CAMLparam0(); + CAMLlocal2(Variant, MessageVal); + LLVMModuleRef M; + char *Message; + + if (LLVMParseIRInContext(C, MemBuf, &M, &Message)) + llvm_raise(*caml_named_value("Llvm_irreader.Error"), Message); + + CAMLreturn((value) M); +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/llvm_irreader.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/llvm_irreader.ml new file mode 100644 index 000000000..a8ece4331 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/llvm_irreader.ml @@ -0,0 +1,15 @@ +(*===-- llvm_irreader.ml - LLVM OCaml Interface ---------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + + +exception Error of string + +let _ = Callback.register_exception "Llvm_irreader.Error" (Error "") + +external parse_ir : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule + = "llvm_parse_ir" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/llvm_irreader.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/llvm_irreader.mli new file mode 100644 index 000000000..bdb7d0408 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/irreader/llvm_irreader.mli @@ -0,0 +1,20 @@ +(*===-- llvm_irreader.mli - LLVM OCaml Interface --------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** IR reader. + + This interface provides an OCaml API for the LLVM assembly reader, the + classes in the IRReader library. *) + +exception Error of string + +(** [parse_ir context mb] parses the IR for a new module [m] from the + memory buffer [mb] in the context [context]. Returns [m] if successful, or + raises [Error msg] otherwise, where [msg] is a description of the error + encountered. See the function [llvm::ParseIR]. *) +val parse_ir : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/CMakeLists.txt new file mode 100644 index 000000000..b6bc8ac1e --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_linker + OCAML llvm_linker + OCAMLDEP llvm + C linker_ocaml + LLVM linker) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/linker_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/linker_ocaml.c new file mode 100644 index 000000000..75723d9ee --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/linker_ocaml.c @@ -0,0 +1,33 @@ +/*===-- linker_ocaml.c - LLVM OCaml Glue ------------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Core.h" +#include "llvm-c/Linker.h" +#include "caml/alloc.h" +#include "caml/memory.h" +#include "caml/fail.h" +#include "caml/callback.h" + +void llvm_raise(value Prototype, char *Message); + +/* llmodule -> llmodule -> unit */ +CAMLprim value llvm_link_modules(LLVMModuleRef Dst, LLVMModuleRef Src) { + if (LLVMLinkModules2(Dst, Src)) + llvm_raise(*caml_named_value("Llvm_linker.Error"), LLVMCreateMessage("Linking failed")); + + return Val_unit; +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/llvm_linker.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/llvm_linker.ml new file mode 100644 index 000000000..e61e8fcb5 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/llvm_linker.ml @@ -0,0 +1,14 @@ +(*===-- llvm_linker.ml - LLVM OCaml Interface ------------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +exception Error of string + +let () = Callback.register_exception "Llvm_linker.Error" (Error "") + +external link_modules' : Llvm.llmodule -> Llvm.llmodule -> unit + = "llvm_link_modules" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/llvm_linker.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/llvm_linker.mli new file mode 100644 index 000000000..ed8f0b38c --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/linker/llvm_linker.mli @@ -0,0 +1,18 @@ +(*===-- llvm_linker.mli - LLVM OCaml Interface -----------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Linker. + + This interface provides an OCaml API for LLVM bitcode linker, + the classes in the Linker library. *) + +exception Error of string + +(** [link_modules' dst src] links [src] into [dst], raising [Error] + if the linking fails. The src module is destroyed. *) +val link_modules' : Llvm.llmodule -> Llvm.llmodule -> unit \ No newline at end of file diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/CMakeLists.txt new file mode 100644 index 000000000..db7aee2ad --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/CMakeLists.txt @@ -0,0 +1,11 @@ +add_ocaml_library(llvm + OCAML llvm + C llvm_ocaml + LLVM core support) + +configure_file( + "${CMAKE_CURRENT_SOURCE_DIR}/META.llvm.in" + "${LLVM_LIBRARY_DIR}/ocaml/META.llvm") + +install(FILES "${LLVM_LIBRARY_DIR}/ocaml/META.llvm" + DESTINATION "${LLVM_OCAML_INSTALL_PATH}") diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/META.llvm.in b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/META.llvm.in new file mode 100644 index 000000000..adafd788e --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/META.llvm.in @@ -0,0 +1,110 @@ +name = "llvm" +version = "@PACKAGE_VERSION@" +description = "LLVM OCaml bindings" +archive(byte) = "llvm.cma" +archive(native) = "llvm.cmxa" +directory = "llvm" + +package "analysis" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "Intermediate representation analysis for LLVM" + archive(byte) = "llvm_analysis.cma" + archive(native) = "llvm_analysis.cmxa" +) + +package "bitreader" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "Bitcode reader for LLVM" + archive(byte) = "llvm_bitreader.cma" + archive(native) = "llvm_bitreader.cmxa" +) + +package "bitwriter" ( + requires = "llvm,unix" + version = "@PACKAGE_VERSION@" + description = "Bitcode writer for LLVM" + archive(byte) = "llvm_bitwriter.cma" + archive(native) = "llvm_bitwriter.cmxa" +) + +package "executionengine" ( + requires = "llvm,llvm.target,ctypes.foreign" + version = "@PACKAGE_VERSION@" + description = "JIT and Interpreter for LLVM" + archive(byte) = "llvm_executionengine.cma" + archive(native) = "llvm_executionengine.cmxa" +) + +package "ipo" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "IPO Transforms for LLVM" + archive(byte) = "llvm_ipo.cma" + archive(native) = "llvm_ipo.cmxa" +) + +package "irreader" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "IR assembly reader for LLVM" + archive(byte) = "llvm_irreader.cma" + archive(native) = "llvm_irreader.cmxa" +) + +package "scalar_opts" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "Scalar Transforms for LLVM" + archive(byte) = "llvm_scalar_opts.cma" + archive(native) = "llvm_scalar_opts.cmxa" +) + +package "transform_utils" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "Transform utilities for LLVM" + archive(byte) = "llvm_transform_utils.cma" + archive(native) = "llvm_transform_utils.cmxa" +) + +package "vectorize" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "Vector Transforms for LLVM" + archive(byte) = "llvm_vectorize.cma" + archive(native) = "llvm_vectorize.cmxa" +) + +package "passmgr_builder" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "Pass Manager Builder for LLVM" + archive(byte) = "llvm_passmgr_builder.cma" + archive(native) = "llvm_passmgr_builder.cmxa" +) + +package "target" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "Target Information for LLVM" + archive(byte) = "llvm_target.cma" + archive(native) = "llvm_target.cmxa" +) + +package "linker" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "Intermediate Representation Linker for LLVM" + archive(byte) = "llvm_linker.cma" + archive(native) = "llvm_linker.cmxa" +) + +package "all_backends" ( + requires = "llvm" + version = "@PACKAGE_VERSION@" + description = "All backends for LLVM" + archive(byte) = "llvm_all_backends.cma" + archive(native) = "llvm_all_backends.cmxa" +) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm.ml new file mode 100644 index 000000000..fdef6eb17 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm.ml @@ -0,0 +1,1389 @@ +(*===-- llvm/llvm.ml - LLVM OCaml Interface -------------------------------===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + + +type llcontext +type llmodule +type lltype +type llvalue +type lluse +type llbasicblock +type llbuilder +type llattrkind +type llattribute +type llmemorybuffer +type llmdkind + +exception FeatureDisabled of string + +let () = Callback.register_exception "Llvm.FeatureDisabled" (FeatureDisabled "") + +module TypeKind = struct + type t = + | Void + | Half + | Float + | Double + | X86fp80 + | Fp128 + | Ppc_fp128 + | Label + | Integer + | Function + | Struct + | Array + | Pointer + | Vector + | Metadata + | X86_mmx + | Token +end + +module Linkage = struct + type t = + | External + | Available_externally + | Link_once + | Link_once_odr + | Link_once_odr_auto_hide + | Weak + | Weak_odr + | Appending + | Internal + | Private + | Dllimport + | Dllexport + | External_weak + | Ghost + | Common + | Linker_private + | Linker_private_weak +end + +module Visibility = struct + type t = + | Default + | Hidden + | Protected +end + +module DLLStorageClass = struct + type t = + | Default + | DLLImport + | DLLExport +end + +module CallConv = struct + let c = 0 + let fast = 8 + let cold = 9 + let x86_stdcall = 64 + let x86_fastcall = 65 +end + +module AttrRepr = struct + type t = + | Enum of llattrkind * int64 + | String of string * string +end + +module AttrIndex = struct + type t = + | Function + | Return + | Param of int + + let to_int index = + match index with + | Function -> -1 + | Return -> 0 + | Param(n) -> 1 + n +end + +module Attribute = struct + type t = + | Zext + | Sext + | Noreturn + | Inreg + | Structret + | Nounwind + | Noalias + | Byval + | Nest + | Readnone + | Readonly + | Noinline + | Alwaysinline + | Optsize + | Ssp + | Sspreq + | Alignment of int + | Nocapture + | Noredzone + | Noimplicitfloat + | Naked + | Inlinehint + | Stackalignment of int + | ReturnsTwice + | UWTable + | NonLazyBind +end + +module Icmp = struct + type t = + | Eq + | Ne + | Ugt + | Uge + | Ult + | Ule + | Sgt + | Sge + | Slt + | Sle +end + +module Fcmp = struct + type t = + | False + | Oeq + | Ogt + | Oge + | Olt + | Ole + | One + | Ord + | Uno + | Ueq + | Ugt + | Uge + | Ult + | Ule + | Une + | True +end + +module Opcode = struct + type t = + | Invalid (* not an instruction *) + (* Terminator Instructions *) + | Ret + | Br + | Switch + | IndirectBr + | Invoke + | Invalid2 + | Unreachable + (* Standard Binary Operators *) + | Add + | FAdd + | Sub + | FSub + | Mul + | FMul + | UDiv + | SDiv + | FDiv + | URem + | SRem + | FRem + (* Logical Operators *) + | Shl + | LShr + | AShr + | And + | Or + | Xor + (* Memory Operators *) + | Alloca + | Load + | Store + | GetElementPtr + (* Cast Operators *) + | Trunc + | ZExt + | SExt + | FPToUI + | FPToSI + | UIToFP + | SIToFP + | FPTrunc + | FPExt + | PtrToInt + | IntToPtr + | BitCast + (* Other Operators *) + | ICmp + | FCmp + | PHI + | Call + | Select + | UserOp1 + | UserOp2 + | VAArg + | ExtractElement + | InsertElement + | ShuffleVector + | ExtractValue + | InsertValue + | Fence + | AtomicCmpXchg + | AtomicRMW + | Resume + | LandingPad + | AddrSpaceCast + | CleanupRet + | CatchRet + | CatchPad + | CleanupPad + | CatchSwitch + | FNeg + | CallBr +end + +module LandingPadClauseTy = struct + type t = + | Catch + | Filter +end + +module ThreadLocalMode = struct + type t = + | None + | GeneralDynamic + | LocalDynamic + | InitialExec + | LocalExec +end + +module AtomicOrdering = struct + type t = + | NotAtomic + | Unordered + | Monotonic + | Invalid + | Acquire + | Release + | AcqiureRelease + | SequentiallyConsistent +end + +module AtomicRMWBinOp = struct + type t = + | Xchg + | Add + | Sub + | And + | Nand + | Or + | Xor + | Max + | Min + | UMax + | UMin +end + +module ValueKind = struct + type t = + | NullValue + | Argument + | BasicBlock + | InlineAsm + | MDNode + | MDString + | BlockAddress + | ConstantAggregateZero + | ConstantArray + | ConstantDataArray + | ConstantDataVector + | ConstantExpr + | ConstantFP + | ConstantInt + | ConstantPointerNull + | ConstantStruct + | ConstantVector + | Function + | GlobalAlias + | GlobalIFunc + | GlobalVariable + | UndefValue + | Instruction of Opcode.t +end + +module DiagnosticSeverity = struct + type t = + | Error + | Warning + | Remark + | Note +end + +exception IoError of string + +let () = Callback.register_exception "Llvm.IoError" (IoError "") + +external install_fatal_error_handler : (string -> unit) -> unit + = "llvm_install_fatal_error_handler" +external reset_fatal_error_handler : unit -> unit + = "llvm_reset_fatal_error_handler" +external enable_pretty_stacktrace : unit -> unit + = "llvm_enable_pretty_stacktrace" +external parse_command_line_options : ?overview:string -> string array -> unit + = "llvm_parse_command_line_options" + +type ('a, 'b) llpos = +| At_end of 'a +| Before of 'b + +type ('a, 'b) llrev_pos = +| At_start of 'a +| After of 'b + + +(*===-- Context error handling --------------------------------------------===*) +module Diagnostic = struct + type t + + external description : t -> string = "llvm_get_diagnostic_description" + external severity : t -> DiagnosticSeverity.t + = "llvm_get_diagnostic_severity" +end + +external set_diagnostic_handler + : llcontext -> (Diagnostic.t -> unit) option -> unit + = "llvm_set_diagnostic_handler" + +(*===-- Contexts ----------------------------------------------------------===*) +external create_context : unit -> llcontext = "llvm_create_context" +external dispose_context : llcontext -> unit = "llvm_dispose_context" +external global_context : unit -> llcontext = "llvm_global_context" +external mdkind_id : llcontext -> string -> llmdkind = "llvm_mdkind_id" + +(*===-- Attributes --------------------------------------------------------===*) +exception UnknownAttribute of string + +let () = Callback.register_exception "Llvm.UnknownAttribute" + (UnknownAttribute "") + +external enum_attr_kind : string -> llattrkind = "llvm_enum_attr_kind" +external llvm_create_enum_attr : llcontext -> llattrkind -> int64 -> + llattribute + = "llvm_create_enum_attr_by_kind" +external is_enum_attr : llattribute -> bool = "llvm_is_enum_attr" +external get_enum_attr_kind : llattribute -> llattrkind + = "llvm_get_enum_attr_kind" +external get_enum_attr_value : llattribute -> int64 + = "llvm_get_enum_attr_value" +external llvm_create_string_attr : llcontext -> string -> string -> + llattribute + = "llvm_create_string_attr" +external is_string_attr : llattribute -> bool = "llvm_is_string_attr" +external get_string_attr_kind : llattribute -> string + = "llvm_get_string_attr_kind" +external get_string_attr_value : llattribute -> string + = "llvm_get_string_attr_value" + +let create_enum_attr context name value = + llvm_create_enum_attr context (enum_attr_kind name) value +let create_string_attr context kind value = + llvm_create_string_attr context kind value + +let attr_of_repr context repr = + match repr with + | AttrRepr.Enum(kind, value) -> llvm_create_enum_attr context kind value + | AttrRepr.String(key, value) -> llvm_create_string_attr context key value + +let repr_of_attr attr = + if is_enum_attr attr then + AttrRepr.Enum(get_enum_attr_kind attr, get_enum_attr_value attr) + else if is_string_attr attr then + AttrRepr.String(get_string_attr_kind attr, get_string_attr_value attr) + else assert false + +(*===-- Modules -----------------------------------------------------------===*) +external create_module : llcontext -> string -> llmodule = "llvm_create_module" +external dispose_module : llmodule -> unit = "llvm_dispose_module" +external target_triple: llmodule -> string + = "llvm_target_triple" +external set_target_triple: string -> llmodule -> unit + = "llvm_set_target_triple" +external data_layout: llmodule -> string + = "llvm_data_layout" +external set_data_layout: string -> llmodule -> unit + = "llvm_set_data_layout" +external dump_module : llmodule -> unit = "llvm_dump_module" +external print_module : string -> llmodule -> unit = "llvm_print_module" +external string_of_llmodule : llmodule -> string = "llvm_string_of_llmodule" +external set_module_inline_asm : llmodule -> string -> unit + = "llvm_set_module_inline_asm" +external module_context : llmodule -> llcontext = "LLVMGetModuleContext" + +(*===-- Types -------------------------------------------------------------===*) +external classify_type : lltype -> TypeKind.t = "llvm_classify_type" +external type_context : lltype -> llcontext = "llvm_type_context" +external type_is_sized : lltype -> bool = "llvm_type_is_sized" +external dump_type : lltype -> unit = "llvm_dump_type" +external string_of_lltype : lltype -> string = "llvm_string_of_lltype" + +(*--... Operations on integer types ........................................--*) +external i1_type : llcontext -> lltype = "llvm_i1_type" +external i8_type : llcontext -> lltype = "llvm_i8_type" +external i16_type : llcontext -> lltype = "llvm_i16_type" +external i32_type : llcontext -> lltype = "llvm_i32_type" +external i64_type : llcontext -> lltype = "llvm_i64_type" + +external integer_type : llcontext -> int -> lltype = "llvm_integer_type" +external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth" + +(*--... Operations on real types ...........................................--*) +external float_type : llcontext -> lltype = "llvm_float_type" +external double_type : llcontext -> lltype = "llvm_double_type" +external x86fp80_type : llcontext -> lltype = "llvm_x86fp80_type" +external fp128_type : llcontext -> lltype = "llvm_fp128_type" +external ppc_fp128_type : llcontext -> lltype = "llvm_ppc_fp128_type" + +(*--... Operations on function types .......................................--*) +external function_type : lltype -> lltype array -> lltype = "llvm_function_type" +external var_arg_function_type : lltype -> lltype array -> lltype + = "llvm_var_arg_function_type" +external is_var_arg : lltype -> bool = "llvm_is_var_arg" +external return_type : lltype -> lltype = "LLVMGetReturnType" +external param_types : lltype -> lltype array = "llvm_param_types" + +(*--... Operations on struct types .........................................--*) +external struct_type : llcontext -> lltype array -> lltype = "llvm_struct_type" +external packed_struct_type : llcontext -> lltype array -> lltype + = "llvm_packed_struct_type" +external struct_name : lltype -> string option = "llvm_struct_name" +external named_struct_type : llcontext -> string -> lltype = + "llvm_named_struct_type" +external struct_set_body : lltype -> lltype array -> bool -> unit = + "llvm_struct_set_body" +external struct_element_types : lltype -> lltype array + = "llvm_struct_element_types" +external is_packed : lltype -> bool = "llvm_is_packed" +external is_opaque : lltype -> bool = "llvm_is_opaque" +external is_literal : lltype -> bool = "llvm_is_literal" + +(*--... Operations on pointer, vector, and array types .....................--*) + +external subtypes : lltype -> lltype array = "llvm_subtypes" +external array_type : lltype -> int -> lltype = "llvm_array_type" +external pointer_type : lltype -> lltype = "llvm_pointer_type" +external qualified_pointer_type : lltype -> int -> lltype + = "llvm_qualified_pointer_type" +external vector_type : lltype -> int -> lltype = "llvm_vector_type" + +external element_type : lltype -> lltype = "LLVMGetElementType" +external array_length : lltype -> int = "llvm_array_length" +external address_space : lltype -> int = "llvm_address_space" +external vector_size : lltype -> int = "llvm_vector_size" + +(*--... Operations on other types ..........................................--*) +external void_type : llcontext -> lltype = "llvm_void_type" +external label_type : llcontext -> lltype = "llvm_label_type" +external x86_mmx_type : llcontext -> lltype = "llvm_x86_mmx_type" +external type_by_name : llmodule -> string -> lltype option = "llvm_type_by_name" + +external classify_value : llvalue -> ValueKind.t = "llvm_classify_value" +(*===-- Values ------------------------------------------------------------===*) +external type_of : llvalue -> lltype = "llvm_type_of" +external value_name : llvalue -> string = "llvm_value_name" +external set_value_name : string -> llvalue -> unit = "llvm_set_value_name" +external dump_value : llvalue -> unit = "llvm_dump_value" +external string_of_llvalue : llvalue -> string = "llvm_string_of_llvalue" +external replace_all_uses_with : llvalue -> llvalue -> unit + = "llvm_replace_all_uses_with" + +(*--... Operations on uses .................................................--*) +external use_begin : llvalue -> lluse option = "llvm_use_begin" +external use_succ : lluse -> lluse option = "llvm_use_succ" +external user : lluse -> llvalue = "llvm_user" +external used_value : lluse -> llvalue = "llvm_used_value" + +let iter_uses f v = + let rec aux = function + | None -> () + | Some u -> + f u; + aux (use_succ u) + in + aux (use_begin v) + +let fold_left_uses f init v = + let rec aux init u = + match u with + | None -> init + | Some u -> aux (f init u) (use_succ u) + in + aux init (use_begin v) + +let fold_right_uses f v init = + let rec aux u init = + match u with + | None -> init + | Some u -> f u (aux (use_succ u) init) + in + aux (use_begin v) init + + +(*--... Operations on users ................................................--*) +external operand : llvalue -> int -> llvalue = "llvm_operand" +external operand_use : llvalue -> int -> lluse = "llvm_operand_use" +external set_operand : llvalue -> int -> llvalue -> unit = "llvm_set_operand" +external num_operands : llvalue -> int = "llvm_num_operands" +external indices : llvalue -> int array = "llvm_indices" + +(*--... Operations on constants of (mostly) any type .......................--*) +external is_constant : llvalue -> bool = "llvm_is_constant" +external const_null : lltype -> llvalue = "LLVMConstNull" +external const_all_ones : (*int|vec*)lltype -> llvalue = "LLVMConstAllOnes" +external const_pointer_null : lltype -> llvalue = "LLVMConstPointerNull" +external undef : lltype -> llvalue = "LLVMGetUndef" +external is_null : llvalue -> bool = "llvm_is_null" +external is_undef : llvalue -> bool = "llvm_is_undef" +external constexpr_opcode : llvalue -> Opcode.t = "llvm_constexpr_get_opcode" + +(*--... Operations on instructions .........................................--*) +external has_metadata : llvalue -> bool = "llvm_has_metadata" +external metadata : llvalue -> llmdkind -> llvalue option = "llvm_metadata" +external set_metadata : llvalue -> llmdkind -> llvalue -> unit = "llvm_set_metadata" +external clear_metadata : llvalue -> llmdkind -> unit = "llvm_clear_metadata" + +(*--... Operations on metadata .......,.....................................--*) +external mdstring : llcontext -> string -> llvalue = "llvm_mdstring" +external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode" +external mdnull : llcontext -> llvalue = "llvm_mdnull" +external get_mdstring : llvalue -> string option = "llvm_get_mdstring" +external get_mdnode_operands : llvalue -> llvalue array + = "llvm_get_mdnode_operands" +external get_named_metadata : llmodule -> string -> llvalue array + = "llvm_get_namedmd" +external add_named_metadata_operand : llmodule -> string -> llvalue -> unit + = "llvm_append_namedmd" + +(*--... Operations on scalar constants .....................................--*) +external const_int : lltype -> int -> llvalue = "llvm_const_int" +external const_of_int64 : lltype -> Int64.t -> bool -> llvalue + = "llvm_const_of_int64" +external int64_of_const : llvalue -> Int64.t option + = "llvm_int64_of_const" +external const_int_of_string : lltype -> string -> int -> llvalue + = "llvm_const_int_of_string" +external const_float : lltype -> float -> llvalue = "llvm_const_float" +external float_of_const : llvalue -> float option + = "llvm_float_of_const" +external const_float_of_string : lltype -> string -> llvalue + = "llvm_const_float_of_string" + +(*--... Operations on composite constants ..................................--*) +external const_string : llcontext -> string -> llvalue = "llvm_const_string" +external const_stringz : llcontext -> string -> llvalue = "llvm_const_stringz" +external const_array : lltype -> llvalue array -> llvalue = "llvm_const_array" +external const_struct : llcontext -> llvalue array -> llvalue + = "llvm_const_struct" +external const_named_struct : lltype -> llvalue array -> llvalue + = "llvm_const_named_struct" +external const_packed_struct : llcontext -> llvalue array -> llvalue + = "llvm_const_packed_struct" +external const_vector : llvalue array -> llvalue = "llvm_const_vector" +external string_of_const : llvalue -> string option = "llvm_string_of_const" +external const_element : llvalue -> int -> llvalue = "llvm_const_element" + +(*--... Constant expressions ...............................................--*) +external align_of : lltype -> llvalue = "LLVMAlignOf" +external size_of : lltype -> llvalue = "LLVMSizeOf" +external const_neg : llvalue -> llvalue = "LLVMConstNeg" +external const_nsw_neg : llvalue -> llvalue = "LLVMConstNSWNeg" +external const_nuw_neg : llvalue -> llvalue = "LLVMConstNUWNeg" +external const_fneg : llvalue -> llvalue = "LLVMConstFNeg" +external const_not : llvalue -> llvalue = "LLVMConstNot" +external const_add : llvalue -> llvalue -> llvalue = "LLVMConstAdd" +external const_nsw_add : llvalue -> llvalue -> llvalue = "LLVMConstNSWAdd" +external const_nuw_add : llvalue -> llvalue -> llvalue = "LLVMConstNUWAdd" +external const_fadd : llvalue -> llvalue -> llvalue = "LLVMConstFAdd" +external const_sub : llvalue -> llvalue -> llvalue = "LLVMConstSub" +external const_nsw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNSWSub" +external const_nuw_sub : llvalue -> llvalue -> llvalue = "LLVMConstNUWSub" +external const_fsub : llvalue -> llvalue -> llvalue = "LLVMConstFSub" +external const_mul : llvalue -> llvalue -> llvalue = "LLVMConstMul" +external const_nsw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNSWMul" +external const_nuw_mul : llvalue -> llvalue -> llvalue = "LLVMConstNUWMul" +external const_fmul : llvalue -> llvalue -> llvalue = "LLVMConstFMul" +external const_udiv : llvalue -> llvalue -> llvalue = "LLVMConstUDiv" +external const_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstSDiv" +external const_exact_sdiv : llvalue -> llvalue -> llvalue = "LLVMConstExactSDiv" +external const_fdiv : llvalue -> llvalue -> llvalue = "LLVMConstFDiv" +external const_urem : llvalue -> llvalue -> llvalue = "LLVMConstURem" +external const_srem : llvalue -> llvalue -> llvalue = "LLVMConstSRem" +external const_frem : llvalue -> llvalue -> llvalue = "LLVMConstFRem" +external const_and : llvalue -> llvalue -> llvalue = "LLVMConstAnd" +external const_or : llvalue -> llvalue -> llvalue = "LLVMConstOr" +external const_xor : llvalue -> llvalue -> llvalue = "LLVMConstXor" +external const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue + = "llvm_const_icmp" +external const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue + = "llvm_const_fcmp" +external const_shl : llvalue -> llvalue -> llvalue = "LLVMConstShl" +external const_lshr : llvalue -> llvalue -> llvalue = "LLVMConstLShr" +external const_ashr : llvalue -> llvalue -> llvalue = "LLVMConstAShr" +external const_gep : llvalue -> llvalue array -> llvalue = "llvm_const_gep" +external const_in_bounds_gep : llvalue -> llvalue array -> llvalue + = "llvm_const_in_bounds_gep" +external const_trunc : llvalue -> lltype -> llvalue = "LLVMConstTrunc" +external const_sext : llvalue -> lltype -> llvalue = "LLVMConstSExt" +external const_zext : llvalue -> lltype -> llvalue = "LLVMConstZExt" +external const_fptrunc : llvalue -> lltype -> llvalue = "LLVMConstFPTrunc" +external const_fpext : llvalue -> lltype -> llvalue = "LLVMConstFPExt" +external const_uitofp : llvalue -> lltype -> llvalue = "LLVMConstUIToFP" +external const_sitofp : llvalue -> lltype -> llvalue = "LLVMConstSIToFP" +external const_fptoui : llvalue -> lltype -> llvalue = "LLVMConstFPToUI" +external const_fptosi : llvalue -> lltype -> llvalue = "LLVMConstFPToSI" +external const_ptrtoint : llvalue -> lltype -> llvalue = "LLVMConstPtrToInt" +external const_inttoptr : llvalue -> lltype -> llvalue = "LLVMConstIntToPtr" +external const_bitcast : llvalue -> lltype -> llvalue = "LLVMConstBitCast" +external const_zext_or_bitcast : llvalue -> lltype -> llvalue + = "LLVMConstZExtOrBitCast" +external const_sext_or_bitcast : llvalue -> lltype -> llvalue + = "LLVMConstSExtOrBitCast" +external const_trunc_or_bitcast : llvalue -> lltype -> llvalue + = "LLVMConstTruncOrBitCast" +external const_pointercast : llvalue -> lltype -> llvalue + = "LLVMConstPointerCast" +external const_intcast : llvalue -> lltype -> is_signed:bool -> llvalue + = "llvm_const_intcast" +external const_fpcast : llvalue -> lltype -> llvalue = "LLVMConstFPCast" +external const_select : llvalue -> llvalue -> llvalue -> llvalue + = "LLVMConstSelect" +external const_extractelement : llvalue -> llvalue -> llvalue + = "LLVMConstExtractElement" +external const_insertelement : llvalue -> llvalue -> llvalue -> llvalue + = "LLVMConstInsertElement" +external const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue + = "LLVMConstShuffleVector" +external const_extractvalue : llvalue -> int array -> llvalue + = "llvm_const_extractvalue" +external const_insertvalue : llvalue -> llvalue -> int array -> llvalue + = "llvm_const_insertvalue" +external const_inline_asm : lltype -> string -> string -> bool -> bool -> + llvalue + = "llvm_const_inline_asm" +external block_address : llvalue -> llbasicblock -> llvalue = "LLVMBlockAddress" + +(*--... Operations on global variables, functions, and aliases (globals) ...--*) +external global_parent : llvalue -> llmodule = "LLVMGetGlobalParent" +external is_declaration : llvalue -> bool = "llvm_is_declaration" +external linkage : llvalue -> Linkage.t = "llvm_linkage" +external set_linkage : Linkage.t -> llvalue -> unit = "llvm_set_linkage" +external unnamed_addr : llvalue -> bool = "llvm_unnamed_addr" +external set_unnamed_addr : bool -> llvalue -> unit = "llvm_set_unnamed_addr" +external section : llvalue -> string = "llvm_section" +external set_section : string -> llvalue -> unit = "llvm_set_section" +external visibility : llvalue -> Visibility.t = "llvm_visibility" +external set_visibility : Visibility.t -> llvalue -> unit = "llvm_set_visibility" +external dll_storage_class : llvalue -> DLLStorageClass.t = "llvm_dll_storage_class" +external set_dll_storage_class : DLLStorageClass.t -> llvalue -> unit = "llvm_set_dll_storage_class" +external alignment : llvalue -> int = "llvm_alignment" +external set_alignment : int -> llvalue -> unit = "llvm_set_alignment" +external is_global_constant : llvalue -> bool = "llvm_is_global_constant" +external set_global_constant : bool -> llvalue -> unit + = "llvm_set_global_constant" + +(*--... Operations on global variables .....................................--*) +external declare_global : lltype -> string -> llmodule -> llvalue + = "llvm_declare_global" +external declare_qualified_global : lltype -> string -> int -> llmodule -> + llvalue + = "llvm_declare_qualified_global" +external define_global : string -> llvalue -> llmodule -> llvalue + = "llvm_define_global" +external define_qualified_global : string -> llvalue -> int -> llmodule -> + llvalue + = "llvm_define_qualified_global" +external lookup_global : string -> llmodule -> llvalue option + = "llvm_lookup_global" +external delete_global : llvalue -> unit = "llvm_delete_global" +external global_initializer : llvalue -> llvalue = "LLVMGetInitializer" +external set_initializer : llvalue -> llvalue -> unit = "llvm_set_initializer" +external remove_initializer : llvalue -> unit = "llvm_remove_initializer" +external is_thread_local : llvalue -> bool = "llvm_is_thread_local" +external set_thread_local : bool -> llvalue -> unit = "llvm_set_thread_local" +external thread_local_mode : llvalue -> ThreadLocalMode.t + = "llvm_thread_local_mode" +external set_thread_local_mode : ThreadLocalMode.t -> llvalue -> unit + = "llvm_set_thread_local_mode" +external is_externally_initialized : llvalue -> bool + = "llvm_is_externally_initialized" +external set_externally_initialized : bool -> llvalue -> unit + = "llvm_set_externally_initialized" +external global_begin : llmodule -> (llmodule, llvalue) llpos + = "llvm_global_begin" +external global_succ : llvalue -> (llmodule, llvalue) llpos + = "llvm_global_succ" +external global_end : llmodule -> (llmodule, llvalue) llrev_pos + = "llvm_global_end" +external global_pred : llvalue -> (llmodule, llvalue) llrev_pos + = "llvm_global_pred" + +let rec iter_global_range f i e = + if i = e then () else + match i with + | At_end _ -> raise (Invalid_argument "Invalid global variable range.") + | Before bb -> + f bb; + iter_global_range f (global_succ bb) e + +let iter_globals f m = + iter_global_range f (global_begin m) (At_end m) + +let rec fold_left_global_range f init i e = + if i = e then init else + match i with + | At_end _ -> raise (Invalid_argument "Invalid global variable range.") + | Before bb -> fold_left_global_range f (f init bb) (global_succ bb) e + +let fold_left_globals f init m = + fold_left_global_range f init (global_begin m) (At_end m) + +let rec rev_iter_global_range f i e = + if i = e then () else + match i with + | At_start _ -> raise (Invalid_argument "Invalid global variable range.") + | After bb -> + f bb; + rev_iter_global_range f (global_pred bb) e + +let rev_iter_globals f m = + rev_iter_global_range f (global_end m) (At_start m) + +let rec fold_right_global_range f i e init = + if i = e then init else + match i with + | At_start _ -> raise (Invalid_argument "Invalid global variable range.") + | After bb -> fold_right_global_range f (global_pred bb) e (f bb init) + +let fold_right_globals f m init = + fold_right_global_range f (global_end m) (At_start m) init + +(*--... Operations on aliases ..............................................--*) +external add_alias : llmodule -> lltype -> llvalue -> string -> llvalue + = "llvm_add_alias" + +(*--... Operations on functions ............................................--*) +external declare_function : string -> lltype -> llmodule -> llvalue + = "llvm_declare_function" +external define_function : string -> lltype -> llmodule -> llvalue + = "llvm_define_function" +external lookup_function : string -> llmodule -> llvalue option + = "llvm_lookup_function" +external delete_function : llvalue -> unit = "llvm_delete_function" +external is_intrinsic : llvalue -> bool = "llvm_is_intrinsic" +external function_call_conv : llvalue -> int = "llvm_function_call_conv" +external set_function_call_conv : int -> llvalue -> unit + = "llvm_set_function_call_conv" +external gc : llvalue -> string option = "llvm_gc" +external set_gc : string option -> llvalue -> unit = "llvm_set_gc" +external function_begin : llmodule -> (llmodule, llvalue) llpos + = "llvm_function_begin" +external function_succ : llvalue -> (llmodule, llvalue) llpos + = "llvm_function_succ" +external function_end : llmodule -> (llmodule, llvalue) llrev_pos + = "llvm_function_end" +external function_pred : llvalue -> (llmodule, llvalue) llrev_pos + = "llvm_function_pred" + +let rec iter_function_range f i e = + if i = e then () else + match i with + | At_end _ -> raise (Invalid_argument "Invalid function range.") + | Before fn -> + f fn; + iter_function_range f (function_succ fn) e + +let iter_functions f m = + iter_function_range f (function_begin m) (At_end m) + +let rec fold_left_function_range f init i e = + if i = e then init else + match i with + | At_end _ -> raise (Invalid_argument "Invalid function range.") + | Before fn -> fold_left_function_range f (f init fn) (function_succ fn) e + +let fold_left_functions f init m = + fold_left_function_range f init (function_begin m) (At_end m) + +let rec rev_iter_function_range f i e = + if i = e then () else + match i with + | At_start _ -> raise (Invalid_argument "Invalid function range.") + | After fn -> + f fn; + rev_iter_function_range f (function_pred fn) e + +let rev_iter_functions f m = + rev_iter_function_range f (function_end m) (At_start m) + +let rec fold_right_function_range f i e init = + if i = e then init else + match i with + | At_start _ -> raise (Invalid_argument "Invalid function range.") + | After fn -> fold_right_function_range f (function_pred fn) e (f fn init) + +let fold_right_functions f m init = + fold_right_function_range f (function_end m) (At_start m) init + +external llvm_add_function_attr : llvalue -> llattribute -> int -> unit + = "llvm_add_function_attr" +external llvm_function_attrs : llvalue -> int -> llattribute array + = "llvm_function_attrs" +external llvm_remove_enum_function_attr : llvalue -> llattrkind -> int -> unit + = "llvm_remove_enum_function_attr" +external llvm_remove_string_function_attr : llvalue -> string -> int -> unit + = "llvm_remove_string_function_attr" + +let add_function_attr f a i = + llvm_add_function_attr f a (AttrIndex.to_int i) +let function_attrs f i = + llvm_function_attrs f (AttrIndex.to_int i) +let remove_enum_function_attr f k i = + llvm_remove_enum_function_attr f k (AttrIndex.to_int i) +let remove_string_function_attr f k i = + llvm_remove_string_function_attr f k (AttrIndex.to_int i) + +(*--... Operations on params ...............................................--*) +external params : llvalue -> llvalue array = "llvm_params" +external param : llvalue -> int -> llvalue = "llvm_param" +external param_parent : llvalue -> llvalue = "LLVMGetParamParent" +external param_begin : llvalue -> (llvalue, llvalue) llpos = "llvm_param_begin" +external param_succ : llvalue -> (llvalue, llvalue) llpos = "llvm_param_succ" +external param_end : llvalue -> (llvalue, llvalue) llrev_pos = "llvm_param_end" +external param_pred : llvalue -> (llvalue, llvalue) llrev_pos ="llvm_param_pred" + +let rec iter_param_range f i e = + if i = e then () else + match i with + | At_end _ -> raise (Invalid_argument "Invalid parameter range.") + | Before p -> + f p; + iter_param_range f (param_succ p) e + +let iter_params f fn = + iter_param_range f (param_begin fn) (At_end fn) + +let rec fold_left_param_range f init i e = + if i = e then init else + match i with + | At_end _ -> raise (Invalid_argument "Invalid parameter range.") + | Before p -> fold_left_param_range f (f init p) (param_succ p) e + +let fold_left_params f init fn = + fold_left_param_range f init (param_begin fn) (At_end fn) + +let rec rev_iter_param_range f i e = + if i = e then () else + match i with + | At_start _ -> raise (Invalid_argument "Invalid parameter range.") + | After p -> + f p; + rev_iter_param_range f (param_pred p) e + +let rev_iter_params f fn = + rev_iter_param_range f (param_end fn) (At_start fn) + +let rec fold_right_param_range f init i e = + if i = e then init else + match i with + | At_start _ -> raise (Invalid_argument "Invalid parameter range.") + | After p -> fold_right_param_range f (f p init) (param_pred p) e + +let fold_right_params f fn init = + fold_right_param_range f init (param_end fn) (At_start fn) + +(*--... Operations on basic blocks .........................................--*) +external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue" +external value_is_block : llvalue -> bool = "llvm_value_is_block" +external block_of_value : llvalue -> llbasicblock = "LLVMValueAsBasicBlock" +external block_parent : llbasicblock -> llvalue = "LLVMGetBasicBlockParent" +external basic_blocks : llvalue -> llbasicblock array = "llvm_basic_blocks" +external entry_block : llvalue -> llbasicblock = "LLVMGetEntryBasicBlock" +external delete_block : llbasicblock -> unit = "llvm_delete_block" +external remove_block : llbasicblock -> unit = "llvm_remove_block" +external move_block_before : llbasicblock -> llbasicblock -> unit + = "llvm_move_block_before" +external move_block_after : llbasicblock -> llbasicblock -> unit + = "llvm_move_block_after" +external append_block : llcontext -> string -> llvalue -> llbasicblock + = "llvm_append_block" +external insert_block : llcontext -> string -> llbasicblock -> llbasicblock + = "llvm_insert_block" +external block_begin : llvalue -> (llvalue, llbasicblock) llpos + = "llvm_block_begin" +external block_succ : llbasicblock -> (llvalue, llbasicblock) llpos + = "llvm_block_succ" +external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos + = "llvm_block_end" +external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos + = "llvm_block_pred" +external block_terminator : llbasicblock -> llvalue option = + "llvm_block_terminator" + +let rec iter_block_range f i e = + if i = e then () else + match i with + | At_end _ -> raise (Invalid_argument "Invalid block range.") + | Before bb -> + f bb; + iter_block_range f (block_succ bb) e + +let iter_blocks f fn = + iter_block_range f (block_begin fn) (At_end fn) + +let rec fold_left_block_range f init i e = + if i = e then init else + match i with + | At_end _ -> raise (Invalid_argument "Invalid block range.") + | Before bb -> fold_left_block_range f (f init bb) (block_succ bb) e + +let fold_left_blocks f init fn = + fold_left_block_range f init (block_begin fn) (At_end fn) + +let rec rev_iter_block_range f i e = + if i = e then () else + match i with + | At_start _ -> raise (Invalid_argument "Invalid block range.") + | After bb -> + f bb; + rev_iter_block_range f (block_pred bb) e + +let rev_iter_blocks f fn = + rev_iter_block_range f (block_end fn) (At_start fn) + +let rec fold_right_block_range f init i e = + if i = e then init else + match i with + | At_start _ -> raise (Invalid_argument "Invalid block range.") + | After bb -> fold_right_block_range f (f bb init) (block_pred bb) e + +let fold_right_blocks f fn init = + fold_right_block_range f init (block_end fn) (At_start fn) + +(*--... Operations on instructions .........................................--*) +external instr_parent : llvalue -> llbasicblock = "LLVMGetInstructionParent" +external instr_begin : llbasicblock -> (llbasicblock, llvalue) llpos + = "llvm_instr_begin" +external instr_succ : llvalue -> (llbasicblock, llvalue) llpos + = "llvm_instr_succ" +external instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos + = "llvm_instr_end" +external instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos + = "llvm_instr_pred" + +external instr_opcode : llvalue -> Opcode.t = "llvm_instr_get_opcode" +external icmp_predicate : llvalue -> Icmp.t option = "llvm_instr_icmp_predicate" +external fcmp_predicate : llvalue -> Fcmp.t option = "llvm_instr_fcmp_predicate" +external instr_clone : llvalue -> llvalue = "llvm_instr_clone" + +let rec iter_instrs_range f i e = + if i = e then () else + match i with + | At_end _ -> raise (Invalid_argument "Invalid instruction range.") + | Before i -> + f i; + iter_instrs_range f (instr_succ i) e + +let iter_instrs f bb = + iter_instrs_range f (instr_begin bb) (At_end bb) + +let rec fold_left_instrs_range f init i e = + if i = e then init else + match i with + | At_end _ -> raise (Invalid_argument "Invalid instruction range.") + | Before i -> fold_left_instrs_range f (f init i) (instr_succ i) e + +let fold_left_instrs f init bb = + fold_left_instrs_range f init (instr_begin bb) (At_end bb) + +let rec rev_iter_instrs_range f i e = + if i = e then () else + match i with + | At_start _ -> raise (Invalid_argument "Invalid instruction range.") + | After i -> + f i; + rev_iter_instrs_range f (instr_pred i) e + +let rev_iter_instrs f bb = + rev_iter_instrs_range f (instr_end bb) (At_start bb) + +let rec fold_right_instr_range f i e init = + if i = e then init else + match i with + | At_start _ -> raise (Invalid_argument "Invalid instruction range.") + | After i -> fold_right_instr_range f (instr_pred i) e (f i init) + +let fold_right_instrs f bb init = + fold_right_instr_range f (instr_end bb) (At_start bb) init + + +(*--... Operations on call sites ...........................................--*) +external instruction_call_conv: llvalue -> int + = "llvm_instruction_call_conv" +external set_instruction_call_conv: int -> llvalue -> unit + = "llvm_set_instruction_call_conv" + +external llvm_add_call_site_attr : llvalue -> llattribute -> int -> unit + = "llvm_add_call_site_attr" +external llvm_call_site_attrs : llvalue -> int -> llattribute array + = "llvm_call_site_attrs" +external llvm_remove_enum_call_site_attr : llvalue -> llattrkind -> int -> unit + = "llvm_remove_enum_call_site_attr" +external llvm_remove_string_call_site_attr : llvalue -> string -> int -> unit + = "llvm_remove_string_call_site_attr" + +let add_call_site_attr f a i = + llvm_add_call_site_attr f a (AttrIndex.to_int i) +let call_site_attrs f i = + llvm_call_site_attrs f (AttrIndex.to_int i) +let remove_enum_call_site_attr f k i = + llvm_remove_enum_call_site_attr f k (AttrIndex.to_int i) +let remove_string_call_site_attr f k i = + llvm_remove_string_call_site_attr f k (AttrIndex.to_int i) + +(*--... Operations on call and invoke instructions (only) ..................--*) +external num_arg_operands : llvalue -> int = "llvm_num_arg_operands" +external is_tail_call : llvalue -> bool = "llvm_is_tail_call" +external set_tail_call : bool -> llvalue -> unit = "llvm_set_tail_call" +external get_normal_dest : llvalue -> llbasicblock = "LLVMGetNormalDest" +external get_unwind_dest : llvalue -> llbasicblock = "LLVMGetUnwindDest" + +(*--... Operations on load/store instructions (only) .......................--*) +external is_volatile : llvalue -> bool = "llvm_is_volatile" +external set_volatile : bool -> llvalue -> unit = "llvm_set_volatile" + +(*--... Operations on terminators ..........................................--*) + +let is_terminator llv = + let open ValueKind in + let open Opcode in + match classify_value llv with + | Instruction (Br | IndirectBr | Invoke | Resume | Ret | Switch | Unreachable) + -> true + | _ -> false + +external successor : llvalue -> int -> llbasicblock = "llvm_successor" +external set_successor : llvalue -> int -> llbasicblock -> unit + = "llvm_set_successor" +external num_successors : llvalue -> int = "llvm_num_successors" + +let successors llv = + if not (is_terminator llv) then + raise (Invalid_argument "Llvm.successors can only be used on terminators") + else + Array.init (num_successors llv) (successor llv) + +let iter_successors f llv = + if not (is_terminator llv) then + raise (Invalid_argument "Llvm.iter_successors can only be used on terminators") + else + for i = 0 to num_successors llv - 1 do + f (successor llv i) + done + +let fold_successors f llv z = + if not (is_terminator llv) then + raise (Invalid_argument "Llvm.fold_successors can only be used on terminators") + else + let n = num_successors llv in + let rec aux i acc = + if i >= n then acc + else begin + let llb = successor llv i in + aux (i+1) (f llb acc) + end + in aux 0 z + + +(*--... Operations on branches .............................................--*) +external condition : llvalue -> llvalue = "llvm_condition" +external set_condition : llvalue -> llvalue -> unit + = "llvm_set_condition" +external is_conditional : llvalue -> bool = "llvm_is_conditional" + +let get_branch llv = + if classify_value llv <> ValueKind.Instruction Opcode.Br then + None + else if is_conditional llv then + Some (`Conditional (condition llv, successor llv 0, successor llv 1)) + else + Some (`Unconditional (successor llv 0)) + +(*--... Operations on phi nodes ............................................--*) +external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit + = "llvm_add_incoming" +external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming" + +external delete_instruction : llvalue -> unit = "llvm_delete_instruction" + +(*===-- Instruction builders ----------------------------------------------===*) +external builder : llcontext -> llbuilder = "llvm_builder" +external position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit + = "llvm_position_builder" +external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block" +external insert_into_builder : llvalue -> string -> llbuilder -> unit + = "llvm_insert_into_builder" + +let builder_at context ip = + let b = builder context in + position_builder ip b; + b + +let builder_before context i = builder_at context (Before i) +let builder_at_end context bb = builder_at context (At_end bb) + +let position_before i = position_builder (Before i) +let position_at_end bb = position_builder (At_end bb) + + +(*--... Metadata ...........................................................--*) +external set_current_debug_location : llbuilder -> llvalue -> unit + = "llvm_set_current_debug_location" +external clear_current_debug_location : llbuilder -> unit + = "llvm_clear_current_debug_location" +external current_debug_location : llbuilder -> llvalue option + = "llvm_current_debug_location" +external set_inst_debug_location : llbuilder -> llvalue -> unit + = "llvm_set_inst_debug_location" + + +(*--... Terminators ........................................................--*) +external build_ret_void : llbuilder -> llvalue = "llvm_build_ret_void" +external build_ret : llvalue -> llbuilder -> llvalue = "llvm_build_ret" +external build_aggregate_ret : llvalue array -> llbuilder -> llvalue + = "llvm_build_aggregate_ret" +external build_br : llbasicblock -> llbuilder -> llvalue = "llvm_build_br" +external build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder -> + llvalue = "llvm_build_cond_br" +external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue + = "llvm_build_switch" +external build_malloc : lltype -> string -> llbuilder -> llvalue = + "llvm_build_malloc" +external build_array_malloc : lltype -> llvalue -> string -> llbuilder -> + llvalue = "llvm_build_array_malloc" +external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free" +external add_case : llvalue -> llvalue -> llbasicblock -> unit + = "llvm_add_case" +external switch_default_dest : llvalue -> llbasicblock = + "LLVMGetSwitchDefaultDest" +external build_indirect_br : llvalue -> int -> llbuilder -> llvalue + = "llvm_build_indirect_br" +external add_destination : llvalue -> llbasicblock -> unit + = "llvm_add_destination" +external build_invoke : llvalue -> llvalue array -> llbasicblock -> + llbasicblock -> string -> llbuilder -> llvalue + = "llvm_build_invoke_bc" "llvm_build_invoke_nat" +external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder -> + llvalue = "llvm_build_landingpad" +external is_cleanup : llvalue -> bool = "llvm_is_cleanup" +external set_cleanup : llvalue -> bool -> unit = "llvm_set_cleanup" +external add_clause : llvalue -> llvalue -> unit = "llvm_add_clause" +external build_resume : llvalue -> llbuilder -> llvalue = "llvm_build_resume" +external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable" + +(*--... Arithmetic .........................................................--*) +external build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_add" +external build_nsw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nsw_add" +external build_nuw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_add" +external build_fadd : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_fadd" +external build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_sub" +external build_nsw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nsw_sub" +external build_nuw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_sub" +external build_fsub : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_fsub" +external build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_mul" +external build_nsw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nsw_mul" +external build_nuw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_mul" +external build_fmul : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_fmul" +external build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_udiv" +external build_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_sdiv" +external build_exact_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_exact_sdiv" +external build_fdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_fdiv" +external build_urem : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_urem" +external build_srem : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_srem" +external build_frem : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_frem" +external build_shl : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_shl" +external build_lshr : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_lshr" +external build_ashr : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_ashr" +external build_and : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_and" +external build_or : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_or" +external build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_xor" +external build_neg : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_neg" +external build_nsw_neg : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nsw_neg" +external build_nuw_neg : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_nuw_neg" +external build_fneg : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_fneg" +external build_not : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_not" + +(*--... Memory .............................................................--*) +external build_alloca : lltype -> string -> llbuilder -> llvalue + = "llvm_build_alloca" +external build_array_alloca : lltype -> llvalue -> string -> llbuilder -> + llvalue = "llvm_build_array_alloca" +external build_load : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_load" +external build_store : llvalue -> llvalue -> llbuilder -> llvalue + = "llvm_build_store" +external build_atomicrmw : AtomicRMWBinOp.t -> llvalue -> llvalue -> + AtomicOrdering.t -> bool -> string -> llbuilder -> + llvalue + = "llvm_build_atomicrmw_bytecode" + "llvm_build_atomicrmw_native" +external build_gep : llvalue -> llvalue array -> string -> llbuilder -> llvalue + = "llvm_build_gep" +external build_in_bounds_gep : llvalue -> llvalue array -> string -> + llbuilder -> llvalue = "llvm_build_in_bounds_gep" +external build_struct_gep : llvalue -> int -> string -> llbuilder -> llvalue + = "llvm_build_struct_gep" + +external build_global_string : string -> string -> llbuilder -> llvalue + = "llvm_build_global_string" +external build_global_stringptr : string -> string -> llbuilder -> llvalue + = "llvm_build_global_stringptr" + +(*--... Casts ..............................................................--*) +external build_trunc : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_trunc" +external build_zext : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_zext" +external build_sext : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_sext" +external build_fptoui : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_fptoui" +external build_fptosi : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_fptosi" +external build_uitofp : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_uitofp" +external build_sitofp : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_sitofp" +external build_fptrunc : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_fptrunc" +external build_fpext : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_fpext" +external build_ptrtoint : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_prttoint" +external build_inttoptr : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_inttoptr" +external build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_bitcast" +external build_zext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> + llvalue = "llvm_build_zext_or_bitcast" +external build_sext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> + llvalue = "llvm_build_sext_or_bitcast" +external build_trunc_or_bitcast : llvalue -> lltype -> string -> llbuilder -> + llvalue = "llvm_build_trunc_or_bitcast" +external build_pointercast : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_pointercast" +external build_intcast : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_intcast" +external build_fpcast : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_fpcast" + +(*--... Comparisons ........................................................--*) +external build_icmp : Icmp.t -> llvalue -> llvalue -> string -> + llbuilder -> llvalue = "llvm_build_icmp" +external build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> + llbuilder -> llvalue = "llvm_build_fcmp" + +(*--... Miscellaneous instructions .........................................--*) +external build_phi : (llvalue * llbasicblock) list -> string -> llbuilder -> + llvalue = "llvm_build_phi" +external build_empty_phi : lltype -> string -> llbuilder -> llvalue + = "llvm_build_empty_phi" +external build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue + = "llvm_build_call" +external build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder -> + llvalue = "llvm_build_select" +external build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue + = "llvm_build_va_arg" +external build_extractelement : llvalue -> llvalue -> string -> llbuilder -> + llvalue = "llvm_build_extractelement" +external build_insertelement : llvalue -> llvalue -> llvalue -> string -> + llbuilder -> llvalue = "llvm_build_insertelement" +external build_shufflevector : llvalue -> llvalue -> llvalue -> string -> + llbuilder -> llvalue = "llvm_build_shufflevector" +external build_extractvalue : llvalue -> int -> string -> llbuilder -> llvalue + = "llvm_build_extractvalue" +external build_insertvalue : llvalue -> llvalue -> int -> string -> llbuilder -> + llvalue = "llvm_build_insertvalue" + +external build_is_null : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_is_null" +external build_is_not_null : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_is_not_null" +external build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue + = "llvm_build_ptrdiff" +external build_freeze : llvalue -> string -> llbuilder -> llvalue + = "llvm_build_freeze" + + +(*===-- Memory buffers ----------------------------------------------------===*) + +module MemoryBuffer = struct + external of_file : string -> llmemorybuffer = "llvm_memorybuffer_of_file" + external of_stdin : unit -> llmemorybuffer = "llvm_memorybuffer_of_stdin" + external of_string : ?name:string -> string -> llmemorybuffer + = "llvm_memorybuffer_of_string" + external as_string : llmemorybuffer -> string = "llvm_memorybuffer_as_string" + external dispose : llmemorybuffer -> unit = "llvm_memorybuffer_dispose" +end + + +(*===-- Pass Manager ------------------------------------------------------===*) + +module PassManager = struct + type 'a t + type any = [ `Module | `Function ] + external create : unit -> [ `Module ] t = "llvm_passmanager_create" + external create_function : llmodule -> [ `Function ] t + = "LLVMCreateFunctionPassManager" + external run_module : llmodule -> [ `Module ] t -> bool + = "llvm_passmanager_run_module" + external initialize : [ `Function ] t -> bool = "llvm_passmanager_initialize" + external run_function : llvalue -> [ `Function ] t -> bool + = "llvm_passmanager_run_function" + external finalize : [ `Function ] t -> bool = "llvm_passmanager_finalize" + external dispose : [< any ] t -> unit = "llvm_passmanager_dispose" +end diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm.mli new file mode 100644 index 000000000..04e27438a --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm.mli @@ -0,0 +1,2673 @@ +(*===-- llvm/llvm.mli - LLVM OCaml Interface ------------------------------===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Core API. + + This interface provides an OCaml API for the LLVM intermediate + representation, the classes in the VMCore library. *) + + +(** {6 Abstract types} + + These abstract types correlate directly to the LLVMCore classes. *) + +(** The top-level container for all LLVM global data. See the + [llvm::LLVMContext] class. *) +type llcontext + +(** The top-level container for all other LLVM Intermediate Representation (IR) + objects. See the [llvm::Module] class. *) +type llmodule + +(** Each value in the LLVM IR has a type, an instance of [lltype]. See the + [llvm::Type] class. *) +type lltype + +(** Any value in the LLVM IR. Functions, instructions, global variables, + constants, and much more are all [llvalues]. See the [llvm::Value] class. + This type covers a wide range of subclasses. *) +type llvalue + +(** Used to store users and usees of values. See the [llvm::Use] class. *) +type lluse + +(** A basic block in LLVM IR. See the [llvm::BasicBlock] class. *) +type llbasicblock + +(** Used to generate instructions in the LLVM IR. See the [llvm::LLVMBuilder] + class. *) +type llbuilder + +(** Used to represent attribute kinds. *) +type llattrkind + +(** An attribute in LLVM IR. See the [llvm::Attribute] class. *) +type llattribute + +(** Used to efficiently handle large buffers of read-only binary data. + See the [llvm::MemoryBuffer] class. *) +type llmemorybuffer + +(** The kind id of metadata attached to an instruction. *) +type llmdkind + +(** The kind of an [lltype], the result of [classify_type ty]. See the + [llvm::Type::TypeID] enumeration. *) +module TypeKind : sig + type t = + Void + | Half + | Float + | Double + | X86fp80 + | Fp128 + | Ppc_fp128 + | Label + | Integer + | Function + | Struct + | Array + | Pointer + | Vector + | Metadata + | X86_mmx + | Token +end + +(** The linkage of a global value, accessed with {!linkage} and + {!set_linkage}. See [llvm::GlobalValue::LinkageTypes]. *) +module Linkage : sig + type t = + External + | Available_externally + | Link_once + | Link_once_odr + | Link_once_odr_auto_hide + | Weak + | Weak_odr + | Appending + | Internal + | Private + | Dllimport + | Dllexport + | External_weak + | Ghost + | Common + | Linker_private + | Linker_private_weak +end + +(** The linker visibility of a global value, accessed with {!visibility} and + {!set_visibility}. See [llvm::GlobalValue::VisibilityTypes]. *) +module Visibility : sig + type t = + Default + | Hidden + | Protected +end + +(** The DLL storage class of a global value, accessed with {!dll_storage_class} and + {!set_dll_storage_class}. See [llvm::GlobalValue::DLLStorageClassTypes]. *) +module DLLStorageClass : sig + type t = + | Default + | DLLImport + | DLLExport +end + +(** The following calling convention values may be accessed with + {!function_call_conv} and {!set_function_call_conv}. Calling + conventions are open-ended. *) +module CallConv : sig + val c : int (** [c] is the C calling convention. *) + val fast : int (** [fast] is the calling convention to allow LLVM + maximum optimization opportunities. Use only with + internal linkage. *) + val cold : int (** [cold] is the calling convention for + callee-save. *) + val x86_stdcall : int (** [x86_stdcall] is the familiar stdcall calling + convention from C. *) + val x86_fastcall : int (** [x86_fastcall] is the familiar fastcall calling + convention from C. *) +end + +(** The logical representation of an attribute. *) +module AttrRepr : sig + type t = + | Enum of llattrkind * int64 + | String of string * string +end + +(** The position of an attribute. See [LLVMAttributeIndex]. *) +module AttrIndex : sig + type t = + | Function + | Return + | Param of int +end + +(** The predicate for an integer comparison ([icmp]) instruction. + See the [llvm::ICmpInst::Predicate] enumeration. *) +module Icmp : sig + type t = + | Eq (** Equal *) + | Ne (** Not equal *) + | Ugt (** Unsigned greater than *) + | Uge (** Unsigned greater or equal *) + | Ult (** Unsigned less than *) + | Ule (** Unsigned less or equal *) + | Sgt (** Signed greater than *) + | Sge (** Signed greater or equal *) + | Slt (** Signed less than *) + | Sle (** Signed less or equal *) +end + +(** The predicate for a floating-point comparison ([fcmp]) instruction. + Ordered means that neither operand is a QNAN while unordered means + that either operand may be a QNAN. + See the [llvm::FCmpInst::Predicate] enumeration. *) +module Fcmp : sig + type t = + | False (** Always false *) + | Oeq (** Ordered and equal *) + | Ogt (** Ordered and greater than *) + | Oge (** Ordered and greater or equal *) + | Olt (** Ordered and less than *) + | Ole (** Ordered and less or equal *) + | One (** Ordered and not equal *) + | Ord (** Ordered (no operand is NaN) *) + | Uno (** Unordered (one operand at least is NaN) *) + | Ueq (** Unordered and equal *) + | Ugt (** Unordered and greater than *) + | Uge (** Unordered and greater or equal *) + | Ult (** Unordered and less than *) + | Ule (** Unordered and less or equal *) + | Une (** Unordered and not equal *) + | True (** Always true *) +end + +(** The opcodes for LLVM instructions and constant expressions. *) +module Opcode : sig + type t = + | Invalid (** Not an instruction *) + + | Ret (** Terminator Instructions *) + | Br + | Switch + | IndirectBr + | Invoke + | Invalid2 + | Unreachable + + | Add (** Standard Binary Operators *) + | FAdd + | Sub + | FSub + | Mul + | FMul + | UDiv + | SDiv + | FDiv + | URem + | SRem + | FRem + + | Shl (** Logical Operators *) + | LShr + | AShr + | And + | Or + | Xor + + | Alloca (** Memory Operators *) + | Load + | Store + | GetElementPtr + + | Trunc (** Cast Operators *) + | ZExt + | SExt + | FPToUI + | FPToSI + | UIToFP + | SIToFP + | FPTrunc + | FPExt + | PtrToInt + | IntToPtr + | BitCast + + | ICmp (** Other Operators *) + | FCmp + | PHI + | Call + | Select + | UserOp1 + | UserOp2 + | VAArg + | ExtractElement + | InsertElement + | ShuffleVector + | ExtractValue + | InsertValue + | Fence + | AtomicCmpXchg + | AtomicRMW + | Resume + | LandingPad + | AddrSpaceCast + | CleanupRet + | CatchRet + | CatchPad + | CleanupPad + | CatchSwitch + | FNeg + | CallBr +end + +(** The type of a clause of a [landingpad] instruction. + See [llvm::LandingPadInst::ClauseType]. *) +module LandingPadClauseTy : sig + type t = + | Catch + | Filter +end + +(** The thread local mode of a global value, accessed with {!thread_local_mode} + and {!set_thread_local_mode}. + See [llvm::GlobalVariable::ThreadLocalMode]. *) +module ThreadLocalMode : sig + type t = + | None + | GeneralDynamic + | LocalDynamic + | InitialExec + | LocalExec +end + +(** The ordering of an atomic [load], [store], [cmpxchg], [atomicrmw] or + [fence] instruction. See [llvm::AtomicOrdering]. *) +module AtomicOrdering : sig + type t = + | NotAtomic + | Unordered + | Monotonic + | Invalid (** removed due to API changes *) + | Acquire + | Release + | AcqiureRelease + | SequentiallyConsistent +end + +(** The opcode of an [atomicrmw] instruction. + See [llvm::AtomicRMWInst::BinOp]. *) +module AtomicRMWBinOp : sig + type t = + | Xchg + | Add + | Sub + | And + | Nand + | Or + | Xor + | Max + | Min + | UMax + | UMin +end + +(** The kind of an [llvalue], the result of [classify_value v]. + See the various [LLVMIsA*] functions. *) +module ValueKind : sig + type t = + | NullValue + | Argument + | BasicBlock + | InlineAsm + | MDNode + | MDString + | BlockAddress + | ConstantAggregateZero + | ConstantArray + | ConstantDataArray + | ConstantDataVector + | ConstantExpr + | ConstantFP + | ConstantInt + | ConstantPointerNull + | ConstantStruct + | ConstantVector + | Function + | GlobalAlias + | GlobalIFunc + | GlobalVariable + | UndefValue + | Instruction of Opcode.t +end + +(** The kind of [Diagnostic], the result of [Diagnostic.severity d]. + See [llvm::DiagnosticSeverity]. *) +module DiagnosticSeverity : sig + type t = + | Error + | Warning + | Remark + | Note +end + + +(** {6 Iteration} *) + +(** [Before b] and [At_end a] specify positions from the start of the ['b] list + of [a]. [llpos] is used to specify positions in and for forward iteration + through the various value lists maintained by the LLVM IR. *) +type ('a, 'b) llpos = +| At_end of 'a +| Before of 'b + +(** [After b] and [At_start a] specify positions from the end of the ['b] list + of [a]. [llrev_pos] is used for reverse iteration through the various value + lists maintained by the LLVM IR. *) +type ('a, 'b) llrev_pos = +| At_start of 'a +| After of 'b + + +(** {6 Exceptions} *) + +exception FeatureDisabled of string + +exception IoError of string + + +(** {6 Global configuration} *) + +(** [enable_pretty_stacktraces ()] enables LLVM's built-in stack trace code. + This intercepts the OS's crash signals and prints which component of LLVM + you were in at the time of the crash. *) +val enable_pretty_stacktrace : unit -> unit + +(** [install_fatal_error_handler f] installs [f] as LLVM's fatal error handler. + The handler will receive the reason for termination as a string. After + the handler has been executed, LLVM calls [exit(1)]. *) +val install_fatal_error_handler : (string -> unit) -> unit + +(** [reset_fatal_error_handler ()] resets LLVM's fatal error handler. *) +val reset_fatal_error_handler : unit -> unit + +(** [parse_command_line_options ?overview args] parses [args] using + the LLVM command line parser. Note that the only stable thing about this + function is its signature; you cannot rely on any particular set of command + line arguments being interpreted the same way across LLVM versions. + + See the function [llvm::cl::ParseCommandLineOptions()]. *) +val parse_command_line_options : ?overview:string -> string array -> unit + +(** {6 Context error handling} *) + +module Diagnostic : sig + type t + + (** [description d] returns a textual description of [d]. *) + val description : t -> string + + (** [severity d] returns the severity of [d]. *) + val severity : t -> DiagnosticSeverity.t +end + +(** [set_diagnostic_handler c h] set the diagnostic handler of [c] to [h]. + See the method [llvm::LLVMContext::setDiagnosticHandler]. *) +val set_diagnostic_handler : llcontext -> (Diagnostic.t -> unit) option -> unit + +(** {6 Contexts} *) + +(** [create_context ()] creates a context for storing the "global" state in + LLVM. See the constructor [llvm::LLVMContext]. *) +val create_context : unit -> llcontext + +(** [destroy_context ()] destroys a context. See the destructor + [llvm::LLVMContext::~LLVMContext]. *) +val dispose_context : llcontext -> unit + +(** See the function [LLVMGetGlobalContext]. *) +val global_context : unit -> llcontext + +(** [mdkind_id context name] returns the MDKind ID that corresponds to the + name [name] in the context [context]. See the function + [llvm::LLVMContext::getMDKindID]. *) +val mdkind_id : llcontext -> string -> llmdkind + + +(** {6 Attributes} *) + +(** [UnknownAttribute attr] is raised when a enum attribute name [name] + is not recognized by LLVM. *) +exception UnknownAttribute of string + +(** [enum_attr_kind name] returns the kind of enum attributes named [name]. + May raise [UnknownAttribute]. *) +val enum_attr_kind : string -> llattrkind + +(** [create_enum_attr context value kind] creates an enum attribute + with the supplied [kind] and [value] in [context]; if the value + is not required (as for the majority of attributes), use [0L]. + May raise [UnknownAttribute]. + See the constructor [llvm::Attribute::get]. *) +val create_enum_attr : llcontext -> string -> int64 -> llattribute + +(** [create_string_attr context kind value] creates a string attribute + with the supplied [kind] and [value] in [context]. + See the constructor [llvm::Attribute::get]. *) +val create_string_attr : llcontext -> string -> string -> llattribute + +(** [attr_of_repr context repr] creates an attribute with the supplied + representation [repr] in [context]. *) +val attr_of_repr : llcontext -> AttrRepr.t -> llattribute + +(** [repr_of_attr attr] describes the representation of attribute [attr]. *) +val repr_of_attr : llattribute -> AttrRepr.t + + +(** {6 Modules} *) + +(** [create_module context id] creates a module with the supplied module ID in + the context [context]. Modules are not garbage collected; it is mandatory + to call {!dispose_module} to free memory. See the constructor + [llvm::Module::Module]. *) +val create_module : llcontext -> string -> llmodule + +(** [dispose_module m] destroys a module [m] and all of the IR objects it + contained. All references to subordinate objects are invalidated; + referencing them will invoke undefined behavior. See the destructor + [llvm::Module::~Module]. *) +val dispose_module : llmodule -> unit + +(** [target_triple m] is the target specifier for the module [m], something like + [i686-apple-darwin8]. See the method [llvm::Module::getTargetTriple]. *) +val target_triple: llmodule -> string + +(** [target_triple triple m] changes the target specifier for the module [m] to + the string [triple]. See the method [llvm::Module::setTargetTriple]. *) +val set_target_triple: string -> llmodule -> unit + +(** [data_layout m] is the data layout specifier for the module [m], something + like [e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-...-a0:0:64-f80:128:128]. See the + method [llvm::Module::getDataLayout]. *) +val data_layout: llmodule -> string + +(** [set_data_layout s m] changes the data layout specifier for the module [m] + to the string [s]. See the method [llvm::Module::setDataLayout]. *) +val set_data_layout: string -> llmodule -> unit + +(** [dump_module m] prints the .ll representation of the module [m] to standard + error. See the method [llvm::Module::dump]. *) +val dump_module : llmodule -> unit + +(** [print_module f m] prints the .ll representation of the module [m] + to file [f]. See the method [llvm::Module::print]. *) +val print_module : string -> llmodule -> unit + +(** [string_of_llmodule m] returns the .ll representation of the module [m] + as a string. See the method [llvm::Module::print]. *) +val string_of_llmodule : llmodule -> string + +(** [set_module_inline_asm m asm] sets the inline assembler for the module. See + the method [llvm::Module::setModuleInlineAsm]. *) +val set_module_inline_asm : llmodule -> string -> unit + +(** [module_context m] returns the context of the specified module. + See the method [llvm::Module::getContext] *) +val module_context : llmodule -> llcontext + + +(** {6 Types} *) + +(** [classify_type ty] returns the {!TypeKind.t} corresponding to the type [ty]. + See the method [llvm::Type::getTypeID]. *) +val classify_type : lltype -> TypeKind.t + +(** [type_is_sized ty] returns whether the type has a size or not. + If it doesn't then it is not safe to call the [DataLayout::] methods on it. + *) +val type_is_sized : lltype -> bool + +(** [type_context ty] returns the {!llcontext} corresponding to the type [ty]. + See the method [llvm::Type::getContext]. *) +val type_context : lltype -> llcontext + +(** [dump_type ty] prints the .ll representation of the type [ty] to standard + error. See the method [llvm::Type::dump]. *) +val dump_type : lltype -> unit + +(** [string_of_lltype ty] returns a string describing the type [ty]. *) +val string_of_lltype : lltype -> string + + +(** {7 Operations on integer types} *) + +(** [i1_type c] returns an integer type of bitwidth 1 in the context [c]. See + [llvm::Type::Int1Ty]. *) +val i1_type : llcontext -> lltype + +(** [i8_type c] returns an integer type of bitwidth 8 in the context [c]. See + [llvm::Type::Int8Ty]. *) +val i8_type : llcontext -> lltype + +(** [i16_type c] returns an integer type of bitwidth 16 in the context [c]. See + [llvm::Type::Int16Ty]. *) +val i16_type : llcontext -> lltype + +(** [i32_type c] returns an integer type of bitwidth 32 in the context [c]. See + [llvm::Type::Int32Ty]. *) +val i32_type : llcontext -> lltype + +(** [i64_type c] returns an integer type of bitwidth 64 in the context [c]. See + [llvm::Type::Int64Ty]. *) +val i64_type : llcontext -> lltype + +(** [integer_type c n] returns an integer type of bitwidth [n] in the context + [c]. See the method [llvm::IntegerType::get]. *) +val integer_type : llcontext -> int -> lltype + +(** [integer_bitwidth c ty] returns the number of bits in the integer type [ty] + in the context [c]. See the method [llvm::IntegerType::getBitWidth]. *) +val integer_bitwidth : lltype -> int + + +(** {7 Operations on real types} *) + +(** [float_type c] returns the IEEE 32-bit floating point type in the context + [c]. See [llvm::Type::FloatTy]. *) +val float_type : llcontext -> lltype + +(** [double_type c] returns the IEEE 64-bit floating point type in the context + [c]. See [llvm::Type::DoubleTy]. *) +val double_type : llcontext -> lltype + +(** [x86fp80_type c] returns the x87 80-bit floating point type in the context + [c]. See [llvm::Type::X86_FP80Ty]. *) +val x86fp80_type : llcontext -> lltype + +(** [fp128_type c] returns the IEEE 128-bit floating point type in the context + [c]. See [llvm::Type::FP128Ty]. *) +val fp128_type : llcontext -> lltype + +(** [ppc_fp128_type c] returns the PowerPC 128-bit floating point type in the + context [c]. See [llvm::Type::PPC_FP128Ty]. *) +val ppc_fp128_type : llcontext -> lltype + + +(** {7 Operations on function types} *) + +(** [function_type ret_ty param_tys] returns the function type returning + [ret_ty] and taking [param_tys] as parameters. + See the method [llvm::FunctionType::get]. *) +val function_type : lltype -> lltype array -> lltype + +(** [var_arg_function_type ret_ty param_tys] is just like + [function_type ret_ty param_tys] except that it returns the function type + which also takes a variable number of arguments. + See the method [llvm::FunctionType::get]. *) +val var_arg_function_type : lltype -> lltype array -> lltype + +(** [is_var_arg fty] returns [true] if [fty] is a varargs function type, [false] + otherwise. See the method [llvm::FunctionType::isVarArg]. *) +val is_var_arg : lltype -> bool + +(** [return_type fty] gets the return type of the function type [fty]. + See the method [llvm::FunctionType::getReturnType]. *) +val return_type : lltype -> lltype + +(** [param_types fty] gets the parameter types of the function type [fty]. + See the method [llvm::FunctionType::getParamType]. *) +val param_types : lltype -> lltype array + + +(** {7 Operations on struct types} *) + +(** [struct_type context tys] returns the structure type in the context + [context] containing in the types in the array [tys]. See the method + [llvm::StructType::get]. *) +val struct_type : llcontext -> lltype array -> lltype + +(** [packed_struct_type context ys] returns the packed structure type in the + context [context] containing in the types in the array [tys]. See the method + [llvm::StructType::get]. *) +val packed_struct_type : llcontext -> lltype array -> lltype + +(** [struct_name ty] returns the name of the named structure type [ty], + or None if the structure type is not named *) +val struct_name : lltype -> string option + +(** [named_struct_type context name] returns the named structure type [name] + in the context [context]. + See the method [llvm::StructType::get]. *) +val named_struct_type : llcontext -> string -> lltype + +(** [struct_set_body ty elts ispacked] sets the body of the named struct [ty] + to the [elts] elements. + See the moethd [llvm::StructType::setBody]. *) +val struct_set_body : lltype -> lltype array -> bool -> unit + +(** [struct_element_types sty] returns the constituent types of the struct type + [sty]. See the method [llvm::StructType::getElementType]. *) +val struct_element_types : lltype -> lltype array + +(** [is_packed sty] returns [true] if the structure type [sty] is packed, + [false] otherwise. See the method [llvm::StructType::isPacked]. *) +val is_packed : lltype -> bool + +(** [is_opaque sty] returns [true] if the structure type [sty] is opaque. + [false] otherwise. See the method [llvm::StructType::isOpaque]. *) +val is_opaque : lltype -> bool + +(** [is_literal sty] returns [true] if the structure type [sty] is literal. + [false] otherwise. See the method [llvm::StructType::isLiteral]. *) +val is_literal : lltype -> bool + + +(** {7 Operations on pointer, vector, and array types} *) + +(** [subtypes ty] returns [ty]'s subtypes *) +val subtypes : lltype -> lltype array + +(** [array_type ty n] returns the array type containing [n] elements of type + [ty]. See the method [llvm::ArrayType::get]. *) +val array_type : lltype -> int -> lltype + +(** [pointer_type ty] returns the pointer type referencing objects of type + [ty] in the default address space (0). + See the method [llvm::PointerType::getUnqual]. *) +val pointer_type : lltype -> lltype + +(** [qualified_pointer_type ty as] returns the pointer type referencing objects + of type [ty] in address space [as]. + See the method [llvm::PointerType::get]. *) +val qualified_pointer_type : lltype -> int -> lltype + +(** [vector_type ty n] returns the array type containing [n] elements of the + primitive type [ty]. See the method [llvm::ArrayType::get]. *) +val vector_type : lltype -> int -> lltype + +(** [element_type ty] returns the element type of the pointer, vector, or array + type [ty]. See the method [llvm::SequentialType::get]. *) +val element_type : lltype -> lltype + +(** [element_type aty] returns the element count of the array type [aty]. + See the method [llvm::ArrayType::getNumElements]. *) +val array_length : lltype -> int + +(** [address_space pty] returns the address space qualifier of the pointer type + [pty]. See the method [llvm::PointerType::getAddressSpace]. *) +val address_space : lltype -> int + +(** [element_type ty] returns the element count of the vector type [ty]. + See the method [llvm::VectorType::getNumElements]. *) +val vector_size : lltype -> int + + +(** {7 Operations on other types} *) + +(** [void_type c] creates a type of a function which does not return any + value in the context [c]. See [llvm::Type::VoidTy]. *) +val void_type : llcontext -> lltype + +(** [label_type c] creates a type of a basic block in the context [c]. See + [llvm::Type::LabelTy]. *) +val label_type : llcontext -> lltype + +(** [x86_mmx_type c] returns the x86 64-bit MMX register type in the + context [c]. See [llvm::Type::X86_MMXTy]. *) +val x86_mmx_type : llcontext -> lltype + +(** [type_by_name m name] returns the specified type from the current module + if it exists. + See the method [llvm::Module::getTypeByName] *) +val type_by_name : llmodule -> string -> lltype option + + +(** {6 Values} *) + +(** [type_of v] returns the type of the value [v]. + See the method [llvm::Value::getType]. *) +val type_of : llvalue -> lltype + +(** [classify_value v] returns the kind of the value [v]. *) +val classify_value : llvalue -> ValueKind.t + +(** [value_name v] returns the name of the value [v]. For global values, this is + the symbol name. For instructions and basic blocks, it is the SSA register + name. It is meaningless for constants. + See the method [llvm::Value::getName]. *) +val value_name : llvalue -> string + +(** [set_value_name n v] sets the name of the value [v] to [n]. See the method + [llvm::Value::setName]. *) +val set_value_name : string -> llvalue -> unit + +(** [dump_value v] prints the .ll representation of the value [v] to standard + error. See the method [llvm::Value::dump]. *) +val dump_value : llvalue -> unit + +(** [string_of_llvalue v] returns a string describing the value [v]. *) +val string_of_llvalue : llvalue -> string + +(** [replace_all_uses_with old new] replaces all uses of the value [old] + with the value [new]. See the method [llvm::Value::replaceAllUsesWith]. *) +val replace_all_uses_with : llvalue -> llvalue -> unit + + +(** {6 Uses} *) + +(** [use_begin v] returns the first position in the use list for the value [v]. + [use_begin] and [use_succ] can e used to iterate over the use list in order. + See the method [llvm::Value::use_begin]. *) +val use_begin : llvalue -> lluse option + +(** [use_succ u] returns the use list position succeeding [u]. + See the method [llvm::use_value_iterator::operator++]. *) +val use_succ : lluse -> lluse option + +(** [user u] returns the user of the use [u]. + See the method [llvm::Use::getUser]. *) +val user : lluse -> llvalue + +(** [used_value u] returns the usee of the use [u]. + See the method [llvm::Use::getUsedValue]. *) +val used_value : lluse -> llvalue + +(** [iter_uses f v] applies function [f] to each of the users of the value [v] + in order. Tail recursive. *) +val iter_uses : (lluse -> unit) -> llvalue -> unit + +(** [fold_left_uses f init v] is [f (... (f init u1) ...) uN] where + [u1,...,uN] are the users of the value [v]. Tail recursive. *) +val fold_left_uses : ('a -> lluse -> 'a) -> 'a -> llvalue -> 'a + +(** [fold_right_uses f v init] is [f u1 (... (f uN init) ...)] where + [u1,...,uN] are the users of the value [v]. Not tail recursive. *) +val fold_right_uses : (lluse -> 'a -> 'a) -> llvalue -> 'a -> 'a + + +(** {6 Users} *) + +(** [operand v i] returns the operand at index [i] for the value [v]. See the + method [llvm::User::getOperand]. *) +val operand : llvalue -> int -> llvalue + +(** [operand_use v i] returns the use of the operand at index [i] for the value [v]. See the + method [llvm::User::getOperandUse]. *) +val operand_use : llvalue -> int -> lluse + + +(** [set_operand v i o] sets the operand of the value [v] at the index [i] to + the value [o]. + See the method [llvm::User::setOperand]. *) +val set_operand : llvalue -> int -> llvalue -> unit + +(** [num_operands v] returns the number of operands for the value [v]. + See the method [llvm::User::getNumOperands]. *) +val num_operands : llvalue -> int + + +(** [indices i] returns the indices for the ExtractValue or InsertValue + instruction [i]. + See the [llvm::getIndices] methods. *) +val indices : llvalue -> int array + +(** {7 Operations on constants of (mostly) any type} *) + +(** [is_constant v] returns [true] if the value [v] is a constant, [false] + otherwise. Similar to [llvm::isa]. *) +val is_constant : llvalue -> bool + +(** [const_null ty] returns the constant null (zero) of the type [ty]. + See the method [llvm::Constant::getNullValue]. *) +val const_null : lltype -> llvalue + +(** [const_all_ones ty] returns the constant '-1' of the integer or vector type + [ty]. See the method [llvm::Constant::getAllOnesValue]. *) +val const_all_ones : (*int|vec*)lltype -> llvalue + +(** [const_pointer_null ty] returns the constant null (zero) pointer of the type + [ty]. See the method [llvm::ConstantPointerNull::get]. *) +val const_pointer_null : lltype -> llvalue + +(** [undef ty] returns the undefined value of the type [ty]. + See the method [llvm::UndefValue::get]. *) +val undef : lltype -> llvalue + +(** [is_null v] returns [true] if the value [v] is the null (zero) value. + See the method [llvm::Constant::isNullValue]. *) +val is_null : llvalue -> bool + +(** [is_undef v] returns [true] if the value [v] is an undefined value, [false] + otherwise. Similar to [llvm::isa]. *) +val is_undef : llvalue -> bool + +(** [constexpr_opcode v] returns an [Opcode.t] corresponding to constexpr + value [v], or [Opcode.Invalid] if [v] is not a constexpr. *) +val constexpr_opcode : llvalue -> Opcode.t + + +(** {7 Operations on instructions} *) + +(** [has_metadata i] returns whether or not the instruction [i] has any + metadata attached to it. See the function + [llvm::Instruction::hasMetadata]. *) +val has_metadata : llvalue -> bool + +(** [metadata i kind] optionally returns the metadata associated with the + kind [kind] in the instruction [i] See the function + [llvm::Instruction::getMetadata]. *) +val metadata : llvalue -> llmdkind -> llvalue option + +(** [set_metadata i kind md] sets the metadata [md] of kind [kind] in the + instruction [i]. See the function [llvm::Instruction::setMetadata]. *) +val set_metadata : llvalue -> llmdkind -> llvalue -> unit + +(** [clear_metadata i kind] clears the metadata of kind [kind] in the + instruction [i]. See the function [llvm::Instruction::setMetadata]. *) +val clear_metadata : llvalue -> llmdkind -> unit + + +(** {7 Operations on metadata} *) + +(** [mdstring c s] returns the MDString of the string [s] in the context [c]. + See the method [llvm::MDNode::get]. *) +val mdstring : llcontext -> string -> llvalue + +(** [mdnode c elts] returns the MDNode containing the values [elts] in the + context [c]. + See the method [llvm::MDNode::get]. *) +val mdnode : llcontext -> llvalue array -> llvalue + +(** [mdnull c ] returns a null MDNode in context [c]. *) +val mdnull : llcontext -> llvalue + +(** [get_mdstring v] returns the MDString. + See the method [llvm::MDString::getString] *) +val get_mdstring : llvalue -> string option + +(** [get_mdnode_operands v] returns the operands in the MDNode. *) +(* See the method [llvm::MDNode::getOperand] *) +val get_mdnode_operands : llvalue -> llvalue array + +(** [get_named_metadata m name] returns all the MDNodes belonging to the named + metadata (if any). + See the method [llvm::NamedMDNode::getOperand]. *) +val get_named_metadata : llmodule -> string -> llvalue array + +(** [add_named_metadata_operand m name v] adds [v] as the last operand of + metadata named [name] in module [m]. If the metadata does not exist, + it is created. + See the methods [llvm::Module::getNamedMetadata()] and + [llvm::MDNode::addOperand()]. *) +val add_named_metadata_operand : llmodule -> string -> llvalue -> unit + + +(** {7 Operations on scalar constants} *) + +(** [const_int ty i] returns the integer constant of type [ty] and value [i]. + See the method [llvm::ConstantInt::get]. *) +val const_int : lltype -> int -> llvalue + +(** [const_of_int64 ty i] returns the integer constant of type [ty] and value + [i]. See the method [llvm::ConstantInt::get]. *) +val const_of_int64 : lltype -> Int64.t -> bool -> llvalue + +(** [int64_of_const c] returns the int64 value of the [c] constant integer. + None is returned if this is not an integer constant, or bitwidth exceeds 64. + See the method [llvm::ConstantInt::getSExtValue].*) +val int64_of_const : llvalue -> Int64.t option + +(** [const_int_of_string ty s r] returns the integer constant of type [ty] and + value [s], with the radix [r]. See the method [llvm::ConstantInt::get]. *) +val const_int_of_string : lltype -> string -> int -> llvalue + +(** [const_float ty n] returns the floating point constant of type [ty] and + value [n]. See the method [llvm::ConstantFP::get]. *) +val const_float : lltype -> float -> llvalue + +(** [float_of_const c] returns the float value of the [c] constant float. + None is returned if this is not an float constant. + See the method [llvm::ConstantFP::getDoubleValue].*) +val float_of_const : llvalue -> float option + +(** [const_float_of_string ty s] returns the floating point constant of type + [ty] and value [n]. See the method [llvm::ConstantFP::get]. *) +val const_float_of_string : lltype -> string -> llvalue + +(** {7 Operations on composite constants} *) + +(** [const_string c s] returns the constant [i8] array with the values of the + characters in the string [s] in the context [c]. The array is not + null-terminated (but see {!const_stringz}). This value can in turn be used + as the initializer for a global variable. See the method + [llvm::ConstantArray::get]. *) +val const_string : llcontext -> string -> llvalue + +(** [const_stringz c s] returns the constant [i8] array with the values of the + characters in the string [s] and a null terminator in the context [c]. This + value can in turn be used as the initializer for a global variable. + See the method [llvm::ConstantArray::get]. *) +val const_stringz : llcontext -> string -> llvalue + +(** [const_array ty elts] returns the constant array of type + [array_type ty (Array.length elts)] and containing the values [elts]. + This value can in turn be used as the initializer for a global variable. + See the method [llvm::ConstantArray::get]. *) +val const_array : lltype -> llvalue array -> llvalue + +(** [const_struct context elts] returns the structured constant of type + [struct_type (Array.map type_of elts)] and containing the values [elts] + in the context [context]. This value can in turn be used as the initializer + for a global variable. See the method [llvm::ConstantStruct::getAnon]. *) +val const_struct : llcontext -> llvalue array -> llvalue + +(** [const_named_struct namedty elts] returns the structured constant of type + [namedty] (which must be a named structure type) and containing the values [elts]. + This value can in turn be used as the initializer + for a global variable. See the method [llvm::ConstantStruct::get]. *) +val const_named_struct : lltype -> llvalue array -> llvalue + +(** [const_packed_struct context elts] returns the structured constant of + type {!packed_struct_type} [(Array.map type_of elts)] and containing the + values [elts] in the context [context]. This value can in turn be used as + the initializer for a global variable. See the method + [llvm::ConstantStruct::get]. *) +val const_packed_struct : llcontext -> llvalue array -> llvalue + +(** [const_vector elts] returns the vector constant of type + [vector_type (type_of elts.(0)) (Array.length elts)] and containing the + values [elts]. See the method [llvm::ConstantVector::get]. *) +val const_vector : llvalue array -> llvalue + +(** [string_of_const c] returns [Some str] if [c] is a string constant, + or [None] if this is not a string constant. *) +val string_of_const : llvalue -> string option + +(** [const_element c] returns a constant for a specified index's element. + See the method ConstantDataSequential::getElementAsConstant. *) +val const_element : llvalue -> int -> llvalue + + +(** {7 Constant expressions} *) + +(** [align_of ty] returns the alignof constant for the type [ty]. This is + equivalent to [const_ptrtoint (const_gep (const_null (pointer_type {i8,ty})) + (const_int i32_type 0) (const_int i32_type 1)) i32_type], but considerably + more readable. See the method [llvm::ConstantExpr::getAlignOf]. *) +val align_of : lltype -> llvalue + +(** [size_of ty] returns the sizeof constant for the type [ty]. This is + equivalent to [const_ptrtoint (const_gep (const_null (pointer_type ty)) + (const_int i32_type 1)) i64_type], but considerably more readable. + See the method [llvm::ConstantExpr::getSizeOf]. *) +val size_of : lltype -> llvalue + +(** [const_neg c] returns the arithmetic negation of the constant [c]. + See the method [llvm::ConstantExpr::getNeg]. *) +val const_neg : llvalue -> llvalue + +(** [const_nsw_neg c] returns the arithmetic negation of the constant [c] with + no signed wrapping. The result is undefined if the negation overflows. + See the method [llvm::ConstantExpr::getNSWNeg]. *) +val const_nsw_neg : llvalue -> llvalue + +(** [const_nuw_neg c] returns the arithmetic negation of the constant [c] with + no unsigned wrapping. The result is undefined if the negation overflows. + See the method [llvm::ConstantExpr::getNUWNeg]. *) +val const_nuw_neg : llvalue -> llvalue + +(** [const_fneg c] returns the arithmetic negation of the constant float [c]. + See the method [llvm::ConstantExpr::getFNeg]. *) +val const_fneg : llvalue -> llvalue + +(** [const_not c] returns the bitwise inverse of the constant [c]. + See the method [llvm::ConstantExpr::getNot]. *) +val const_not : llvalue -> llvalue + +(** [const_add c1 c2] returns the constant sum of two constants. + See the method [llvm::ConstantExpr::getAdd]. *) +val const_add : llvalue -> llvalue -> llvalue + +(** [const_nsw_add c1 c2] returns the constant sum of two constants with no + signed wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWAdd]. *) +val const_nsw_add : llvalue -> llvalue -> llvalue + +(** [const_nuw_add c1 c2] returns the constant sum of two constants with no + unsigned wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWAdd]. *) +val const_nuw_add : llvalue -> llvalue -> llvalue + +(** [const_fadd c1 c2] returns the constant sum of two constant floats. + See the method [llvm::ConstantExpr::getFAdd]. *) +val const_fadd : llvalue -> llvalue -> llvalue + +(** [const_sub c1 c2] returns the constant difference, [c1 - c2], of two + constants. See the method [llvm::ConstantExpr::getSub]. *) +val const_sub : llvalue -> llvalue -> llvalue + +(** [const_nsw_sub c1 c2] returns the constant difference of two constants with + no signed wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWSub]. *) +val const_nsw_sub : llvalue -> llvalue -> llvalue + +(** [const_nuw_sub c1 c2] returns the constant difference of two constants with + no unsigned wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWSub]. *) +val const_nuw_sub : llvalue -> llvalue -> llvalue + +(** [const_fsub c1 c2] returns the constant difference, [c1 - c2], of two + constant floats. See the method [llvm::ConstantExpr::getFSub]. *) +val const_fsub : llvalue -> llvalue -> llvalue + +(** [const_mul c1 c2] returns the constant product of two constants. + See the method [llvm::ConstantExpr::getMul]. *) +val const_mul : llvalue -> llvalue -> llvalue + +(** [const_nsw_mul c1 c2] returns the constant product of two constants with + no signed wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWMul]. *) +val const_nsw_mul : llvalue -> llvalue -> llvalue + +(** [const_nuw_mul c1 c2] returns the constant product of two constants with + no unsigned wrapping. The result is undefined if the sum overflows. + See the method [llvm::ConstantExpr::getNSWMul]. *) +val const_nuw_mul : llvalue -> llvalue -> llvalue + +(** [const_fmul c1 c2] returns the constant product of two constants floats. + See the method [llvm::ConstantExpr::getFMul]. *) +val const_fmul : llvalue -> llvalue -> llvalue + +(** [const_udiv c1 c2] returns the constant quotient [c1 / c2] of two unsigned + integer constants. + See the method [llvm::ConstantExpr::getUDiv]. *) +val const_udiv : llvalue -> llvalue -> llvalue + +(** [const_sdiv c1 c2] returns the constant quotient [c1 / c2] of two signed + integer constants. + See the method [llvm::ConstantExpr::getSDiv]. *) +val const_sdiv : llvalue -> llvalue -> llvalue + +(** [const_exact_sdiv c1 c2] returns the constant quotient [c1 / c2] of two + signed integer constants. The result is undefined if the result is rounded + or overflows. See the method [llvm::ConstantExpr::getExactSDiv]. *) +val const_exact_sdiv : llvalue -> llvalue -> llvalue + +(** [const_fdiv c1 c2] returns the constant quotient [c1 / c2] of two floating + point constants. + See the method [llvm::ConstantExpr::getFDiv]. *) +val const_fdiv : llvalue -> llvalue -> llvalue + +(** [const_urem c1 c2] returns the constant remainder [c1 MOD c2] of two + unsigned integer constants. + See the method [llvm::ConstantExpr::getURem]. *) +val const_urem : llvalue -> llvalue -> llvalue + +(** [const_srem c1 c2] returns the constant remainder [c1 MOD c2] of two + signed integer constants. + See the method [llvm::ConstantExpr::getSRem]. *) +val const_srem : llvalue -> llvalue -> llvalue + +(** [const_frem c1 c2] returns the constant remainder [c1 MOD c2] of two + signed floating point constants. + See the method [llvm::ConstantExpr::getFRem]. *) +val const_frem : llvalue -> llvalue -> llvalue + +(** [const_and c1 c2] returns the constant bitwise [AND] of two integer + constants. + See the method [llvm::ConstantExpr::getAnd]. *) +val const_and : llvalue -> llvalue -> llvalue + +(** [const_or c1 c2] returns the constant bitwise [OR] of two integer + constants. + See the method [llvm::ConstantExpr::getOr]. *) +val const_or : llvalue -> llvalue -> llvalue + +(** [const_xor c1 c2] returns the constant bitwise [XOR] of two integer + constants. + See the method [llvm::ConstantExpr::getXor]. *) +val const_xor : llvalue -> llvalue -> llvalue + +(** [const_icmp pred c1 c2] returns the constant comparison of two integer + constants, [c1 pred c2]. + See the method [llvm::ConstantExpr::getICmp]. *) +val const_icmp : Icmp.t -> llvalue -> llvalue -> llvalue + +(** [const_fcmp pred c1 c2] returns the constant comparison of two floating + point constants, [c1 pred c2]. + See the method [llvm::ConstantExpr::getFCmp]. *) +val const_fcmp : Fcmp.t -> llvalue -> llvalue -> llvalue + +(** [const_shl c1 c2] returns the constant integer [c1] left-shifted by the + constant integer [c2]. + See the method [llvm::ConstantExpr::getShl]. *) +val const_shl : llvalue -> llvalue -> llvalue + +(** [const_lshr c1 c2] returns the constant integer [c1] right-shifted by the + constant integer [c2] with zero extension. + See the method [llvm::ConstantExpr::getLShr]. *) +val const_lshr : llvalue -> llvalue -> llvalue + +(** [const_ashr c1 c2] returns the constant integer [c1] right-shifted by the + constant integer [c2] with sign extension. + See the method [llvm::ConstantExpr::getAShr]. *) +val const_ashr : llvalue -> llvalue -> llvalue + +(** [const_gep pc indices] returns the constant [getElementPtr] of [pc] with the + constant integers indices from the array [indices]. + See the method [llvm::ConstantExpr::getGetElementPtr]. *) +val const_gep : llvalue -> llvalue array -> llvalue + +(** [const_in_bounds_gep pc indices] returns the constant [getElementPtr] of [pc] + with the constant integers indices from the array [indices]. + See the method [llvm::ConstantExpr::getInBoundsGetElementPtr]. *) +val const_in_bounds_gep : llvalue -> llvalue array -> llvalue + +(** [const_trunc c ty] returns the constant truncation of integer constant [c] + to the smaller integer type [ty]. + See the method [llvm::ConstantExpr::getTrunc]. *) +val const_trunc : llvalue -> lltype -> llvalue + +(** [const_sext c ty] returns the constant sign extension of integer constant + [c] to the larger integer type [ty]. + See the method [llvm::ConstantExpr::getSExt]. *) +val const_sext : llvalue -> lltype -> llvalue + +(** [const_zext c ty] returns the constant zero extension of integer constant + [c] to the larger integer type [ty]. + See the method [llvm::ConstantExpr::getZExt]. *) +val const_zext : llvalue -> lltype -> llvalue + +(** [const_fptrunc c ty] returns the constant truncation of floating point + constant [c] to the smaller floating point type [ty]. + See the method [llvm::ConstantExpr::getFPTrunc]. *) +val const_fptrunc : llvalue -> lltype -> llvalue + +(** [const_fpext c ty] returns the constant extension of floating point constant + [c] to the larger floating point type [ty]. + See the method [llvm::ConstantExpr::getFPExt]. *) +val const_fpext : llvalue -> lltype -> llvalue + +(** [const_uitofp c ty] returns the constant floating point conversion of + unsigned integer constant [c] to the floating point type [ty]. + See the method [llvm::ConstantExpr::getUIToFP]. *) +val const_uitofp : llvalue -> lltype -> llvalue + +(** [const_sitofp c ty] returns the constant floating point conversion of + signed integer constant [c] to the floating point type [ty]. + See the method [llvm::ConstantExpr::getSIToFP]. *) +val const_sitofp : llvalue -> lltype -> llvalue + +(** [const_fptoui c ty] returns the constant unsigned integer conversion of + floating point constant [c] to integer type [ty]. + See the method [llvm::ConstantExpr::getFPToUI]. *) +val const_fptoui : llvalue -> lltype -> llvalue + +(** [const_fptoui c ty] returns the constant unsigned integer conversion of + floating point constant [c] to integer type [ty]. + See the method [llvm::ConstantExpr::getFPToSI]. *) +val const_fptosi : llvalue -> lltype -> llvalue + +(** [const_ptrtoint c ty] returns the constant integer conversion of + pointer constant [c] to integer type [ty]. + See the method [llvm::ConstantExpr::getPtrToInt]. *) +val const_ptrtoint : llvalue -> lltype -> llvalue + +(** [const_inttoptr c ty] returns the constant pointer conversion of + integer constant [c] to pointer type [ty]. + See the method [llvm::ConstantExpr::getIntToPtr]. *) +val const_inttoptr : llvalue -> lltype -> llvalue + +(** [const_bitcast c ty] returns the constant bitwise conversion of constant [c] + to type [ty] of equal size. + See the method [llvm::ConstantExpr::getBitCast]. *) +val const_bitcast : llvalue -> lltype -> llvalue + +(** [const_zext_or_bitcast c ty] returns a constant zext or bitwise cast + conversion of constant [c] to type [ty]. + See the method [llvm::ConstantExpr::getZExtOrBitCast]. *) +val const_zext_or_bitcast : llvalue -> lltype -> llvalue + +(** [const_sext_or_bitcast c ty] returns a constant sext or bitwise cast + conversion of constant [c] to type [ty]. + See the method [llvm::ConstantExpr::getSExtOrBitCast]. *) +val const_sext_or_bitcast : llvalue -> lltype -> llvalue + +(** [const_trunc_or_bitcast c ty] returns a constant trunc or bitwise cast + conversion of constant [c] to type [ty]. + See the method [llvm::ConstantExpr::getTruncOrBitCast]. *) +val const_trunc_or_bitcast : llvalue -> lltype -> llvalue + +(** [const_pointercast c ty] returns a constant bitcast or a pointer-to-int + cast conversion of constant [c] to type [ty] of equal size. + See the method [llvm::ConstantExpr::getPointerCast]. *) +val const_pointercast : llvalue -> lltype -> llvalue + +(** [const_intcast c ty ~is_signed] returns a constant sext/zext, bitcast, + or trunc for integer -> integer casts of constant [c] to type [ty]. + When converting a narrower value to a wider one, whether sext or zext + will be used is controlled by [is_signed]. + See the method [llvm::ConstantExpr::getIntegerCast]. *) +val const_intcast : llvalue -> lltype -> is_signed:bool -> llvalue + +(** [const_fpcast c ty] returns a constant fpext, bitcast, or fptrunc for fp -> + fp casts of constant [c] to type [ty]. + See the method [llvm::ConstantExpr::getFPCast]. *) +val const_fpcast : llvalue -> lltype -> llvalue + +(** [const_select cond t f] returns the constant conditional which returns value + [t] if the boolean constant [cond] is true and the value [f] otherwise. + See the method [llvm::ConstantExpr::getSelect]. *) +val const_select : llvalue -> llvalue -> llvalue -> llvalue + +(** [const_extractelement vec i] returns the constant [i]th element of + constant vector [vec]. [i] must be a constant [i32] value unsigned less than + the size of the vector. + See the method [llvm::ConstantExpr::getExtractElement]. *) +val const_extractelement : llvalue -> llvalue -> llvalue + +(** [const_insertelement vec v i] returns the constant vector with the same + elements as constant vector [v] but the [i]th element replaced by the + constant [v]. [v] must be a constant value with the type of the vector + elements. [i] must be a constant [i32] value unsigned less than the size + of the vector. + See the method [llvm::ConstantExpr::getInsertElement]. *) +val const_insertelement : llvalue -> llvalue -> llvalue -> llvalue + +(** [const_shufflevector a b mask] returns a constant [shufflevector]. + See the LLVM Language Reference for details on the [shufflevector] + instruction. + See the method [llvm::ConstantExpr::getShuffleVector]. *) +val const_shufflevector : llvalue -> llvalue -> llvalue -> llvalue + +(** [const_extractvalue agg idxs] returns the constant [idxs]th value of + constant aggregate [agg]. Each [idxs] must be less than the size of the + aggregate. See the method [llvm::ConstantExpr::getExtractValue]. *) +val const_extractvalue : llvalue -> int array -> llvalue + +(** [const_insertvalue agg val idxs] inserts the value [val] in the specified + indexs [idxs] in the aggregate [agg]. Each [idxs] must be less than the size + of the aggregate. See the method [llvm::ConstantExpr::getInsertValue]. *) +val const_insertvalue : llvalue -> llvalue -> int array -> llvalue + +(** [const_inline_asm ty asm con side align] inserts a inline assembly string. + See the method [llvm::InlineAsm::get]. *) +val const_inline_asm : lltype -> string -> string -> bool -> bool -> llvalue + +(** [block_address f bb] returns the address of the basic block [bb] in the + function [f]. See the method [llvm::BasicBlock::get]. *) +val block_address : llvalue -> llbasicblock -> llvalue + + +(** {7 Operations on global variables, functions, and aliases (globals)} *) + +(** [global_parent g] is the enclosing module of the global value [g]. + See the method [llvm::GlobalValue::getParent]. *) +val global_parent : llvalue -> llmodule + +(** [is_declaration g] returns [true] if the global value [g] is a declaration + only. Returns [false] otherwise. + See the method [llvm::GlobalValue::isDeclaration]. *) +val is_declaration : llvalue -> bool + +(** [linkage g] returns the linkage of the global value [g]. + See the method [llvm::GlobalValue::getLinkage]. *) +val linkage : llvalue -> Linkage.t + +(** [set_linkage l g] sets the linkage of the global value [g] to [l]. + See the method [llvm::GlobalValue::setLinkage]. *) +val set_linkage : Linkage.t -> llvalue -> unit + +(** [unnamed_addr g] returns [true] if the global value [g] has the unnamed_addr + attribute. Returns [false] otherwise. + See the method [llvm::GlobalValue::getUnnamedAddr]. *) +val unnamed_addr : llvalue -> bool + +(** [set_unnamed_addr b g] if [b] is [true], sets the unnamed_addr attribute of + the global value [g]. Unset it otherwise. + See the method [llvm::GlobalValue::setUnnamedAddr]. *) +val set_unnamed_addr : bool -> llvalue -> unit + +(** [section g] returns the linker section of the global value [g]. + See the method [llvm::GlobalValue::getSection]. *) +val section : llvalue -> string + +(** [set_section s g] sets the linker section of the global value [g] to [s]. + See the method [llvm::GlobalValue::setSection]. *) +val set_section : string -> llvalue -> unit + +(** [visibility g] returns the linker visibility of the global value [g]. + See the method [llvm::GlobalValue::getVisibility]. *) +val visibility : llvalue -> Visibility.t + +(** [set_visibility v g] sets the linker visibility of the global value [g] to + [v]. See the method [llvm::GlobalValue::setVisibility]. *) +val set_visibility : Visibility.t -> llvalue -> unit + +(** [dll_storage_class g] returns the DLL storage class of the global value [g]. + See the method [llvm::GlobalValue::getDLLStorageClass]. *) +val dll_storage_class : llvalue -> DLLStorageClass.t + +(** [set_dll_storage_class v g] sets the DLL storage class of the global value [g] to + [v]. See the method [llvm::GlobalValue::setDLLStorageClass]. *) +val set_dll_storage_class : DLLStorageClass.t -> llvalue -> unit + +(** [alignment g] returns the required alignment of the global value [g]. + See the method [llvm::GlobalValue::getAlignment]. *) +val alignment : llvalue -> int + +(** [set_alignment n g] sets the required alignment of the global value [g] to + [n] bytes. See the method [llvm::GlobalValue::setAlignment]. *) +val set_alignment : int -> llvalue -> unit + + +(** {7 Operations on global variables} *) + +(** [declare_global ty name m] returns a new global variable of type [ty] and + with name [name] in module [m] in the default address space (0). If such a + global variable already exists, it is returned. If the type of the existing + global differs, then a bitcast to [ty] is returned. *) +val declare_global : lltype -> string -> llmodule -> llvalue + +(** [declare_qualified_global ty name addrspace m] returns a new global variable + of type [ty] and with name [name] in module [m] in the address space + [addrspace]. If such a global variable already exists, it is returned. If + the type of the existing global differs, then a bitcast to [ty] is + returned. *) +val declare_qualified_global : lltype -> string -> int -> llmodule -> llvalue + +(** [define_global name init m] returns a new global with name [name] and + initializer [init] in module [m] in the default address space (0). If the + named global already exists, it is renamed. + See the constructor of [llvm::GlobalVariable]. *) +val define_global : string -> llvalue -> llmodule -> llvalue + +(** [define_qualified_global name init addrspace m] returns a new global with + name [name] and initializer [init] in module [m] in the address space + [addrspace]. If the named global already exists, it is renamed. + See the constructor of [llvm::GlobalVariable]. *) +val define_qualified_global : string -> llvalue -> int -> llmodule -> llvalue + +(** [lookup_global name m] returns [Some g] if a global variable with name + [name] exists in module [m]. If no such global exists, returns [None]. + See the [llvm::GlobalVariable] constructor. *) +val lookup_global : string -> llmodule -> llvalue option + +(** [delete_global gv] destroys the global variable [gv]. + See the method [llvm::GlobalVariable::eraseFromParent]. *) +val delete_global : llvalue -> unit + +(** [global_begin m] returns the first position in the global variable list of + the module [m]. [global_begin] and [global_succ] can be used to iterate + over the global list in order. + See the method [llvm::Module::global_begin]. *) +val global_begin : llmodule -> (llmodule, llvalue) llpos + +(** [global_succ gv] returns the global variable list position succeeding + [Before gv]. + See the method [llvm::Module::global_iterator::operator++]. *) +val global_succ : llvalue -> (llmodule, llvalue) llpos + +(** [iter_globals f m] applies function [f] to each of the global variables of + module [m] in order. Tail recursive. *) +val iter_globals : (llvalue -> unit) -> llmodule -> unit + +(** [fold_left_globals f init m] is [f (... (f init g1) ...) gN] where + [g1,...,gN] are the global variables of module [m]. Tail recursive. *) +val fold_left_globals : ('a -> llvalue -> 'a) -> 'a -> llmodule -> 'a + +(** [global_end m] returns the last position in the global variable list of the + module [m]. [global_end] and [global_pred] can be used to iterate over the + global list in reverse. + See the method [llvm::Module::global_end]. *) +val global_end : llmodule -> (llmodule, llvalue) llrev_pos + +(** [global_pred gv] returns the global variable list position preceding + [After gv]. + See the method [llvm::Module::global_iterator::operator--]. *) +val global_pred : llvalue -> (llmodule, llvalue) llrev_pos + +(** [rev_iter_globals f m] applies function [f] to each of the global variables + of module [m] in reverse order. Tail recursive. *) +val rev_iter_globals : (llvalue -> unit) -> llmodule -> unit + +(** [fold_right_globals f m init] is [f g1 (... (f gN init) ...)] where + [g1,...,gN] are the global variables of module [m]. Tail recursive. *) +val fold_right_globals : (llvalue -> 'a -> 'a) -> llmodule -> 'a -> 'a + +(** [is_global_constant gv] returns [true] if the global variabile [gv] is a + constant. Returns [false] otherwise. + See the method [llvm::GlobalVariable::isConstant]. *) +val is_global_constant : llvalue -> bool + +(** [set_global_constant c gv] sets the global variable [gv] to be a constant if + [c] is [true] and not if [c] is [false]. + See the method [llvm::GlobalVariable::setConstant]. *) +val set_global_constant : bool -> llvalue -> unit + +(** [global_initializer gv] returns the initializer for the global variable + [gv]. See the method [llvm::GlobalVariable::getInitializer]. *) +val global_initializer : llvalue -> llvalue + +(** [set_initializer c gv] sets the initializer for the global variable + [gv] to the constant [c]. + See the method [llvm::GlobalVariable::setInitializer]. *) +val set_initializer : llvalue -> llvalue -> unit + +(** [remove_initializer gv] unsets the initializer for the global variable + [gv]. + See the method [llvm::GlobalVariable::setInitializer]. *) +val remove_initializer : llvalue -> unit + +(** [is_thread_local gv] returns [true] if the global variable [gv] is + thread-local and [false] otherwise. + See the method [llvm::GlobalVariable::isThreadLocal]. *) +val is_thread_local : llvalue -> bool + +(** [set_thread_local c gv] sets the global variable [gv] to be thread local if + [c] is [true] and not otherwise. + See the method [llvm::GlobalVariable::setThreadLocal]. *) +val set_thread_local : bool -> llvalue -> unit + +(** [is_thread_local gv] returns the thread local mode of the global + variable [gv]. + See the method [llvm::GlobalVariable::getThreadLocalMode]. *) +val thread_local_mode : llvalue -> ThreadLocalMode.t + +(** [set_thread_local c gv] sets the thread local mode of the global + variable [gv]. + See the method [llvm::GlobalVariable::setThreadLocalMode]. *) +val set_thread_local_mode : ThreadLocalMode.t -> llvalue -> unit + +(** [is_externally_initialized gv] returns [true] if the global + variable [gv] is externally initialized and [false] otherwise. + See the method [llvm::GlobalVariable::isExternallyInitialized]. *) +val is_externally_initialized : llvalue -> bool + +(** [set_externally_initialized c gv] sets the global variable [gv] to be + externally initialized if [c] is [true] and not otherwise. + See the method [llvm::GlobalVariable::setExternallyInitialized]. *) +val set_externally_initialized : bool -> llvalue -> unit + + +(** {7 Operations on aliases} *) + +(** [add_alias m t a n] inserts an alias in the module [m] with the type [t] and + the aliasee [a] with the name [n]. + See the constructor for [llvm::GlobalAlias]. *) +val add_alias : llmodule -> lltype -> llvalue -> string -> llvalue + + +(** {7 Operations on functions} *) + +(** [declare_function name ty m] returns a new function of type [ty] and + with name [name] in module [m]. If such a function already exists, + it is returned. If the type of the existing function differs, then a bitcast + to [ty] is returned. *) +val declare_function : string -> lltype -> llmodule -> llvalue + +(** [define_function name ty m] creates a new function with name [name] and + type [ty] in module [m]. If the named function already exists, it is + renamed. An entry basic block is created in the function. + See the constructor of [llvm::GlobalVariable]. *) +val define_function : string -> lltype -> llmodule -> llvalue + +(** [lookup_function name m] returns [Some f] if a function with name + [name] exists in module [m]. If no such function exists, returns [None]. + See the method [llvm::Module] constructor. *) +val lookup_function : string -> llmodule -> llvalue option + +(** [delete_function f] destroys the function [f]. + See the method [llvm::Function::eraseFromParent]. *) +val delete_function : llvalue -> unit + +(** [function_begin m] returns the first position in the function list of the + module [m]. [function_begin] and [function_succ] can be used to iterate over + the function list in order. + See the method [llvm::Module::begin]. *) +val function_begin : llmodule -> (llmodule, llvalue) llpos + +(** [function_succ gv] returns the function list position succeeding + [Before gv]. + See the method [llvm::Module::iterator::operator++]. *) +val function_succ : llvalue -> (llmodule, llvalue) llpos + +(** [iter_functions f m] applies function [f] to each of the functions of module + [m] in order. Tail recursive. *) +val iter_functions : (llvalue -> unit) -> llmodule -> unit + +(** [fold_left_function f init m] is [f (... (f init f1) ...) fN] where + [f1,...,fN] are the functions of module [m]. Tail recursive. *) +val fold_left_functions : ('a -> llvalue -> 'a) -> 'a -> llmodule -> 'a + +(** [function_end m] returns the last position in the function list of + the module [m]. [function_end] and [function_pred] can be used to iterate + over the function list in reverse. + See the method [llvm::Module::end]. *) +val function_end : llmodule -> (llmodule, llvalue) llrev_pos + +(** [function_pred gv] returns the function list position preceding [After gv]. + See the method [llvm::Module::iterator::operator--]. *) +val function_pred : llvalue -> (llmodule, llvalue) llrev_pos + +(** [rev_iter_functions f fn] applies function [f] to each of the functions of + module [m] in reverse order. Tail recursive. *) +val rev_iter_functions : (llvalue -> unit) -> llmodule -> unit + +(** [fold_right_functions f m init] is [f (... (f init fN) ...) f1] where + [f1,...,fN] are the functions of module [m]. Tail recursive. *) +val fold_right_functions : (llvalue -> 'a -> 'a) -> llmodule -> 'a -> 'a + +(** [is_intrinsic f] returns true if the function [f] is an intrinsic. + See the method [llvm::Function::isIntrinsic]. *) +val is_intrinsic : llvalue -> bool + +(** [function_call_conv f] returns the calling convention of the function [f]. + See the method [llvm::Function::getCallingConv]. *) +val function_call_conv : llvalue -> int + +(** [set_function_call_conv cc f] sets the calling convention of the function + [f] to the calling convention numbered [cc]. + See the method [llvm::Function::setCallingConv]. *) +val set_function_call_conv : int -> llvalue -> unit + +(** [gc f] returns [Some name] if the function [f] has a garbage + collection algorithm specified and [None] otherwise. + See the method [llvm::Function::getGC]. *) +val gc : llvalue -> string option + +(** [set_gc gc f] sets the collection algorithm for the function [f] to + [gc]. See the method [llvm::Function::setGC]. *) +val set_gc : string option -> llvalue -> unit + +(** [add_function_attr f a i] adds attribute [a] to the function [f] + at position [i]. *) +val add_function_attr : llvalue -> llattribute -> AttrIndex.t -> unit + +(** [function_attrs f i] returns the attributes for the function [f] + at position [i]. *) +val function_attrs : llvalue -> AttrIndex.t -> llattribute array + +(** [remove_enum_function_attr f k i] removes enum attribute with kind [k] + from the function [f] at position [i]. *) +val remove_enum_function_attr : llvalue -> llattrkind -> AttrIndex.t -> unit + +(** [remove_string_function_attr f k i] removes string attribute with kind [k] + from the function [f] at position [i]. *) +val remove_string_function_attr : llvalue -> string -> AttrIndex.t -> unit + + +(** {7 Operations on params} *) + +(** [params f] returns the parameters of function [f]. + See the method [llvm::Function::getArgumentList]. *) +val params : llvalue -> llvalue array + +(** [param f n] returns the [n]th parameter of function [f]. + See the method [llvm::Function::getArgumentList]. *) +val param : llvalue -> int -> llvalue + +(** [param_parent p] returns the parent function that owns the parameter. + See the method [llvm::Argument::getParent]. *) +val param_parent : llvalue -> llvalue + +(** [param_begin f] returns the first position in the parameter list of the + function [f]. [param_begin] and [param_succ] can be used to iterate over + the parameter list in order. + See the method [llvm::Function::arg_begin]. *) +val param_begin : llvalue -> (llvalue, llvalue) llpos + +(** [param_succ bb] returns the parameter list position succeeding + [Before bb]. + See the method [llvm::Function::arg_iterator::operator++]. *) +val param_succ : llvalue -> (llvalue, llvalue) llpos + +(** [iter_params f fn] applies function [f] to each of the parameters + of function [fn] in order. Tail recursive. *) +val iter_params : (llvalue -> unit) -> llvalue -> unit + +(** [fold_left_params f init fn] is [f (... (f init b1) ...) bN] where + [b1,...,bN] are the parameters of function [fn]. Tail recursive. *) +val fold_left_params : ('a -> llvalue -> 'a) -> 'a -> llvalue -> 'a + +(** [param_end f] returns the last position in the parameter list of + the function [f]. [param_end] and [param_pred] can be used to iterate + over the parameter list in reverse. + See the method [llvm::Function::arg_end]. *) +val param_end : llvalue -> (llvalue, llvalue) llrev_pos + +(** [param_pred gv] returns the function list position preceding [After gv]. + See the method [llvm::Function::arg_iterator::operator--]. *) +val param_pred : llvalue -> (llvalue, llvalue) llrev_pos + +(** [rev_iter_params f fn] applies function [f] to each of the parameters + of function [fn] in reverse order. Tail recursive. *) +val rev_iter_params : (llvalue -> unit) -> llvalue -> unit + +(** [fold_right_params f fn init] is [f (... (f init bN) ...) b1] where + [b1,...,bN] are the parameters of function [fn]. Tail recursive. *) +val fold_right_params : (llvalue -> 'a -> 'a) -> llvalue -> 'a -> 'a + + +(** {7 Operations on basic blocks} *) + +(** [basic_blocks fn] returns the basic blocks of the function [f]. + See the method [llvm::Function::getBasicBlockList]. *) +val basic_blocks : llvalue -> llbasicblock array + +(** [entry_block fn] returns the entry basic block of the function [f]. + See the method [llvm::Function::getEntryBlock]. *) +val entry_block : llvalue -> llbasicblock + +(** [delete_block bb] deletes the basic block [bb]. + See the method [llvm::BasicBlock::eraseFromParent]. *) +val delete_block : llbasicblock -> unit + +(** [remove_block bb] removes the basic block [bb] from its parent function. + See the method [llvm::BasicBlock::removeFromParent]. *) +val remove_block : llbasicblock -> unit + +(** [move_block_before pos bb] moves the basic block [bb] before [pos]. + See the method [llvm::BasicBlock::moveBefore]. *) +val move_block_before : llbasicblock -> llbasicblock -> unit + +(** [move_block_after pos bb] moves the basic block [bb] after [pos]. + See the method [llvm::BasicBlock::moveAfter]. *) +val move_block_after : llbasicblock -> llbasicblock -> unit + +(** [append_block c name f] creates a new basic block named [name] at the end of + function [f] in the context [c]. + See the constructor of [llvm::BasicBlock]. *) +val append_block : llcontext -> string -> llvalue -> llbasicblock + +(** [insert_block c name bb] creates a new basic block named [name] before the + basic block [bb] in the context [c]. + See the constructor of [llvm::BasicBlock]. *) +val insert_block : llcontext -> string -> llbasicblock -> llbasicblock + +(** [block_parent bb] returns the parent function that owns the basic block. + See the method [llvm::BasicBlock::getParent]. *) +val block_parent : llbasicblock -> llvalue + +(** [block_begin f] returns the first position in the basic block list of the + function [f]. [block_begin] and [block_succ] can be used to iterate over + the basic block list in order. + See the method [llvm::Function::begin]. *) +val block_begin : llvalue -> (llvalue, llbasicblock) llpos + +(** [block_succ bb] returns the basic block list position succeeding + [Before bb]. + See the method [llvm::Function::iterator::operator++]. *) +val block_succ : llbasicblock -> (llvalue, llbasicblock) llpos + +(** [iter_blocks f fn] applies function [f] to each of the basic blocks + of function [fn] in order. Tail recursive. *) +val iter_blocks : (llbasicblock -> unit) -> llvalue -> unit + +(** [fold_left_blocks f init fn] is [f (... (f init b1) ...) bN] where + [b1,...,bN] are the basic blocks of function [fn]. Tail recursive. *) +val fold_left_blocks : ('a -> llbasicblock -> 'a) -> 'a -> llvalue -> 'a + +(** [block_end f] returns the last position in the basic block list of + the function [f]. [block_end] and [block_pred] can be used to iterate + over the basic block list in reverse. + See the method [llvm::Function::end]. *) +val block_end : llvalue -> (llvalue, llbasicblock) llrev_pos + +(** [block_pred bb] returns the basic block list position preceding [After bb]. + See the method [llvm::Function::iterator::operator--]. *) +val block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos + +(** [block_terminator bb] returns the terminator of the basic block [bb]. *) +val block_terminator : llbasicblock -> llvalue option + +(** [rev_iter_blocks f fn] applies function [f] to each of the basic blocks + of function [fn] in reverse order. Tail recursive. *) +val rev_iter_blocks : (llbasicblock -> unit) -> llvalue -> unit + +(** [fold_right_blocks f fn init] is [f (... (f init bN) ...) b1] where + [b1,...,bN] are the basic blocks of function [fn]. Tail recursive. *) +val fold_right_blocks : (llbasicblock -> 'a -> 'a) -> llvalue -> 'a -> 'a + +(** [value_of_block bb] losslessly casts [bb] to an [llvalue]. *) +val value_of_block : llbasicblock -> llvalue + +(** [value_is_block v] returns [true] if the value [v] is a basic block and + [false] otherwise. + Similar to [llvm::isa]. *) +val value_is_block : llvalue -> bool + +(** [block_of_value v] losslessly casts [v] to an [llbasicblock]. *) +val block_of_value : llvalue -> llbasicblock + + +(** {7 Operations on instructions} *) + +(** [instr_parent i] is the enclosing basic block of the instruction [i]. + See the method [llvm::Instruction::getParent]. *) +val instr_parent : llvalue -> llbasicblock + +(** [delete_instruction i] deletes the instruction [i]. + * See the method [llvm::Instruction::eraseFromParent]. *) +val delete_instruction : llvalue -> unit + +(** [instr_begin bb] returns the first position in the instruction list of the + basic block [bb]. [instr_begin] and [instr_succ] can be used to iterate over + the instruction list in order. + See the method [llvm::BasicBlock::begin]. *) +val instr_begin : llbasicblock -> (llbasicblock, llvalue) llpos + +(** [instr_succ i] returns the instruction list position succeeding [Before i]. + See the method [llvm::BasicBlock::iterator::operator++]. *) +val instr_succ : llvalue -> (llbasicblock, llvalue) llpos + +(** [iter_instrs f bb] applies function [f] to each of the instructions of basic + block [bb] in order. Tail recursive. *) +val iter_instrs: (llvalue -> unit) -> llbasicblock -> unit + +(** [fold_left_instrs f init bb] is [f (... (f init g1) ...) gN] where + [g1,...,gN] are the instructions of basic block [bb]. Tail recursive. *) +val fold_left_instrs: ('a -> llvalue -> 'a) -> 'a -> llbasicblock -> 'a + +(** [instr_end bb] returns the last position in the instruction list of the + basic block [bb]. [instr_end] and [instr_pred] can be used to iterate over + the instruction list in reverse. + See the method [llvm::BasicBlock::end]. *) +val instr_end : llbasicblock -> (llbasicblock, llvalue) llrev_pos + +(** [instr_pred i] returns the instruction list position preceding [After i]. + See the method [llvm::BasicBlock::iterator::operator--]. *) +val instr_pred : llvalue -> (llbasicblock, llvalue) llrev_pos + +(** [fold_right_instrs f bb init] is [f (... (f init fN) ...) f1] where + [f1,...,fN] are the instructions of basic block [bb]. Tail recursive. *) +val fold_right_instrs: (llvalue -> 'a -> 'a) -> llbasicblock -> 'a -> 'a + +(** [inst_opcode i] returns the [Opcode.t] corresponding to instruction [i], + or [Opcode.Invalid] if [i] is not an instruction. *) +val instr_opcode : llvalue -> Opcode.t + +(** [icmp_predicate i] returns the [Icmp.t] corresponding to an [icmp] + instruction [i]. *) +val icmp_predicate : llvalue -> Icmp.t option + +(** [fcmp_predicate i] returns the [fcmp.t] corresponding to an [fcmp] + instruction [i]. *) +val fcmp_predicate : llvalue -> Fcmp.t option + +(** [inst_clone i] returns a copy of instruction [i], + The instruction has no parent, and no name. + See the method [llvm::Instruction::clone]. *) +val instr_clone : llvalue -> llvalue + + +(** {7 Operations on call sites} *) + +(** [instruction_call_conv ci] is the calling convention for the call or invoke + instruction [ci], which may be one of the values from the module + {!CallConv}. See the method [llvm::CallInst::getCallingConv] and + [llvm::InvokeInst::getCallingConv]. *) +val instruction_call_conv: llvalue -> int + +(** [set_instruction_call_conv cc ci] sets the calling convention for the call + or invoke instruction [ci] to the integer [cc], which can be one of the + values from the module {!CallConv}. + See the method [llvm::CallInst::setCallingConv] + and [llvm::InvokeInst::setCallingConv]. *) +val set_instruction_call_conv: int -> llvalue -> unit + +(** [add_call_site_attr f a i] adds attribute [a] to the call instruction [ci] + at position [i]. *) +val add_call_site_attr : llvalue -> llattribute -> AttrIndex.t -> unit + +(** [call_site_attr f i] returns the attributes for the call instruction [ci] + at position [i]. *) +val call_site_attrs : llvalue -> AttrIndex.t -> llattribute array + +(** [remove_enum_call_site_attr f k i] removes enum attribute with kind [k] + from the call instruction [ci] at position [i]. *) +val remove_enum_call_site_attr : llvalue -> llattrkind -> AttrIndex.t -> unit + +(** [remove_string_call_site_attr f k i] removes string attribute with kind [k] + from the call instruction [ci] at position [i]. *) +val remove_string_call_site_attr : llvalue -> string -> AttrIndex.t -> unit + + +(** {7 Operations on call and invoke instructions (only)} *) + +(** [num_arg_operands ci] returns the number of arguments for the call or + invoke instruction [ci]. See the method + [llvm::CallInst::getNumArgOperands]. *) +val num_arg_operands : llvalue -> int + +(** [is_tail_call ci] is [true] if the call instruction [ci] is flagged as + eligible for tail call optimization, [false] otherwise. + See the method [llvm::CallInst::isTailCall]. *) +val is_tail_call : llvalue -> bool + +(** [set_tail_call tc ci] flags the call instruction [ci] as eligible for tail + call optimization if [tc] is [true], clears otherwise. + See the method [llvm::CallInst::setTailCall]. *) +val set_tail_call : bool -> llvalue -> unit + +(** [get_normal_dest ii] is the normal destination basic block of an invoke + instruction. See the method [llvm::InvokeInst::getNormalDest()]. *) +val get_normal_dest : llvalue -> llbasicblock + +(** [get_unwind_dest ii] is the unwind destination basic block of an invoke + instruction. See the method [llvm::InvokeInst::getUnwindDest()]. *) +val get_unwind_dest : llvalue -> llbasicblock + + +(** {7 Operations on load/store instructions (only)} *) + +(** [is_volatile i] is [true] if the load or store instruction [i] is marked + as volatile. + See the methods [llvm::LoadInst::isVolatile] and + [llvm::StoreInst::isVolatile]. *) +val is_volatile : llvalue -> bool + +(** [set_volatile v i] marks the load or store instruction [i] as volatile + if [v] is [true], unmarks otherwise. + See the methods [llvm::LoadInst::setVolatile] and + [llvm::StoreInst::setVolatile]. *) +val set_volatile : bool -> llvalue -> unit + +(** {7 Operations on terminators} *) + +(** [is_terminator v] returns true if the instruction [v] is a terminator. *) +val is_terminator : llvalue -> bool + +(** [successor v i] returns the successor at index [i] for the value [v]. + See the method [llvm::Instruction::getSuccessor]. *) +val successor : llvalue -> int -> llbasicblock + +(** [set_successor v i o] sets the successor of the value [v] at the index [i] to + the value [o]. + See the method [llvm::Instruction::setSuccessor]. *) +val set_successor : llvalue -> int -> llbasicblock -> unit + +(** [num_successors v] returns the number of successors for the value [v]. + See the method [llvm::Instruction::getNumSuccessors]. *) +val num_successors : llvalue -> int + +(** [successors v] returns the successors of [v]. *) +val successors : llvalue -> llbasicblock array + +(** [iter_successors f v] applies function f to each successor [v] in order. Tail recursive. *) +val iter_successors : (llbasicblock -> unit) -> llvalue -> unit + +(** [fold_successors f v init] is [f (... (f init vN) ...) v1] where [v1,...,vN] are the successors of [v]. Tail recursive. *) +val fold_successors : (llbasicblock -> 'a -> 'a) -> llvalue -> 'a -> 'a + +(** {7 Operations on branches} *) + +(** [is_conditional v] returns true if the branch instruction [v] is conditional. + See the method [llvm::BranchInst::isConditional]. *) +val is_conditional : llvalue -> bool + +(** [condition v] return the condition of the branch instruction [v]. + See the method [llvm::BranchInst::getCondition]. *) +val condition : llvalue -> llvalue + +(** [set_condition v c] sets the condition of the branch instruction [v] to the value [c]. + See the method [llvm::BranchInst::setCondition]. *) +val set_condition : llvalue -> llvalue -> unit + +(** [get_branch c] returns a description of the branch instruction [c]. *) +val get_branch : llvalue -> + [ `Conditional of llvalue * llbasicblock * llbasicblock + | `Unconditional of llbasicblock ] + option + +(** {7 Operations on phi nodes} *) + +(** [add_incoming (v, bb) pn] adds the value [v] to the phi node [pn] for use + with branches from [bb]. See the method [llvm::PHINode::addIncoming]. *) +val add_incoming : (llvalue * llbasicblock) -> llvalue -> unit + +(** [incoming pn] returns the list of value-block pairs for phi node [pn]. + See the method [llvm::PHINode::getIncomingValue]. *) +val incoming : llvalue -> (llvalue * llbasicblock) list + + + +(** {6 Instruction builders} *) + +(** [builder context] creates an instruction builder with no position in + the context [context]. It is invalid to use this builder until its position + is set with {!position_before} or {!position_at_end}. See the constructor + for [llvm::LLVMBuilder]. *) +val builder : llcontext -> llbuilder + +(** [builder_at ip] creates an instruction builder positioned at [ip]. + See the constructor for [llvm::LLVMBuilder]. *) +val builder_at : llcontext -> (llbasicblock, llvalue) llpos -> llbuilder + +(** [builder_before ins] creates an instruction builder positioned before the + instruction [isn]. See the constructor for [llvm::LLVMBuilder]. *) +val builder_before : llcontext -> llvalue -> llbuilder + +(** [builder_at_end bb] creates an instruction builder positioned at the end of + the basic block [bb]. See the constructor for [llvm::LLVMBuilder]. *) +val builder_at_end : llcontext -> llbasicblock -> llbuilder + +(** [position_builder ip bb] moves the instruction builder [bb] to the position + [ip]. + See the constructor for [llvm::LLVMBuilder]. *) +val position_builder : (llbasicblock, llvalue) llpos -> llbuilder -> unit + +(** [position_before ins b] moves the instruction builder [b] to before the + instruction [isn]. See the method [llvm::LLVMBuilder::SetInsertPoint]. *) +val position_before : llvalue -> llbuilder -> unit + +(** [position_at_end bb b] moves the instruction builder [b] to the end of the + basic block [bb]. See the method [llvm::LLVMBuilder::SetInsertPoint]. *) +val position_at_end : llbasicblock -> llbuilder -> unit + +(** [insertion_block b] returns the basic block that the builder [b] is + positioned to insert into. Raises [Not_Found] if the instruction builder is + uninitialized. + See the method [llvm::LLVMBuilder::GetInsertBlock]. *) +val insertion_block : llbuilder -> llbasicblock + +(** [insert_into_builder i name b] inserts the specified instruction [i] at the + position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::Insert]. *) +val insert_into_builder : llvalue -> string -> llbuilder -> unit + + +(** {7 Metadata} *) + +(** [set_current_debug_location b md] sets the current debug location [md] in + the builder [b]. + See the method [llvm::IRBuilder::SetDebugLocation]. *) +val set_current_debug_location : llbuilder -> llvalue -> unit + +(** [clear_current_debug_location b] clears the current debug location in the + builder [b]. *) +val clear_current_debug_location : llbuilder -> unit + +(** [current_debug_location b] returns the current debug location, or None + if none is currently set. + See the method [llvm::IRBuilder::GetDebugLocation]. *) +val current_debug_location : llbuilder -> llvalue option + +(** [set_inst_debug_location b i] sets the current debug location of the builder + [b] to the instruction [i]. + See the method [llvm::IRBuilder::SetInstDebugLocation]. *) +val set_inst_debug_location : llbuilder -> llvalue -> unit + + +(** {7 Terminators} *) + +(** [build_ret_void b] creates a + [ret void] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateRetVoid]. *) +val build_ret_void : llbuilder -> llvalue + +(** [build_ret v b] creates a + [ret %v] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateRet]. *) +val build_ret : llvalue -> llbuilder -> llvalue + +(** [build_aggregate_ret vs b] creates a + [ret {...} { %v1, %v2, ... } ] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateAggregateRet]. *) +val build_aggregate_ret : llvalue array -> llbuilder -> llvalue + +(** [build_br bb b] creates a + [br %bb] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateBr]. *) +val build_br : llbasicblock -> llbuilder -> llvalue + +(** [build_cond_br cond tbb fbb b] creates a + [br %cond, %tbb, %fbb] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateCondBr]. *) +val build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder -> + llvalue + +(** [build_switch case elsebb count b] creates an empty + [switch %case, %elsebb] + instruction at the position specified by the instruction builder [b] with + space reserved for [count] cases. + See the method [llvm::LLVMBuilder::CreateSwitch]. *) +val build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue + +(** [build_malloc ty name b] creates an [malloc] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::CallInst::CreateMalloc]. *) +val build_malloc : lltype -> string -> llbuilder -> llvalue + +(** [build_array_malloc ty val name b] creates an [array malloc] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::CallInst::CreateArrayMalloc]. *) +val build_array_malloc : lltype -> llvalue -> string -> llbuilder -> llvalue + +(** [build_free p b] creates a [free] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFree]. *) +val build_free : llvalue -> llbuilder -> llvalue + +(** [add_case sw onval bb] causes switch instruction [sw] to branch to [bb] + when its input matches the constant [onval]. + See the method [llvm::SwitchInst::addCase]. **) +val add_case : llvalue -> llvalue -> llbasicblock -> unit + +(** [switch_default_dest sw] returns the default destination of the [switch] + instruction. + See the method [llvm:;SwitchInst::getDefaultDest]. **) +val switch_default_dest : llvalue -> llbasicblock + +(** [build_indirect_br addr count b] creates a + [indirectbr %addr] + instruction at the position specified by the instruction builder [b] with + space reserved for [count] destinations. + See the method [llvm::LLVMBuilder::CreateIndirectBr]. *) +val build_indirect_br : llvalue -> int -> llbuilder -> llvalue + +(** [add_destination br bb] adds the basic block [bb] as a possible branch + location for the indirectbr instruction [br]. + See the method [llvm::IndirectBrInst::addDestination]. **) +val add_destination : llvalue -> llbasicblock -> unit + +(** [build_invoke fn args tobb unwindbb name b] creates an + [%name = invoke %fn(args) to %tobb unwind %unwindbb] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateInvoke]. *) +val build_invoke : llvalue -> llvalue array -> llbasicblock -> + llbasicblock -> string -> llbuilder -> llvalue + +(** [build_landingpad ty persfn numclauses name b] creates an + [landingpad] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateLandingPad]. *) +val build_landingpad : lltype -> llvalue -> int -> string -> llbuilder -> + llvalue + +(** [is_cleanup lp] returns [true] if [landingpad] instruction lp is a cleanup. + See the method [llvm::LandingPadInst::isCleanup]. *) +val is_cleanup : llvalue -> bool + +(** [set_cleanup lp] sets the cleanup flag in the [landingpad]instruction. + See the method [llvm::LandingPadInst::setCleanup]. *) +val set_cleanup : llvalue -> bool -> unit + +(** [add_clause lp clause] adds the clause to the [landingpad]instruction. + See the method [llvm::LandingPadInst::addClause]. *) +val add_clause : llvalue -> llvalue -> unit + +(** [build_resume exn b] builds a [resume exn] instruction + at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateResume] *) +val build_resume : llvalue -> llbuilder -> llvalue + +(** [build_unreachable b] creates an + [unreachable] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateUnwind]. *) +val build_unreachable : llbuilder -> llvalue + + +(** {7 Arithmetic} *) + +(** [build_add x y name b] creates a + [%name = add %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateAdd]. *) +val build_add : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_nsw_add x y name b] creates a + [%name = nsw add %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNSWAdd]. *) +val build_nsw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_nuw_add x y name b] creates a + [%name = nuw add %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNUWAdd]. *) +val build_nuw_add : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_fadd x y name b] creates a + [%name = fadd %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFAdd]. *) +val build_fadd : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_sub x y name b] creates a + [%name = sub %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateSub]. *) +val build_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_nsw_sub x y name b] creates a + [%name = nsw sub %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNSWSub]. *) +val build_nsw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_nuw_sub x y name b] creates a + [%name = nuw sub %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNUWSub]. *) +val build_nuw_sub : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_fsub x y name b] creates a + [%name = fsub %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFSub]. *) +val build_fsub : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_mul x y name b] creates a + [%name = mul %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateMul]. *) +val build_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_nsw_mul x y name b] creates a + [%name = nsw mul %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNSWMul]. *) +val build_nsw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_nuw_mul x y name b] creates a + [%name = nuw mul %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateNUWMul]. *) +val build_nuw_mul : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_fmul x y name b] creates a + [%name = fmul %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFMul]. *) +val build_fmul : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_udiv x y name b] creates a + [%name = udiv %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateUDiv]. *) +val build_udiv : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_sdiv x y name b] creates a + [%name = sdiv %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateSDiv]. *) +val build_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_exact_sdiv x y name b] creates a + [%name = exact sdiv %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateExactSDiv]. *) +val build_exact_sdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_fdiv x y name b] creates a + [%name = fdiv %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFDiv]. *) +val build_fdiv : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_urem x y name b] creates a + [%name = urem %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateURem]. *) +val build_urem : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_SRem x y name b] creates a + [%name = srem %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateSRem]. *) +val build_srem : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_frem x y name b] creates a + [%name = frem %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFRem]. *) +val build_frem : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_shl x y name b] creates a + [%name = shl %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateShl]. *) +val build_shl : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_lshr x y name b] creates a + [%name = lshr %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateLShr]. *) +val build_lshr : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_ashr x y name b] creates a + [%name = ashr %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateAShr]. *) +val build_ashr : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_and x y name b] creates a + [%name = and %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateAnd]. *) +val build_and : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_or x y name b] creates a + [%name = or %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateOr]. *) +val build_or : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_xor x y name b] creates a + [%name = xor %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateXor]. *) +val build_xor : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_neg x name b] creates a + [%name = sub 0, %x] + instruction at the position specified by the instruction builder [b]. + [-0.0] is used for floating point types to compute the correct sign. + See the method [llvm::LLVMBuilder::CreateNeg]. *) +val build_neg : llvalue -> string -> llbuilder -> llvalue + +(** [build_nsw_neg x name b] creates a + [%name = nsw sub 0, %x] + instruction at the position specified by the instruction builder [b]. + [-0.0] is used for floating point types to compute the correct sign. + See the method [llvm::LLVMBuilder::CreateNeg]. *) +val build_nsw_neg : llvalue -> string -> llbuilder -> llvalue + +(** [build_nuw_neg x name b] creates a + [%name = nuw sub 0, %x] + instruction at the position specified by the instruction builder [b]. + [-0.0] is used for floating point types to compute the correct sign. + See the method [llvm::LLVMBuilder::CreateNeg]. *) +val build_nuw_neg : llvalue -> string -> llbuilder -> llvalue + +(** [build_fneg x name b] creates a + [%name = fsub 0, %x] + instruction at the position specified by the instruction builder [b]. + [-0.0] is used for floating point types to compute the correct sign. + See the method [llvm::LLVMBuilder::CreateFNeg]. *) +val build_fneg : llvalue -> string -> llbuilder -> llvalue + +(** [build_xor x name b] creates a + [%name = xor %x, -1] + instruction at the position specified by the instruction builder [b]. + [-1] is the correct "all ones" value for the type of [x]. + See the method [llvm::LLVMBuilder::CreateXor]. *) +val build_not : llvalue -> string -> llbuilder -> llvalue + + +(** {7 Memory} *) + +(** [build_alloca ty name b] creates a + [%name = alloca %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateAlloca]. *) +val build_alloca : lltype -> string -> llbuilder -> llvalue + +(** [build_array_alloca ty n name b] creates a + [%name = alloca %ty, %n] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateAlloca]. *) +val build_array_alloca : lltype -> llvalue -> string -> llbuilder -> + llvalue + +(** [build_load v name b] creates a + [%name = load %v] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateLoad]. *) +val build_load : llvalue -> string -> llbuilder -> llvalue + +(** [build_store v p b] creates a + [store %v, %p] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateStore]. *) +val build_store : llvalue -> llvalue -> llbuilder -> llvalue + +(** [build_atomicrmw op ptr val o st b] creates an [atomicrmw] instruction with + operation [op] performed on pointer [ptr] and value [val] with ordering [o] + and singlethread flag set to [st] at the position specified by + the instruction builder [b]. + See the method [llvm::IRBuilder::CreateAtomicRMW]. *) +val build_atomicrmw : AtomicRMWBinOp.t -> llvalue -> llvalue -> + AtomicOrdering.t -> bool -> string -> llbuilder -> llvalue + +(** [build_gep p indices name b] creates a + [%name = getelementptr %p, indices...] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateGetElementPtr]. *) +val build_gep : llvalue -> llvalue array -> string -> llbuilder -> llvalue + +(** [build_in_bounds_gep p indices name b] creates a + [%name = gelementptr inbounds %p, indices...] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateInBoundsGetElementPtr]. *) +val build_in_bounds_gep : llvalue -> llvalue array -> string -> llbuilder -> + llvalue + +(** [build_struct_gep p idx name b] creates a + [%name = getelementptr %p, 0, idx] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateStructGetElementPtr]. *) +val build_struct_gep : llvalue -> int -> string -> llbuilder -> + llvalue + +(** [build_global_string str name b] creates a series of instructions that adds + a global string at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateGlobalString]. *) +val build_global_string : string -> string -> llbuilder -> llvalue + +(** [build_global_stringptr str name b] creates a series of instructions that + adds a global string pointer at the position specified by the instruction + builder [b]. + See the method [llvm::LLVMBuilder::CreateGlobalStringPtr]. *) +val build_global_stringptr : string -> string -> llbuilder -> llvalue + + +(** {7 Casts} *) + +(** [build_trunc v ty name b] creates a + [%name = trunc %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateTrunc]. *) +val build_trunc : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_zext v ty name b] creates a + [%name = zext %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateZExt]. *) +val build_zext : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_sext v ty name b] creates a + [%name = sext %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateSExt]. *) +val build_sext : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_fptoui v ty name b] creates a + [%name = fptoui %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFPToUI]. *) +val build_fptoui : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_fptosi v ty name b] creates a + [%name = fptosi %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFPToSI]. *) +val build_fptosi : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_uitofp v ty name b] creates a + [%name = uitofp %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateUIToFP]. *) +val build_uitofp : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_sitofp v ty name b] creates a + [%name = sitofp %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateSIToFP]. *) +val build_sitofp : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_fptrunc v ty name b] creates a + [%name = fptrunc %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFPTrunc]. *) +val build_fptrunc : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_fpext v ty name b] creates a + [%name = fpext %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFPExt]. *) +val build_fpext : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_ptrtoint v ty name b] creates a + [%name = prtotint %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreatePtrToInt]. *) +val build_ptrtoint : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_inttoptr v ty name b] creates a + [%name = inttoptr %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateIntToPtr]. *) +val build_inttoptr : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_bitcast v ty name b] creates a + [%name = bitcast %p to %ty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateBitCast]. *) +val build_bitcast : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_zext_or_bitcast v ty name b] creates a zext or bitcast + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateZExtOrBitCast]. *) +val build_zext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> + llvalue + +(** [build_sext_or_bitcast v ty name b] creates a sext or bitcast + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateSExtOrBitCast]. *) +val build_sext_or_bitcast : llvalue -> lltype -> string -> llbuilder -> + llvalue + +(** [build_trunc_or_bitcast v ty name b] creates a trunc or bitcast + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateZExtOrBitCast]. *) +val build_trunc_or_bitcast : llvalue -> lltype -> string -> llbuilder -> + llvalue + +(** [build_pointercast v ty name b] creates a bitcast or pointer-to-int + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreatePointerCast]. *) +val build_pointercast : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_intcast v ty name b] creates a zext, bitcast, or trunc + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateIntCast]. *) +val build_intcast : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_fpcast v ty name b] creates a fpext, bitcast, or fptrunc + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFPCast]. *) +val build_fpcast : llvalue -> lltype -> string -> llbuilder -> llvalue + + +(** {7 Comparisons} *) + +(** [build_icmp pred x y name b] creates a + [%name = icmp %pred %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateICmp]. *) +val build_icmp : Icmp.t -> llvalue -> llvalue -> string -> + llbuilder -> llvalue + +(** [build_fcmp pred x y name b] creates a + [%name = fcmp %pred %x, %y] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFCmp]. *) +val build_fcmp : Fcmp.t -> llvalue -> llvalue -> string -> + llbuilder -> llvalue + + +(** {7 Miscellaneous instructions} *) + +(** [build_phi incoming name b] creates a + [%name = phi %incoming] + instruction at the position specified by the instruction builder [b]. + [incoming] is a list of [(llvalue, llbasicblock)] tuples. + See the method [llvm::LLVMBuilder::CreatePHI]. *) +val build_phi : (llvalue * llbasicblock) list -> string -> llbuilder -> + llvalue + +(** [build_empty_phi ty name b] creates a + [%name = phi %ty] instruction at the position specified by + the instruction builder [b]. [ty] is the type of the instruction. + See the method [llvm::LLVMBuilder::CreatePHI]. *) +val build_empty_phi : lltype -> string -> llbuilder -> llvalue + +(** [build_call fn args name b] creates a + [%name = call %fn(args...)] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateCall]. *) +val build_call : llvalue -> llvalue array -> string -> llbuilder -> llvalue + +(** [build_select cond thenv elsev name b] creates a + [%name = select %cond, %thenv, %elsev] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateSelect]. *) +val build_select : llvalue -> llvalue -> llvalue -> string -> llbuilder -> + llvalue + +(** [build_va_arg valist argty name b] creates a + [%name = va_arg %valist, %argty] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateVAArg]. *) +val build_va_arg : llvalue -> lltype -> string -> llbuilder -> llvalue + +(** [build_extractelement vec i name b] creates a + [%name = extractelement %vec, %i] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateExtractElement]. *) +val build_extractelement : llvalue -> llvalue -> string -> llbuilder -> + llvalue + +(** [build_insertelement vec elt i name b] creates a + [%name = insertelement %vec, %elt, %i] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateInsertElement]. *) +val build_insertelement : llvalue -> llvalue -> llvalue -> string -> + llbuilder -> llvalue + +(** [build_shufflevector veca vecb mask name b] creates a + [%name = shufflevector %veca, %vecb, %mask] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateShuffleVector]. *) +val build_shufflevector : llvalue -> llvalue -> llvalue -> string -> + llbuilder -> llvalue + +(** [build_extractvalue agg idx name b] creates a + [%name = extractvalue %agg, %idx] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateExtractValue]. *) +val build_extractvalue : llvalue -> int -> string -> llbuilder -> llvalue + + +(** [build_insertvalue agg val idx name b] creates a + [%name = insertvalue %agg, %val, %idx] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateInsertValue]. *) +val build_insertvalue : llvalue -> llvalue -> int -> string -> llbuilder -> + llvalue + +(** [build_is_null val name b] creates a + [%name = icmp eq %val, null] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateIsNull]. *) +val build_is_null : llvalue -> string -> llbuilder -> llvalue + +(** [build_is_not_null val name b] creates a + [%name = icmp ne %val, null] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateIsNotNull]. *) +val build_is_not_null : llvalue -> string -> llbuilder -> llvalue + +(** [build_ptrdiff lhs rhs name b] creates a series of instructions that measure + the difference between two pointer values at the position specified by the + instruction builder [b]. + See the method [llvm::LLVMBuilder::CreatePtrDiff]. *) +val build_ptrdiff : llvalue -> llvalue -> string -> llbuilder -> llvalue + +(** [build_freeze x name b] creates a + [%name = freeze %x] + instruction at the position specified by the instruction builder [b]. + See the method [llvm::LLVMBuilder::CreateFreeze]. *) +val build_freeze : llvalue -> string -> llbuilder -> llvalue + + +(** {6 Memory buffers} *) + +module MemoryBuffer : sig + (** [of_file p] is the memory buffer containing the contents of the file at + path [p]. If the file could not be read, then [IoError msg] is + raised. *) + val of_file : string -> llmemorybuffer + + (** [of_stdin ()] is the memory buffer containing the contents of standard input. + If standard input is empty, then [IoError msg] is raised. *) + val of_stdin : unit -> llmemorybuffer + + (** [of_string ~name s] is the memory buffer containing the contents of string [s]. + The name of memory buffer is set to [name] if it is provided. *) + val of_string : ?name:string -> string -> llmemorybuffer + + (** [as_string mb] is the string containing the contents of memory buffer [mb]. *) + val as_string : llmemorybuffer -> string + + (** Disposes of a memory buffer. *) + val dispose : llmemorybuffer -> unit +end + + +(** {6 Pass Managers} *) + +module PassManager : sig + (** *) + type 'a t + type any = [ `Module | `Function ] + + (** [PassManager.create ()] constructs a new whole-module pass pipeline. This + type of pipeline is suitable for link-time optimization and whole-module + transformations. + See the constructor of [llvm::PassManager]. *) + val create : unit -> [ `Module ] t + + (** [PassManager.create_function m] constructs a new function-by-function + pass pipeline over the module [m]. It does not take ownership of [m]. + This type of pipeline is suitable for code generation and JIT compilation + tasks. + See the constructor of [llvm::FunctionPassManager]. *) + val create_function : llmodule -> [ `Function ] t + + (** [run_module m pm] initializes, executes on the module [m], and finalizes + all of the passes scheduled in the pass manager [pm]. Returns [true] if + any of the passes modified the module, [false] otherwise. + See the [llvm::PassManager::run] method. *) + val run_module : llmodule -> [ `Module ] t -> bool + + (** [initialize fpm] initializes all of the function passes scheduled in the + function pass manager [fpm]. Returns [true] if any of the passes modified + the module, [false] otherwise. + See the [llvm::FunctionPassManager::doInitialization] method. *) + val initialize : [ `Function ] t -> bool + + (** [run_function f fpm] executes all of the function passes scheduled in the + function pass manager [fpm] over the function [f]. Returns [true] if any + of the passes modified [f], [false] otherwise. + See the [llvm::FunctionPassManager::run] method. *) + val run_function : llvalue -> [ `Function ] t -> bool + + (** [finalize fpm] finalizes all of the function passes scheduled in the + function pass manager [fpm]. Returns [true] if any of the passes + modified the module, [false] otherwise. + See the [llvm::FunctionPassManager::doFinalization] method. *) + val finalize : [ `Function ] t -> bool + + (** Frees the memory of a pass pipeline. For function pipelines, does not free + the module. + See the destructor of [llvm::BasePassManager]. *) + val dispose : [< any ] t -> unit +end diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm_ocaml.c new file mode 100644 index 000000000..1552abf29 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/llvm/llvm_ocaml.c @@ -0,0 +1,2552 @@ +/*===-- llvm_ocaml.c - LLVM OCaml Glue --------------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include +#include +#include +#include "llvm-c/Core.h" +#include "llvm-c/Support.h" +#include "llvm/Config/llvm-config.h" +#include "caml/alloc.h" +#include "caml/custom.h" +#include "caml/memory.h" +#include "caml/fail.h" +#include "caml/callback.h" + +value llvm_string_of_message(char* Message) { + value String = caml_copy_string(Message); + LLVMDisposeMessage(Message); + + return String; +} + +void llvm_raise(value Prototype, char *Message) { + CAMLparam1(Prototype); + caml_raise_with_arg(Prototype, llvm_string_of_message(Message)); + CAMLnoreturn; +} + +static value llvm_fatal_error_handler; + +static void llvm_fatal_error_trampoline(const char *Reason) { + callback(llvm_fatal_error_handler, caml_copy_string(Reason)); +} + +CAMLprim value llvm_install_fatal_error_handler(value Handler) { + LLVMInstallFatalErrorHandler(llvm_fatal_error_trampoline); + llvm_fatal_error_handler = Handler; + caml_register_global_root(&llvm_fatal_error_handler); + return Val_unit; +} + +CAMLprim value llvm_reset_fatal_error_handler(value Unit) { + caml_remove_global_root(&llvm_fatal_error_handler); + LLVMResetFatalErrorHandler(); + return Val_unit; +} + +CAMLprim value llvm_enable_pretty_stacktrace(value Unit) { + LLVMEnablePrettyStackTrace(); + return Val_unit; +} + +CAMLprim value llvm_parse_command_line_options(value Overview, value Args) { + char *COverview; + if (Overview == Val_int(0)) { + COverview = NULL; + } else { + COverview = String_val(Field(Overview, 0)); + } + LLVMParseCommandLineOptions(Wosize_val(Args), (const char* const*) Op_val(Args), COverview); + return Val_unit; +} + +static value alloc_variant(int tag, void *Value) { + value Iter = alloc_small(1, tag); + Field(Iter, 0) = Val_op(Value); + return Iter; +} + +/* Macro to convert the C first/next/last/prev idiom to the Ocaml llpos/ + llrev_pos idiom. */ +#define DEFINE_ITERATORS(camlname, cname, pty, cty, pfun) \ + /* llmodule -> ('a, 'b) llpos */ \ + CAMLprim value llvm_##camlname##_begin(pty Mom) { \ + cty First = LLVMGetFirst##cname(Mom); \ + if (First) \ + return alloc_variant(1, First); \ + return alloc_variant(0, Mom); \ + } \ + \ + /* llvalue -> ('a, 'b) llpos */ \ + CAMLprim value llvm_##camlname##_succ(cty Kid) { \ + cty Next = LLVMGetNext##cname(Kid); \ + if (Next) \ + return alloc_variant(1, Next); \ + return alloc_variant(0, pfun(Kid)); \ + } \ + \ + /* llmodule -> ('a, 'b) llrev_pos */ \ + CAMLprim value llvm_##camlname##_end(pty Mom) { \ + cty Last = LLVMGetLast##cname(Mom); \ + if (Last) \ + return alloc_variant(1, Last); \ + return alloc_variant(0, Mom); \ + } \ + \ + /* llvalue -> ('a, 'b) llrev_pos */ \ + CAMLprim value llvm_##camlname##_pred(cty Kid) { \ + cty Prev = LLVMGetPrevious##cname(Kid); \ + if (Prev) \ + return alloc_variant(1, Prev); \ + return alloc_variant(0, pfun(Kid)); \ + } + +/*===-- Context error handling --------------------------------------------===*/ + +void llvm_diagnostic_handler_trampoline(LLVMDiagnosticInfoRef DI, + void *DiagnosticContext) { + caml_callback(*((value *)DiagnosticContext), (value)DI); +} + +/* Diagnostic.t -> string */ +CAMLprim value llvm_get_diagnostic_description(value Diagnostic) { + return llvm_string_of_message( + LLVMGetDiagInfoDescription((LLVMDiagnosticInfoRef)Diagnostic)); +} + +/* Diagnostic.t -> DiagnosticSeverity.t */ +CAMLprim value llvm_get_diagnostic_severity(value Diagnostic) { + return Val_int(LLVMGetDiagInfoSeverity((LLVMDiagnosticInfoRef)Diagnostic)); +} + +static void llvm_remove_diagnostic_handler(LLVMContextRef C) { + if (LLVMContextGetDiagnosticHandler(C) == + llvm_diagnostic_handler_trampoline) { + value *Handler = (value *)LLVMContextGetDiagnosticContext(C); + remove_global_root(Handler); + free(Handler); + } +} + +/* llcontext -> (Diagnostic.t -> unit) option -> unit */ +CAMLprim value llvm_set_diagnostic_handler(LLVMContextRef C, value Handler) { + llvm_remove_diagnostic_handler(C); + if (Handler == Val_int(0)) { + LLVMContextSetDiagnosticHandler(C, NULL, NULL); + } else { + value *DiagnosticContext = malloc(sizeof(value)); + if (DiagnosticContext == NULL) + caml_raise_out_of_memory(); + caml_register_global_root(DiagnosticContext); + *DiagnosticContext = Field(Handler, 0); + LLVMContextSetDiagnosticHandler(C, llvm_diagnostic_handler_trampoline, + DiagnosticContext); + } + return Val_unit; +} + +/*===-- Contexts ----------------------------------------------------------===*/ + +/* unit -> llcontext */ +CAMLprim LLVMContextRef llvm_create_context(value Unit) { + return LLVMContextCreate(); +} + +/* llcontext -> unit */ +CAMLprim value llvm_dispose_context(LLVMContextRef C) { + llvm_remove_diagnostic_handler(C); + LLVMContextDispose(C); + return Val_unit; +} + +/* unit -> llcontext */ +CAMLprim LLVMContextRef llvm_global_context(value Unit) { + return LLVMGetGlobalContext(); +} + +/* llcontext -> string -> int */ +CAMLprim value llvm_mdkind_id(LLVMContextRef C, value Name) { + unsigned MDKindID = LLVMGetMDKindIDInContext(C, String_val(Name), + caml_string_length(Name)); + return Val_int(MDKindID); +} + +/*===-- Attributes --------------------------------------------------------===*/ + +/* string -> llattrkind */ +CAMLprim value llvm_enum_attr_kind(value Name) { + unsigned Kind = LLVMGetEnumAttributeKindForName( + String_val(Name), caml_string_length(Name)); + if(Kind == 0) + caml_raise_with_arg(*caml_named_value("Llvm.UnknownAttribute"), Name); + return Val_int(Kind); +} + +/* llcontext -> int -> int64 -> llattribute */ +CAMLprim LLVMAttributeRef +llvm_create_enum_attr_by_kind(LLVMContextRef C, value Kind, value Value) { + return LLVMCreateEnumAttribute(C, Int_val(Kind), Int64_val(Value)); +} + +/* llattribute -> bool */ +CAMLprim value llvm_is_enum_attr(LLVMAttributeRef A) { + return Val_int(LLVMIsEnumAttribute(A)); +} + +/* llattribute -> llattrkind */ +CAMLprim value llvm_get_enum_attr_kind(LLVMAttributeRef A) { + return Val_int(LLVMGetEnumAttributeKind(A)); +} + +/* llattribute -> int64 */ +CAMLprim value llvm_get_enum_attr_value(LLVMAttributeRef A) { + return caml_copy_int64(LLVMGetEnumAttributeValue(A)); +} + +/* llcontext -> kind:string -> name:string -> llattribute */ +CAMLprim LLVMAttributeRef llvm_create_string_attr(LLVMContextRef C, + value Kind, value Value) { + return LLVMCreateStringAttribute(C, + String_val(Kind), caml_string_length(Kind), + String_val(Value), caml_string_length(Value)); +} + +/* llattribute -> bool */ +CAMLprim value llvm_is_string_attr(LLVMAttributeRef A) { + return Val_int(LLVMIsStringAttribute(A)); +} + +/* llattribute -> string */ +CAMLprim value llvm_get_string_attr_kind(LLVMAttributeRef A) { + unsigned Length; + const char *String = LLVMGetStringAttributeKind(A, &Length); + value Result = caml_alloc_string(Length); + memcpy(String_val(Result), String, Length); + return Result; +} + +/* llattribute -> string */ +CAMLprim value llvm_get_string_attr_value(LLVMAttributeRef A) { + unsigned Length; + const char *String = LLVMGetStringAttributeValue(A, &Length); + value Result = caml_alloc_string(Length); + memcpy(String_val(Result), String, Length); + return Result; +} + +/*===-- Modules -----------------------------------------------------------===*/ + +/* llcontext -> string -> llmodule */ +CAMLprim LLVMModuleRef llvm_create_module(LLVMContextRef C, value ModuleID) { + return LLVMModuleCreateWithNameInContext(String_val(ModuleID), C); +} + +/* llmodule -> unit */ +CAMLprim value llvm_dispose_module(LLVMModuleRef M) { + LLVMDisposeModule(M); + return Val_unit; +} + +/* llmodule -> string */ +CAMLprim value llvm_target_triple(LLVMModuleRef M) { + return caml_copy_string(LLVMGetTarget(M)); +} + +/* string -> llmodule -> unit */ +CAMLprim value llvm_set_target_triple(value Trip, LLVMModuleRef M) { + LLVMSetTarget(M, String_val(Trip)); + return Val_unit; +} + +/* llmodule -> string */ +CAMLprim value llvm_data_layout(LLVMModuleRef M) { + return caml_copy_string(LLVMGetDataLayout(M)); +} + +/* string -> llmodule -> unit */ +CAMLprim value llvm_set_data_layout(value Layout, LLVMModuleRef M) { + LLVMSetDataLayout(M, String_val(Layout)); + return Val_unit; +} + +/* llmodule -> unit */ +CAMLprim value llvm_dump_module(LLVMModuleRef M) { + LLVMDumpModule(M); + return Val_unit; +} + +/* string -> llmodule -> unit */ +CAMLprim value llvm_print_module(value Filename, LLVMModuleRef M) { + char* Message; + + if(LLVMPrintModuleToFile(M, String_val(Filename), &Message)) + llvm_raise(*caml_named_value("Llvm.IoError"), Message); + + return Val_unit; +} + +/* llmodule -> string */ +CAMLprim value llvm_string_of_llmodule(LLVMModuleRef M) { + CAMLparam0(); + CAMLlocal1(ModuleStr); + char* ModuleCStr; + + ModuleCStr = LLVMPrintModuleToString(M); + ModuleStr = caml_copy_string(ModuleCStr); + LLVMDisposeMessage(ModuleCStr); + + CAMLreturn(ModuleStr); +} + +/* llmodule -> string -> unit */ +CAMLprim value llvm_set_module_inline_asm(LLVMModuleRef M, value Asm) { + LLVMSetModuleInlineAsm(M, String_val(Asm)); + return Val_unit; +} + +/*===-- Types -------------------------------------------------------------===*/ + +/* lltype -> TypeKind.t */ +CAMLprim value llvm_classify_type(LLVMTypeRef Ty) { + return Val_int(LLVMGetTypeKind(Ty)); +} + +CAMLprim value llvm_type_is_sized(LLVMTypeRef Ty) { + return Val_bool(LLVMTypeIsSized(Ty)); +} + +/* lltype -> llcontext */ +CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) { + return LLVMGetTypeContext(Ty); +} + +/* lltype -> unit */ +CAMLprim value llvm_dump_type(LLVMTypeRef Val) { +#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP) + LLVMDumpType(Val); +#else + caml_raise_with_arg(*caml_named_value("Llvm.FeatureDisabled"), + caml_copy_string("dump")); +#endif + return Val_unit; +} + +/* lltype -> string */ +CAMLprim value llvm_string_of_lltype(LLVMTypeRef M) { + CAMLparam0(); + CAMLlocal1(TypeStr); + char* TypeCStr; + + TypeCStr = LLVMPrintTypeToString(M); + TypeStr = caml_copy_string(TypeCStr); + LLVMDisposeMessage(TypeCStr); + + CAMLreturn(TypeStr); +} + +/*--... Operations on integer types ........................................--*/ + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_i1_type (LLVMContextRef Context) { + return LLVMInt1TypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_i8_type (LLVMContextRef Context) { + return LLVMInt8TypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_i16_type (LLVMContextRef Context) { + return LLVMInt16TypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_i32_type (LLVMContextRef Context) { + return LLVMInt32TypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_i64_type (LLVMContextRef Context) { + return LLVMInt64TypeInContext(Context); +} + +/* llcontext -> int -> lltype */ +CAMLprim LLVMTypeRef llvm_integer_type(LLVMContextRef Context, value Width) { + return LLVMIntTypeInContext(Context, Int_val(Width)); +} + +/* lltype -> int */ +CAMLprim value llvm_integer_bitwidth(LLVMTypeRef IntegerTy) { + return Val_int(LLVMGetIntTypeWidth(IntegerTy)); +} + +/*--... Operations on real types ...........................................--*/ + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_float_type(LLVMContextRef Context) { + return LLVMFloatTypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_double_type(LLVMContextRef Context) { + return LLVMDoubleTypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_x86fp80_type(LLVMContextRef Context) { + return LLVMX86FP80TypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_fp128_type(LLVMContextRef Context) { + return LLVMFP128TypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_ppc_fp128_type(LLVMContextRef Context) { + return LLVMPPCFP128TypeInContext(Context); +} + +/*--... Operations on function types .......................................--*/ + +/* lltype -> lltype array -> lltype */ +CAMLprim LLVMTypeRef llvm_function_type(LLVMTypeRef RetTy, value ParamTys) { + return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys, + Wosize_val(ParamTys), 0); +} + +/* lltype -> lltype array -> lltype */ +CAMLprim LLVMTypeRef llvm_var_arg_function_type(LLVMTypeRef RetTy, + value ParamTys) { + return LLVMFunctionType(RetTy, (LLVMTypeRef *) ParamTys, + Wosize_val(ParamTys), 1); +} + +/* lltype -> bool */ +CAMLprim value llvm_is_var_arg(LLVMTypeRef FunTy) { + return Val_bool(LLVMIsFunctionVarArg(FunTy)); +} + +/* lltype -> lltype array */ +CAMLprim value llvm_param_types(LLVMTypeRef FunTy) { + value Tys = alloc(LLVMCountParamTypes(FunTy), 0); + LLVMGetParamTypes(FunTy, (LLVMTypeRef *) Tys); + return Tys; +} + +/*--... Operations on struct types .........................................--*/ + +/* llcontext -> lltype array -> lltype */ +CAMLprim LLVMTypeRef llvm_struct_type(LLVMContextRef C, value ElementTypes) { + return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes, + Wosize_val(ElementTypes), 0); +} + +/* llcontext -> lltype array -> lltype */ +CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C, + value ElementTypes) { + return LLVMStructTypeInContext(C, (LLVMTypeRef *) ElementTypes, + Wosize_val(ElementTypes), 1); +} + +/* llcontext -> string -> lltype */ +CAMLprim LLVMTypeRef llvm_named_struct_type(LLVMContextRef C, + value Name) { + return LLVMStructCreateNamed(C, String_val(Name)); +} + +CAMLprim value llvm_struct_set_body(LLVMTypeRef Ty, + value ElementTypes, + value Packed) { + LLVMStructSetBody(Ty, (LLVMTypeRef *) ElementTypes, + Wosize_val(ElementTypes), Bool_val(Packed)); + return Val_unit; +} + +/* lltype -> string option */ +CAMLprim value llvm_struct_name(LLVMTypeRef Ty) +{ + CAMLparam0(); + CAMLlocal1(result); + const char *C = LLVMGetStructName(Ty); + if (C) { + result = caml_alloc_small(1, 0); + Store_field(result, 0, caml_copy_string(C)); + CAMLreturn(result); + } + CAMLreturn(Val_int(0)); +} + +/* lltype -> lltype array */ +CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) { + value Tys = alloc(LLVMCountStructElementTypes(StructTy), 0); + LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *) Tys); + return Tys; +} + +/* lltype -> bool */ +CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) { + return Val_bool(LLVMIsPackedStruct(StructTy)); +} + +/* lltype -> bool */ +CAMLprim value llvm_is_opaque(LLVMTypeRef StructTy) { + return Val_bool(LLVMIsOpaqueStruct(StructTy)); +} + +/* lltype -> bool */ +CAMLprim value llvm_is_literal(LLVMTypeRef StructTy) { + return Val_bool(LLVMIsLiteralStruct(StructTy)); +} + +/*--... Operations on array, pointer, and vector types .....................--*/ + +/* lltype -> lltype array */ +CAMLprim value llvm_subtypes(LLVMTypeRef Ty) { + CAMLparam0(); + CAMLlocal1(Arr); + + unsigned Size = LLVMGetNumContainedTypes(Ty); + + Arr = caml_alloc(Size, 0); + + LLVMGetSubtypes(Ty, (LLVMTypeRef *) Arr); + + CAMLreturn(Arr); +} + +/* lltype -> int -> lltype */ +CAMLprim LLVMTypeRef llvm_array_type(LLVMTypeRef ElementTy, value Count) { + return LLVMArrayType(ElementTy, Int_val(Count)); +} + +/* lltype -> lltype */ +CAMLprim LLVMTypeRef llvm_pointer_type(LLVMTypeRef ElementTy) { + return LLVMPointerType(ElementTy, 0); +} + +/* lltype -> int -> lltype */ +CAMLprim LLVMTypeRef llvm_qualified_pointer_type(LLVMTypeRef ElementTy, + value AddressSpace) { + return LLVMPointerType(ElementTy, Int_val(AddressSpace)); +} + +/* lltype -> int -> lltype */ +CAMLprim LLVMTypeRef llvm_vector_type(LLVMTypeRef ElementTy, value Count) { + return LLVMVectorType(ElementTy, Int_val(Count)); +} + +/* lltype -> int */ +CAMLprim value llvm_array_length(LLVMTypeRef ArrayTy) { + return Val_int(LLVMGetArrayLength(ArrayTy)); +} + +/* lltype -> int */ +CAMLprim value llvm_address_space(LLVMTypeRef PtrTy) { + return Val_int(LLVMGetPointerAddressSpace(PtrTy)); +} + +/* lltype -> int */ +CAMLprim value llvm_vector_size(LLVMTypeRef VectorTy) { + return Val_int(LLVMGetVectorSize(VectorTy)); +} + +/*--... Operations on other types ..........................................--*/ + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_void_type (LLVMContextRef Context) { + return LLVMVoidTypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) { + return LLVMLabelTypeInContext(Context); +} + +/* llcontext -> lltype */ +CAMLprim LLVMTypeRef llvm_x86_mmx_type(LLVMContextRef Context) { + return LLVMX86MMXTypeInContext(Context); +} + +CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name) +{ + CAMLparam1(Name); + LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name)); + if (Ty) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) Ty; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/*===-- VALUES ------------------------------------------------------------===*/ + +/* llvalue -> lltype */ +CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) { + return LLVMTypeOf(Val); +} + +/* keep in sync with ValueKind.t */ +enum ValueKind { + NullValue=0, + Argument, + BasicBlock, + InlineAsm, + MDNode, + MDString, + BlockAddress, + ConstantAggregateZero, + ConstantArray, + ConstantDataArray, + ConstantDataVector, + ConstantExpr, + ConstantFP, + ConstantInt, + ConstantPointerNull, + ConstantStruct, + ConstantVector, + Function, + GlobalAlias, + GlobalIFunc, + GlobalVariable, + UndefValue, + Instruction +}; + +/* llvalue -> ValueKind.t */ +#define DEFINE_CASE(Val, Kind) \ + do {if (LLVMIsA##Kind(Val)) CAMLreturn(Val_int(Kind));} while(0) + +CAMLprim value llvm_classify_value(LLVMValueRef Val) { + CAMLparam0(); + CAMLlocal1(result); + if (!Val) + CAMLreturn(Val_int(NullValue)); + if (LLVMIsAConstant(Val)) { + DEFINE_CASE(Val, BlockAddress); + DEFINE_CASE(Val, ConstantAggregateZero); + DEFINE_CASE(Val, ConstantArray); + DEFINE_CASE(Val, ConstantDataArray); + DEFINE_CASE(Val, ConstantDataVector); + DEFINE_CASE(Val, ConstantExpr); + DEFINE_CASE(Val, ConstantFP); + DEFINE_CASE(Val, ConstantInt); + DEFINE_CASE(Val, ConstantPointerNull); + DEFINE_CASE(Val, ConstantStruct); + DEFINE_CASE(Val, ConstantVector); + } + if (LLVMIsAInstruction(Val)) { + result = caml_alloc_small(1, 0); + Store_field(result, 0, Val_int(LLVMGetInstructionOpcode(Val))); + CAMLreturn(result); + } + if (LLVMIsAGlobalValue(Val)) { + DEFINE_CASE(Val, Function); + DEFINE_CASE(Val, GlobalAlias); + DEFINE_CASE(Val, GlobalIFunc); + DEFINE_CASE(Val, GlobalVariable); + } + DEFINE_CASE(Val, Argument); + DEFINE_CASE(Val, BasicBlock); + DEFINE_CASE(Val, InlineAsm); + DEFINE_CASE(Val, MDNode); + DEFINE_CASE(Val, MDString); + DEFINE_CASE(Val, UndefValue); + failwith("Unknown Value class"); +} + +/* llvalue -> string */ +CAMLprim value llvm_value_name(LLVMValueRef Val) { + return caml_copy_string(LLVMGetValueName(Val)); +} + +/* string -> llvalue -> unit */ +CAMLprim value llvm_set_value_name(value Name, LLVMValueRef Val) { + LLVMSetValueName(Val, String_val(Name)); + return Val_unit; +} + +/* llvalue -> unit */ +CAMLprim value llvm_dump_value(LLVMValueRef Val) { + LLVMDumpValue(Val); + return Val_unit; +} + +/* llvalue -> string */ +CAMLprim value llvm_string_of_llvalue(LLVMValueRef M) { + CAMLparam0(); + CAMLlocal1(ValueStr); + char* ValueCStr; + + ValueCStr = LLVMPrintValueToString(M); + ValueStr = caml_copy_string(ValueCStr); + LLVMDisposeMessage(ValueCStr); + + CAMLreturn(ValueStr); +} + +/* llvalue -> llvalue -> unit */ +CAMLprim value llvm_replace_all_uses_with(LLVMValueRef OldVal, + LLVMValueRef NewVal) { + LLVMReplaceAllUsesWith(OldVal, NewVal); + return Val_unit; +} + +/*--... Operations on users ................................................--*/ + +/* llvalue -> int -> llvalue */ +CAMLprim LLVMValueRef llvm_operand(LLVMValueRef V, value I) { + return LLVMGetOperand(V, Int_val(I)); +} + +/* llvalue -> int -> lluse */ +CAMLprim LLVMUseRef llvm_operand_use(LLVMValueRef V, value I) { + return LLVMGetOperandUse(V, Int_val(I)); +} + +/* llvalue -> int -> llvalue -> unit */ +CAMLprim value llvm_set_operand(LLVMValueRef U, value I, LLVMValueRef V) { + LLVMSetOperand(U, Int_val(I), V); + return Val_unit; +} + +/* llvalue -> int */ +CAMLprim value llvm_num_operands(LLVMValueRef V) { + return Val_int(LLVMGetNumOperands(V)); +} + +/* llvalue -> int array */ +CAMLprim value llvm_indices(LLVMValueRef Instr) { + CAMLparam0(); + CAMLlocal1(indices); + unsigned n = LLVMGetNumIndices(Instr); + const unsigned *Indices = LLVMGetIndices(Instr); + indices = caml_alloc(n, 0); + for (unsigned i = 0; i < n; i++) { + Op_val(indices)[i] = Val_int(Indices[i]); + } + CAMLreturn(indices); +} + +/*--... Operations on constants of (mostly) any type .......................--*/ + +/* llvalue -> bool */ +CAMLprim value llvm_is_constant(LLVMValueRef Val) { + return Val_bool(LLVMIsConstant(Val)); +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_null(LLVMValueRef Val) { + return Val_bool(LLVMIsNull(Val)); +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_undef(LLVMValueRef Val) { + return Val_bool(LLVMIsUndef(Val)); +} + +/* llvalue -> Opcode.t */ +CAMLprim value llvm_constexpr_get_opcode(LLVMValueRef Val) { + return LLVMIsAConstantExpr(Val) ? + Val_int(LLVMGetConstOpcode(Val)) : Val_int(0); +} + +/*--... Operations on instructions .........................................--*/ + +/* llvalue -> bool */ +CAMLprim value llvm_has_metadata(LLVMValueRef Val) { + return Val_bool(LLVMHasMetadata(Val)); +} + +/* llvalue -> int -> llvalue option */ +CAMLprim value llvm_metadata(LLVMValueRef Val, value MDKindID) { + CAMLparam1(MDKindID); + LLVMValueRef MD; + if ((MD = LLVMGetMetadata(Val, Int_val(MDKindID)))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) MD; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* llvalue -> int -> llvalue -> unit */ +CAMLprim value llvm_set_metadata(LLVMValueRef Val, value MDKindID, + LLVMValueRef MD) { + LLVMSetMetadata(Val, Int_val(MDKindID), MD); + return Val_unit; +} + +/* llvalue -> int -> unit */ +CAMLprim value llvm_clear_metadata(LLVMValueRef Val, value MDKindID) { + LLVMSetMetadata(Val, Int_val(MDKindID), NULL); + return Val_unit; +} + + +/*--... Operations on metadata .............................................--*/ + +/* llcontext -> string -> llvalue */ +CAMLprim LLVMValueRef llvm_mdstring(LLVMContextRef C, value S) { + return LLVMMDStringInContext(C, String_val(S), caml_string_length(S)); +} + +/* llcontext -> llvalue array -> llvalue */ +CAMLprim LLVMValueRef llvm_mdnode(LLVMContextRef C, value ElementVals) { + return LLVMMDNodeInContext(C, (LLVMValueRef*) Op_val(ElementVals), + Wosize_val(ElementVals)); +} + +/* llcontext -> llvalue */ +CAMLprim LLVMValueRef llvm_mdnull(LLVMContextRef C) { + return NULL; +} + +/* llvalue -> string option */ +CAMLprim value llvm_get_mdstring(LLVMValueRef V) { + CAMLparam0(); + CAMLlocal2(Option, Str); + const char *S; + unsigned Len; + + if ((S = LLVMGetMDString(V, &Len))) { + Str = caml_alloc_string(Len); + memcpy(String_val(Str), S, Len); + Option = alloc(1,0); + Store_field(Option, 0, Str); + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +CAMLprim value llvm_get_mdnode_operands(LLVMValueRef V) { + CAMLparam0(); + CAMLlocal1(Operands); + unsigned int n; + + n = LLVMGetMDNodeNumOperands(V); + Operands = alloc(n, 0); + LLVMGetMDNodeOperands(V, (LLVMValueRef *) Operands); + CAMLreturn(Operands); +} + +/* llmodule -> string -> llvalue array */ +CAMLprim value llvm_get_namedmd(LLVMModuleRef M, value Name) +{ + CAMLparam1(Name); + CAMLlocal1(Nodes); + Nodes = alloc(LLVMGetNamedMetadataNumOperands(M, String_val(Name)), 0); + LLVMGetNamedMetadataOperands(M, String_val(Name), (LLVMValueRef *) Nodes); + CAMLreturn(Nodes); +} + +/* llmodule -> string -> llvalue -> unit */ +CAMLprim value llvm_append_namedmd(LLVMModuleRef M, value Name, LLVMValueRef Val) { + LLVMAddNamedMetadataOperand(M, String_val(Name), Val); + return Val_unit; +} + +/*--... Operations on scalar constants .....................................--*/ + +/* lltype -> int -> llvalue */ +CAMLprim LLVMValueRef llvm_const_int(LLVMTypeRef IntTy, value N) { + return LLVMConstInt(IntTy, (long long) Long_val(N), 1); +} + +/* lltype -> Int64.t -> bool -> llvalue */ +CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N, + value SExt) { + return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt)); +} + +/* llvalue -> Int64.t */ +CAMLprim value llvm_int64_of_const(LLVMValueRef Const) +{ + CAMLparam0(); + if (LLVMIsAConstantInt(Const) && + LLVMGetIntTypeWidth(LLVMTypeOf(Const)) <= 64) { + value Option = alloc(1, 0); + Field(Option, 0) = caml_copy_int64(LLVMConstIntGetSExtValue(Const)); + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* lltype -> string -> int -> llvalue */ +CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S, + value Radix) { + return LLVMConstIntOfStringAndSize(IntTy, String_val(S), caml_string_length(S), + Int_val(Radix)); +} + +/* lltype -> float -> llvalue */ +CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) { + return LLVMConstReal(RealTy, Double_val(N)); +} + + +/* llvalue -> float */ +CAMLprim value llvm_float_of_const(LLVMValueRef Const) +{ + CAMLparam0(); + CAMLlocal1(Option); + LLVMBool LosesInfo; + double Result; + + if (LLVMIsAConstantFP(Const)) { + Result = LLVMConstRealGetDouble(Const, &LosesInfo); + if (LosesInfo) + CAMLreturn(Val_int(0)); + + Option = alloc(1, 0); + Field(Option, 0) = caml_copy_double(Result); + CAMLreturn(Option); + } + + CAMLreturn(Val_int(0)); +} + +/* lltype -> string -> llvalue */ +CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) { + return LLVMConstRealOfStringAndSize(RealTy, String_val(S), + caml_string_length(S)); +} + +/*--... Operations on composite constants ..................................--*/ + +/* llcontext -> string -> llvalue */ +CAMLprim LLVMValueRef llvm_const_string(LLVMContextRef Context, value Str, + value NullTerminate) { + return LLVMConstStringInContext(Context, String_val(Str), string_length(Str), + 1); +} + +/* llcontext -> string -> llvalue */ +CAMLprim LLVMValueRef llvm_const_stringz(LLVMContextRef Context, value Str, + value NullTerminate) { + return LLVMConstStringInContext(Context, String_val(Str), string_length(Str), + 0); +} + +/* lltype -> llvalue array -> llvalue */ +CAMLprim LLVMValueRef llvm_const_array(LLVMTypeRef ElementTy, + value ElementVals) { + return LLVMConstArray(ElementTy, (LLVMValueRef*) Op_val(ElementVals), + Wosize_val(ElementVals)); +} + +/* llcontext -> llvalue array -> llvalue */ +CAMLprim LLVMValueRef llvm_const_struct(LLVMContextRef C, value ElementVals) { + return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals), + Wosize_val(ElementVals), 0); +} + +/* lltype -> llvalue array -> llvalue */ +CAMLprim LLVMValueRef llvm_const_named_struct(LLVMTypeRef Ty, value ElementVals) { + return LLVMConstNamedStruct(Ty, (LLVMValueRef *) Op_val(ElementVals), Wosize_val(ElementVals)); +} + +/* llcontext -> llvalue array -> llvalue */ +CAMLprim LLVMValueRef llvm_const_packed_struct(LLVMContextRef C, + value ElementVals) { + return LLVMConstStructInContext(C, (LLVMValueRef *) Op_val(ElementVals), + Wosize_val(ElementVals), 1); +} + +/* llvalue array -> llvalue */ +CAMLprim LLVMValueRef llvm_const_vector(value ElementVals) { + return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals), + Wosize_val(ElementVals)); +} + +/* llvalue -> string option */ +CAMLprim value llvm_string_of_const(LLVMValueRef Const) { + const char *S; + size_t Len; + CAMLparam0(); + CAMLlocal2(Option, Str); + + if(LLVMIsAConstantDataSequential(Const) && LLVMIsConstantString(Const)) { + S = LLVMGetAsString(Const, &Len); + Str = caml_alloc_string(Len); + memcpy(String_val(Str), S, Len); + + Option = alloc(1, 0); + Field(Option, 0) = Str; + CAMLreturn(Option); + } else { + CAMLreturn(Val_int(0)); + } +} + +/* llvalue -> int -> llvalue */ +CAMLprim LLVMValueRef llvm_const_element(LLVMValueRef Const, value N) { + return LLVMGetElementAsConstant(Const, Int_val(N)); +} + +/*--... Constant expressions ...............................................--*/ + +/* Icmp.t -> llvalue -> llvalue -> llvalue */ +CAMLprim LLVMValueRef llvm_const_icmp(value Pred, + LLVMValueRef LHSConstant, + LLVMValueRef RHSConstant) { + return LLVMConstICmp(Int_val(Pred) + LLVMIntEQ, LHSConstant, RHSConstant); +} + +/* Fcmp.t -> llvalue -> llvalue -> llvalue */ +CAMLprim LLVMValueRef llvm_const_fcmp(value Pred, + LLVMValueRef LHSConstant, + LLVMValueRef RHSConstant) { + return LLVMConstFCmp(Int_val(Pred), LHSConstant, RHSConstant); +} + +/* llvalue -> llvalue array -> llvalue */ +CAMLprim LLVMValueRef llvm_const_gep(LLVMValueRef ConstantVal, value Indices) { + return LLVMConstGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices), + Wosize_val(Indices)); +} + +/* llvalue -> llvalue array -> llvalue */ +CAMLprim LLVMValueRef llvm_const_in_bounds_gep(LLVMValueRef ConstantVal, + value Indices) { + return LLVMConstInBoundsGEP(ConstantVal, (LLVMValueRef*) Op_val(Indices), + Wosize_val(Indices)); +} + +/* llvalue -> lltype -> is_signed:bool -> llvalue */ +CAMLprim LLVMValueRef llvm_const_intcast(LLVMValueRef CV, LLVMTypeRef T, + value IsSigned) { + return LLVMConstIntCast(CV, T, Bool_val(IsSigned)); +} + +/* llvalue -> int array -> llvalue */ +CAMLprim LLVMValueRef llvm_const_extractvalue(LLVMValueRef Aggregate, + value Indices) { + CAMLparam1(Indices); + int size = Wosize_val(Indices); + int i; + LLVMValueRef result; + + unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned)); + for (i = 0; i < size; i++) { + idxs[i] = Int_val(Field(Indices, i)); + } + + result = LLVMConstExtractValue(Aggregate, idxs, size); + free(idxs); + CAMLreturnT(LLVMValueRef, result); +} + +/* llvalue -> llvalue -> int array -> llvalue */ +CAMLprim LLVMValueRef llvm_const_insertvalue(LLVMValueRef Aggregate, + LLVMValueRef Val, value Indices) { + CAMLparam1(Indices); + int size = Wosize_val(Indices); + int i; + LLVMValueRef result; + + unsigned* idxs = (unsigned*)malloc(size * sizeof(unsigned)); + for (i = 0; i < size; i++) { + idxs[i] = Int_val(Field(Indices, i)); + } + + result = LLVMConstInsertValue(Aggregate, Val, idxs, size); + free(idxs); + CAMLreturnT(LLVMValueRef, result); +} + +/* lltype -> string -> string -> bool -> bool -> llvalue */ +CAMLprim LLVMValueRef llvm_const_inline_asm(LLVMTypeRef Ty, value Asm, + value Constraints, value HasSideEffects, + value IsAlignStack) { + return LLVMConstInlineAsm(Ty, String_val(Asm), String_val(Constraints), + Bool_val(HasSideEffects), Bool_val(IsAlignStack)); +} + +/*--... Operations on global variables, functions, and aliases (globals) ...--*/ + +/* llvalue -> bool */ +CAMLprim value llvm_is_declaration(LLVMValueRef Global) { + return Val_bool(LLVMIsDeclaration(Global)); +} + +/* llvalue -> Linkage.t */ +CAMLprim value llvm_linkage(LLVMValueRef Global) { + return Val_int(LLVMGetLinkage(Global)); +} + +/* Linkage.t -> llvalue -> unit */ +CAMLprim value llvm_set_linkage(value Linkage, LLVMValueRef Global) { + LLVMSetLinkage(Global, Int_val(Linkage)); + return Val_unit; +} + +/* llvalue -> bool */ +CAMLprim value llvm_unnamed_addr(LLVMValueRef Global) { + return Val_bool(LLVMHasUnnamedAddr(Global)); +} + +/* bool -> llvalue -> unit */ +CAMLprim value llvm_set_unnamed_addr(value UseUnnamedAddr, LLVMValueRef Global) { + LLVMSetUnnamedAddr(Global, Bool_val(UseUnnamedAddr)); + return Val_unit; +} + +/* llvalue -> string */ +CAMLprim value llvm_section(LLVMValueRef Global) { + return caml_copy_string(LLVMGetSection(Global)); +} + +/* string -> llvalue -> unit */ +CAMLprim value llvm_set_section(value Section, LLVMValueRef Global) { + LLVMSetSection(Global, String_val(Section)); + return Val_unit; +} + +/* llvalue -> Visibility.t */ +CAMLprim value llvm_visibility(LLVMValueRef Global) { + return Val_int(LLVMGetVisibility(Global)); +} + +/* Visibility.t -> llvalue -> unit */ +CAMLprim value llvm_set_visibility(value Viz, LLVMValueRef Global) { + LLVMSetVisibility(Global, Int_val(Viz)); + return Val_unit; +} + +/* llvalue -> DLLStorageClass.t */ +CAMLprim value llvm_dll_storage_class(LLVMValueRef Global) { + return Val_int(LLVMGetDLLStorageClass(Global)); +} + +/* DLLStorageClass.t -> llvalue -> unit */ +CAMLprim value llvm_set_dll_storage_class(value Viz, LLVMValueRef Global) { + LLVMSetDLLStorageClass(Global, Int_val(Viz)); + return Val_unit; +} + +/* llvalue -> int */ +CAMLprim value llvm_alignment(LLVMValueRef Global) { + return Val_int(LLVMGetAlignment(Global)); +} + +/* int -> llvalue -> unit */ +CAMLprim value llvm_set_alignment(value Bytes, LLVMValueRef Global) { + LLVMSetAlignment(Global, Int_val(Bytes)); + return Val_unit; +} + +/*--... Operations on uses .................................................--*/ + +/* llvalue -> lluse option */ +CAMLprim value llvm_use_begin(LLVMValueRef Val) { + CAMLparam0(); + LLVMUseRef First; + if ((First = LLVMGetFirstUse(Val))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) First; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* lluse -> lluse option */ +CAMLprim value llvm_use_succ(LLVMUseRef U) { + CAMLparam0(); + LLVMUseRef Next; + if ((Next = LLVMGetNextUse(U))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) Next; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* lluse -> llvalue */ +CAMLprim LLVMValueRef llvm_user(LLVMUseRef UR) { + return LLVMGetUser(UR); +} + +/* lluse -> llvalue */ +CAMLprim LLVMValueRef llvm_used_value(LLVMUseRef UR) { + return LLVMGetUsedValue(UR); +} + +/*--... Operations on global variables .....................................--*/ + +DEFINE_ITERATORS(global, Global, LLVMModuleRef, LLVMValueRef, + LLVMGetGlobalParent) + +/* lltype -> string -> llmodule -> llvalue */ +CAMLprim LLVMValueRef llvm_declare_global(LLVMTypeRef Ty, value Name, + LLVMModuleRef M) { + LLVMValueRef GlobalVar; + if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) { + if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty) + return LLVMConstBitCast(GlobalVar, LLVMPointerType(Ty, 0)); + return GlobalVar; + } + return LLVMAddGlobal(M, Ty, String_val(Name)); +} + +/* lltype -> string -> int -> llmodule -> llvalue */ +CAMLprim LLVMValueRef llvm_declare_qualified_global(LLVMTypeRef Ty, value Name, + value AddressSpace, + LLVMModuleRef M) { + LLVMValueRef GlobalVar; + if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) { + if (LLVMGetElementType(LLVMTypeOf(GlobalVar)) != Ty) + return LLVMConstBitCast(GlobalVar, + LLVMPointerType(Ty, Int_val(AddressSpace))); + return GlobalVar; + } + return LLVMAddGlobalInAddressSpace(M, Ty, String_val(Name), + Int_val(AddressSpace)); +} + +/* string -> llmodule -> llvalue option */ +CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) { + CAMLparam1(Name); + LLVMValueRef GlobalVar; + if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) GlobalVar; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* string -> llvalue -> llmodule -> llvalue */ +CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer, + LLVMModuleRef M) { + LLVMValueRef GlobalVar = LLVMAddGlobal(M, LLVMTypeOf(Initializer), + String_val(Name)); + LLVMSetInitializer(GlobalVar, Initializer); + return GlobalVar; +} + +/* string -> llvalue -> int -> llmodule -> llvalue */ +CAMLprim LLVMValueRef llvm_define_qualified_global(value Name, + LLVMValueRef Initializer, + value AddressSpace, + LLVMModuleRef M) { + LLVMValueRef GlobalVar = LLVMAddGlobalInAddressSpace(M, + LLVMTypeOf(Initializer), + String_val(Name), + Int_val(AddressSpace)); + LLVMSetInitializer(GlobalVar, Initializer); + return GlobalVar; +} + +/* llvalue -> unit */ +CAMLprim value llvm_delete_global(LLVMValueRef GlobalVar) { + LLVMDeleteGlobal(GlobalVar); + return Val_unit; +} + +/* llvalue -> llvalue -> unit */ +CAMLprim value llvm_set_initializer(LLVMValueRef ConstantVal, + LLVMValueRef GlobalVar) { + LLVMSetInitializer(GlobalVar, ConstantVal); + return Val_unit; +} + +/* llvalue -> unit */ +CAMLprim value llvm_remove_initializer(LLVMValueRef GlobalVar) { + LLVMSetInitializer(GlobalVar, NULL); + return Val_unit; +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_thread_local(LLVMValueRef GlobalVar) { + return Val_bool(LLVMIsThreadLocal(GlobalVar)); +} + +/* bool -> llvalue -> unit */ +CAMLprim value llvm_set_thread_local(value IsThreadLocal, + LLVMValueRef GlobalVar) { + LLVMSetThreadLocal(GlobalVar, Bool_val(IsThreadLocal)); + return Val_unit; +} + +/* llvalue -> ThreadLocalMode.t */ +CAMLprim value llvm_thread_local_mode(LLVMValueRef GlobalVar) { + return Val_int(LLVMGetThreadLocalMode(GlobalVar)); +} + +/* ThreadLocalMode.t -> llvalue -> unit */ +CAMLprim value llvm_set_thread_local_mode(value ThreadLocalMode, + LLVMValueRef GlobalVar) { + LLVMSetThreadLocalMode(GlobalVar, Int_val(ThreadLocalMode)); + return Val_unit; +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_externally_initialized(LLVMValueRef GlobalVar) { + return Val_bool(LLVMIsExternallyInitialized(GlobalVar)); +} + +/* bool -> llvalue -> unit */ +CAMLprim value llvm_set_externally_initialized(value IsExternallyInitialized, + LLVMValueRef GlobalVar) { + LLVMSetExternallyInitialized(GlobalVar, Bool_val(IsExternallyInitialized)); + return Val_unit; +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_global_constant(LLVMValueRef GlobalVar) { + return Val_bool(LLVMIsGlobalConstant(GlobalVar)); +} + +/* bool -> llvalue -> unit */ +CAMLprim value llvm_set_global_constant(value Flag, LLVMValueRef GlobalVar) { + LLVMSetGlobalConstant(GlobalVar, Bool_val(Flag)); + return Val_unit; +} + +/*--... Operations on aliases ..............................................--*/ + +CAMLprim LLVMValueRef llvm_add_alias(LLVMModuleRef M, LLVMTypeRef Ty, + LLVMValueRef Aliasee, value Name) { + return LLVMAddAlias(M, Ty, Aliasee, String_val(Name)); +} + +/*--... Operations on functions ............................................--*/ + +DEFINE_ITERATORS(function, Function, LLVMModuleRef, LLVMValueRef, + LLVMGetGlobalParent) + +/* string -> lltype -> llmodule -> llvalue */ +CAMLprim LLVMValueRef llvm_declare_function(value Name, LLVMTypeRef Ty, + LLVMModuleRef M) { + LLVMValueRef Fn; + if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) { + if (LLVMGetElementType(LLVMTypeOf(Fn)) != Ty) + return LLVMConstBitCast(Fn, LLVMPointerType(Ty, 0)); + return Fn; + } + return LLVMAddFunction(M, String_val(Name), Ty); +} + +/* string -> llmodule -> llvalue option */ +CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) { + CAMLparam1(Name); + LLVMValueRef Fn; + if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) Fn; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* string -> lltype -> llmodule -> llvalue */ +CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty, + LLVMModuleRef M) { + LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty); + LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry"); + return Fn; +} + +/* llvalue -> unit */ +CAMLprim value llvm_delete_function(LLVMValueRef Fn) { + LLVMDeleteFunction(Fn); + return Val_unit; +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_intrinsic(LLVMValueRef Fn) { + return Val_bool(LLVMGetIntrinsicID(Fn)); +} + +/* llvalue -> int */ +CAMLprim value llvm_function_call_conv(LLVMValueRef Fn) { + return Val_int(LLVMGetFunctionCallConv(Fn)); +} + +/* int -> llvalue -> unit */ +CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) { + LLVMSetFunctionCallConv(Fn, Int_val(Id)); + return Val_unit; +} + +/* llvalue -> string option */ +CAMLprim value llvm_gc(LLVMValueRef Fn) { + const char *GC; + CAMLparam0(); + CAMLlocal2(Name, Option); + + if ((GC = LLVMGetGC(Fn))) { + Name = caml_copy_string(GC); + + Option = alloc(1, 0); + Field(Option, 0) = Name; + CAMLreturn(Option); + } else { + CAMLreturn(Val_int(0)); + } +} + +/* string option -> llvalue -> unit */ +CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) { + LLVMSetGC(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0))); + return Val_unit; +} + +/* llvalue -> llattribute -> int -> unit */ +CAMLprim value llvm_add_function_attr(LLVMValueRef F, LLVMAttributeRef A, + value Index) { + LLVMAddAttributeAtIndex(F, Int_val(Index), A); + return Val_unit; +} + +/* llvalue -> int -> llattribute array */ +CAMLprim value llvm_function_attrs(LLVMValueRef F, value Index) { + unsigned Length = LLVMGetAttributeCountAtIndex(F, Int_val(Index)); + value Array = caml_alloc(Length, 0); + LLVMGetAttributesAtIndex(F, Int_val(Index), + (LLVMAttributeRef *) Op_val(Array)); + return Array; +} + +/* llvalue -> llattrkind -> int -> unit */ +CAMLprim value llvm_remove_enum_function_attr(LLVMValueRef F, value Kind, + value Index) { + LLVMRemoveEnumAttributeAtIndex(F, Int_val(Index), Int_val(Kind)); + return Val_unit; +} + +/* llvalue -> string -> int -> unit */ +CAMLprim value llvm_remove_string_function_attr(LLVMValueRef F, value Kind, + value Index) { + LLVMRemoveStringAttributeAtIndex(F, Int_val(Index), String_val(Kind), + caml_string_length(Kind)); + return Val_unit; +} + +/*--... Operations on parameters ...........................................--*/ + +DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent) + +/* llvalue -> int -> llvalue */ +CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) { + return LLVMGetParam(Fn, Int_val(Index)); +} + +/* llvalue -> llvalue */ +CAMLprim value llvm_params(LLVMValueRef Fn) { + value Params = alloc(LLVMCountParams(Fn), 0); + LLVMGetParams(Fn, (LLVMValueRef *) Op_val(Params)); + return Params; +} + +/*--... Operations on basic blocks .........................................--*/ + +DEFINE_ITERATORS( + block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent) + +/* llbasicblock -> llvalue option */ +CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block) +{ + CAMLparam0(); + LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block); + if (Term) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) Term; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* llvalue -> llbasicblock array */ +CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) { + value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0); + LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *) Op_val(MLArray)); + return MLArray; +} + +/* llbasicblock -> unit */ +CAMLprim value llvm_delete_block(LLVMBasicBlockRef BB) { + LLVMDeleteBasicBlock(BB); + return Val_unit; +} + +/* llbasicblock -> unit */ +CAMLprim value llvm_remove_block(LLVMBasicBlockRef BB) { + LLVMRemoveBasicBlockFromParent(BB); + return Val_unit; +} + +/* llbasicblock -> llbasicblock -> unit */ +CAMLprim value llvm_move_block_before(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) { + LLVMMoveBasicBlockBefore(BB, Pos); + return Val_unit; +} + +/* llbasicblock -> llbasicblock -> unit */ +CAMLprim value llvm_move_block_after(LLVMBasicBlockRef Pos, LLVMBasicBlockRef BB) { + LLVMMoveBasicBlockAfter(BB, Pos); + return Val_unit; +} + +/* string -> llvalue -> llbasicblock */ +CAMLprim LLVMBasicBlockRef llvm_append_block(LLVMContextRef Context, value Name, + LLVMValueRef Fn) { + return LLVMAppendBasicBlockInContext(Context, Fn, String_val(Name)); +} + +/* string -> llbasicblock -> llbasicblock */ +CAMLprim LLVMBasicBlockRef llvm_insert_block(LLVMContextRef Context, value Name, + LLVMBasicBlockRef BB) { + return LLVMInsertBasicBlockInContext(Context, BB, String_val(Name)); +} + +/* llvalue -> bool */ +CAMLprim value llvm_value_is_block(LLVMValueRef Val) { + return Val_bool(LLVMValueIsBasicBlock(Val)); +} + +/*--... Operations on instructions .........................................--*/ + +DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef, + LLVMGetInstructionParent) + +/* llvalue -> Opcode.t */ +CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) { + LLVMOpcode o; + if (!LLVMIsAInstruction(Inst)) + failwith("Not an instruction"); + o = LLVMGetInstructionOpcode(Inst); + assert (o <= LLVMCallBr); + return Val_int(o); +} + +/* llvalue -> ICmp.t option */ +CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) { + CAMLparam0(); + int x = LLVMGetICmpPredicate(Val); + if (x) { + value Option = alloc(1, 0); + Field(Option, 0) = Val_int(x - LLVMIntEQ); + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* llvalue -> FCmp.t option */ +CAMLprim value llvm_instr_fcmp_predicate(LLVMValueRef Val) { + CAMLparam0(); + int x = LLVMGetFCmpPredicate(Val); + if (x) { + value Option = alloc(1, 0); + Field(Option, 0) = Val_int(x - LLVMRealPredicateFalse); + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* llvalue -> llvalue */ +CAMLprim LLVMValueRef llvm_instr_clone(LLVMValueRef Inst) { + if (!LLVMIsAInstruction(Inst)) + failwith("Not an instruction"); + return LLVMInstructionClone(Inst); +} + + +/*--... Operations on call sites ...........................................--*/ + +/* llvalue -> int */ +CAMLprim value llvm_instruction_call_conv(LLVMValueRef Inst) { + return Val_int(LLVMGetInstructionCallConv(Inst)); +} + +/* int -> llvalue -> unit */ +CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) { + LLVMSetInstructionCallConv(Inst, Int_val(CC)); + return Val_unit; +} + +/* llvalue -> llattribute -> int -> unit */ +CAMLprim value llvm_add_call_site_attr(LLVMValueRef F, LLVMAttributeRef A, + value Index) { + LLVMAddCallSiteAttribute(F, Int_val(Index), A); + return Val_unit; +} + +/* llvalue -> int -> llattribute array */ +CAMLprim value llvm_call_site_attrs(LLVMValueRef F, value Index) { + unsigned Count = LLVMGetCallSiteAttributeCount(F, Int_val(Index)); + value Array = caml_alloc(Count, 0); + LLVMGetCallSiteAttributes(F, Int_val(Index), + (LLVMAttributeRef *)Op_val(Array)); + return Array; +} + +/* llvalue -> llattrkind -> int -> unit */ +CAMLprim value llvm_remove_enum_call_site_attr(LLVMValueRef F, value Kind, + value Index) { + LLVMRemoveCallSiteEnumAttribute(F, Int_val(Index), Int_val(Kind)); + return Val_unit; +} + +/* llvalue -> string -> int -> unit */ +CAMLprim value llvm_remove_string_call_site_attr(LLVMValueRef F, value Kind, + value Index) { + LLVMRemoveCallSiteStringAttribute(F, Int_val(Index), String_val(Kind), + caml_string_length(Kind)); + return Val_unit; +} + +/*--... Operations on call instructions (only) .............................--*/ + +/* llvalue -> int */ +CAMLprim value llvm_num_arg_operands(LLVMValueRef V) { + return Val_int(LLVMGetNumArgOperands(V)); +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_tail_call(LLVMValueRef CallInst) { + return Val_bool(LLVMIsTailCall(CallInst)); +} + +/* bool -> llvalue -> unit */ +CAMLprim value llvm_set_tail_call(value IsTailCall, + LLVMValueRef CallInst) { + LLVMSetTailCall(CallInst, Bool_val(IsTailCall)); + return Val_unit; +} + +/*--... Operations on load/store instructions (only)........................--*/ + +/* llvalue -> bool */ +CAMLprim value llvm_is_volatile(LLVMValueRef MemoryInst) { + return Val_bool(LLVMGetVolatile(MemoryInst)); +} + +/* bool -> llvalue -> unit */ +CAMLprim value llvm_set_volatile(value IsVolatile, + LLVMValueRef MemoryInst) { + LLVMSetVolatile(MemoryInst, Bool_val(IsVolatile)); + return Val_unit; +} + + +/*--.. Operations on terminators ...........................................--*/ + +/* llvalue -> int -> llbasicblock */ +CAMLprim LLVMBasicBlockRef llvm_successor(LLVMValueRef V, value I) { + return LLVMGetSuccessor(V, Int_val(I)); +} + +/* llvalue -> int -> llvalue -> unit */ +CAMLprim value llvm_set_successor(LLVMValueRef U, value I, LLVMBasicBlockRef B) { + LLVMSetSuccessor(U, Int_val(I), B); + return Val_unit; +} + +/* llvalue -> int */ +CAMLprim value llvm_num_successors(LLVMValueRef V) { + return Val_int(LLVMGetNumSuccessors(V)); +} + +/*--.. Operations on branch ................................................--*/ + +/* llvalue -> llvalue */ +CAMLprim LLVMValueRef llvm_condition(LLVMValueRef V) { + return LLVMGetCondition(V); +} + +/* llvalue -> llvalue -> unit */ +CAMLprim value llvm_set_condition(LLVMValueRef B, LLVMValueRef C) { + LLVMSetCondition(B, C); + return Val_unit; +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_conditional(LLVMValueRef V) { + return Val_bool(LLVMIsConditional(V)); +} + +/*--... Operations on phi nodes ............................................--*/ + +/* (llvalue * llbasicblock) -> llvalue -> unit */ +CAMLprim value llvm_add_incoming(value Incoming, LLVMValueRef PhiNode) { + LLVMAddIncoming(PhiNode, + (LLVMValueRef*) &Field(Incoming, 0), + (LLVMBasicBlockRef*) &Field(Incoming, 1), + 1); + return Val_unit; +} + +/* llvalue -> (llvalue * llbasicblock) list */ +CAMLprim value llvm_incoming(LLVMValueRef PhiNode) { + unsigned I; + CAMLparam0(); + CAMLlocal3(Hd, Tl, Tmp); + + /* Build a tuple list of them. */ + Tl = Val_int(0); + for (I = LLVMCountIncoming(PhiNode); I != 0; ) { + Hd = alloc(2, 0); + Store_field(Hd, 0, (value) LLVMGetIncomingValue(PhiNode, --I)); + Store_field(Hd, 1, (value) LLVMGetIncomingBlock(PhiNode, I)); + + Tmp = alloc(2, 0); + Store_field(Tmp, 0, Hd); + Store_field(Tmp, 1, Tl); + Tl = Tmp; + } + + CAMLreturn(Tl); +} + +/* llvalue -> unit */ +CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) { + LLVMInstructionEraseFromParent(Instruction); + return Val_unit; +} + +/*===-- Instruction builders ----------------------------------------------===*/ + +#define Builder_val(v) (*(LLVMBuilderRef *)(Data_custom_val(v))) + +static void llvm_finalize_builder(value B) { + LLVMDisposeBuilder(Builder_val(B)); +} + +static struct custom_operations builder_ops = { + (char *) "Llvm.llbuilder", + llvm_finalize_builder, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default +}; + +static value alloc_builder(LLVMBuilderRef B) { + value V = alloc_custom(&builder_ops, sizeof(LLVMBuilderRef), 0, 1); + Builder_val(V) = B; + return V; +} + +/* llcontext -> llbuilder */ +CAMLprim value llvm_builder(LLVMContextRef C) { + return alloc_builder(LLVMCreateBuilderInContext(C)); +} + +/* (llbasicblock, llvalue) llpos -> llbuilder -> unit */ +CAMLprim value llvm_position_builder(value Pos, value B) { + if (Tag_val(Pos) == 0) { + LLVMBasicBlockRef BB = (LLVMBasicBlockRef) Op_val(Field(Pos, 0)); + LLVMPositionBuilderAtEnd(Builder_val(B), BB); + } else { + LLVMValueRef I = (LLVMValueRef) Op_val(Field(Pos, 0)); + LLVMPositionBuilderBefore(Builder_val(B), I); + } + return Val_unit; +} + +/* llbuilder -> llbasicblock */ +CAMLprim LLVMBasicBlockRef llvm_insertion_block(value B) { + LLVMBasicBlockRef InsertBlock = LLVMGetInsertBlock(Builder_val(B)); + if (!InsertBlock) + caml_raise_not_found(); + return InsertBlock; +} + +/* llvalue -> string -> llbuilder -> unit */ +CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) { + LLVMInsertIntoBuilderWithName(Builder_val(B), I, String_val(Name)); + return Val_unit; +} + +/*--... Metadata ...........................................................--*/ + +/* llbuilder -> llvalue -> unit */ +CAMLprim value llvm_set_current_debug_location(value B, LLVMValueRef V) { + LLVMSetCurrentDebugLocation(Builder_val(B), V); + return Val_unit; +} + +/* llbuilder -> unit */ +CAMLprim value llvm_clear_current_debug_location(value B) { + LLVMSetCurrentDebugLocation(Builder_val(B), NULL); + return Val_unit; +} + +/* llbuilder -> llvalue option */ +CAMLprim value llvm_current_debug_location(value B) { + CAMLparam0(); + LLVMValueRef L; + if ((L = LLVMGetCurrentDebugLocation(Builder_val(B)))) { + value Option = alloc(1, 0); + Field(Option, 0) = (value) L; + CAMLreturn(Option); + } + CAMLreturn(Val_int(0)); +} + +/* llbuilder -> llvalue -> unit */ +CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) { + LLVMSetInstDebugLocation(Builder_val(B), V); + return Val_unit; +} + + +/*--... Terminators ........................................................--*/ + +/* llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_ret_void(value B) { + return LLVMBuildRetVoid(Builder_val(B)); +} + +/* llvalue -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_ret(LLVMValueRef Val, value B) { + return LLVMBuildRet(Builder_val(B), Val); +} + +/* llvalue array -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_aggregate_ret(value RetVals, value B) { + return LLVMBuildAggregateRet(Builder_val(B), (LLVMValueRef *) Op_val(RetVals), + Wosize_val(RetVals)); +} + +/* llbasicblock -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_br(LLVMBasicBlockRef BB, value B) { + return LLVMBuildBr(Builder_val(B), BB); +} + +/* llvalue -> llbasicblock -> llbasicblock -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_cond_br(LLVMValueRef If, + LLVMBasicBlockRef Then, + LLVMBasicBlockRef Else, + value B) { + return LLVMBuildCondBr(Builder_val(B), If, Then, Else); +} + +/* llvalue -> llbasicblock -> int -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of, + LLVMBasicBlockRef Else, + value EstimatedCount, + value B) { + return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount)); +} + +/* lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name, + value B) +{ + return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name)); +} + +/* lltype -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty, + LLVMValueRef Val, + value Name, value B) +{ + return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name)); +} + +/* llvalue -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B) +{ + return LLVMBuildFree(Builder_val(B), P); +} + +/* llvalue -> llvalue -> llbasicblock -> unit */ +CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal, + LLVMBasicBlockRef Dest) { + LLVMAddCase(Switch, OnVal, Dest); + return Val_unit; +} + +/* llvalue -> llbasicblock -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_indirect_br(LLVMValueRef Addr, + value EstimatedDests, + value B) { + return LLVMBuildIndirectBr(Builder_val(B), Addr, EstimatedDests); +} + +/* llvalue -> llvalue -> llbasicblock -> unit */ +CAMLprim value llvm_add_destination(LLVMValueRef IndirectBr, + LLVMBasicBlockRef Dest) { + LLVMAddDestination(IndirectBr, Dest); + return Val_unit; +} + +/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string -> + llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_invoke_nat(LLVMValueRef Fn, value Args, + LLVMBasicBlockRef Then, + LLVMBasicBlockRef Catch, + value Name, value B) { + return LLVMBuildInvoke(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Args), + Wosize_val(Args), Then, Catch, String_val(Name)); +} + +/* llvalue -> llvalue array -> llbasicblock -> llbasicblock -> string -> + llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) { + return llvm_build_invoke_nat((LLVMValueRef) Args[0], Args[1], + (LLVMBasicBlockRef) Args[2], + (LLVMBasicBlockRef) Args[3], + Args[4], Args[5]); +} + +/* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn, + value NumClauses, value Name, + value B) { + return LLVMBuildLandingPad(Builder_val(B), Ty, PersFn, Int_val(NumClauses), + String_val(Name)); +} + +/* llvalue -> llvalue -> unit */ +CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal) +{ + LLVMAddClause(LandingPadInst, ClauseVal); + return Val_unit; +} + +/* llvalue -> bool */ +CAMLprim value llvm_is_cleanup(LLVMValueRef LandingPadInst) +{ + return Val_bool(LLVMIsCleanup(LandingPadInst)); +} + +/* llvalue -> bool -> unit */ +CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag) +{ + LLVMSetCleanup(LandingPadInst, Bool_val(flag)); + return Val_unit; +} + +/* llvalue -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B) +{ + return LLVMBuildResume(Builder_val(B), Exn); +} + +/* llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_unreachable(value B) { + return LLVMBuildUnreachable(Builder_val(B)); +} + +/*--... Arithmetic .........................................................--*/ + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_add(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildAdd(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nsw_add(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNSWAdd(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nuw_add(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNUWAdd(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fadd(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildFAdd(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_sub(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildSub(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nsw_sub(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNSWSub(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nuw_sub(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNUWSub(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fsub(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildFSub(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_mul(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildMul(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nsw_mul(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNSWMul(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nuw_mul(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildNUWMul(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fmul(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildFMul(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_udiv(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildUDiv(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_sdiv(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildSDiv(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_exact_sdiv(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildExactSDiv(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fdiv(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildFDiv(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_urem(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildURem(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_srem(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildSRem(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_frem(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildFRem(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_shl(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildShl(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_lshr(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildLShr(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_ashr(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildAShr(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_and(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildAnd(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_or(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildOr(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_xor(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildXor(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_neg(LLVMValueRef X, + value Name, value B) { + return LLVMBuildNeg(Builder_val(B), X, String_val(Name)); +} + +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nsw_neg(LLVMValueRef X, + value Name, value B) { + return LLVMBuildNSWNeg(Builder_val(B), X, String_val(Name)); +} + +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_nuw_neg(LLVMValueRef X, + value Name, value B) { + return LLVMBuildNUWNeg(Builder_val(B), X, String_val(Name)); +} + +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fneg(LLVMValueRef X, + value Name, value B) { + return LLVMBuildFNeg(Builder_val(B), X, String_val(Name)); +} + +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_not(LLVMValueRef X, + value Name, value B) { + return LLVMBuildNot(Builder_val(B), X, String_val(Name)); +} + +/*--... Memory .............................................................--*/ + +/* lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_alloca(LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildAlloca(Builder_val(B), Ty, String_val(Name)); +} + +/* lltype -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_array_alloca(LLVMTypeRef Ty, LLVMValueRef Size, + value Name, value B) { + return LLVMBuildArrayAlloca(Builder_val(B), Ty, Size, String_val(Name)); +} + +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_load(LLVMValueRef Pointer, + value Name, value B) { + return LLVMBuildLoad(Builder_val(B), Pointer, String_val(Name)); +} + +/* llvalue -> llvalue -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_store(LLVMValueRef Value, LLVMValueRef Pointer, + value B) { + return LLVMBuildStore(Builder_val(B), Value, Pointer); +} + +/* AtomicRMWBinOp.t -> llvalue -> llvalue -> AtomicOrdering.t -> + bool -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_atomicrmw_native(value BinOp, LLVMValueRef Ptr, + LLVMValueRef Val, value Ord, + value ST, value Name, value B) { + LLVMValueRef Instr; + Instr = LLVMBuildAtomicRMW(Builder_val(B), Int_val(BinOp), + Ptr, Val, Int_val(Ord), Bool_val(ST)); + LLVMSetValueName(Instr, String_val(Name)); + return Instr; +} + +CAMLprim LLVMValueRef llvm_build_atomicrmw_bytecode(value *argv, int argn) { + return llvm_build_atomicrmw_native(argv[0], (LLVMValueRef) argv[1], + (LLVMValueRef) argv[2], argv[3], + argv[4], argv[5], argv[6]); +} + +/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_gep(LLVMValueRef Pointer, value Indices, + value Name, value B) { + return LLVMBuildGEP(Builder_val(B), Pointer, + (LLVMValueRef *) Op_val(Indices), Wosize_val(Indices), + String_val(Name)); +} + +/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_in_bounds_gep(LLVMValueRef Pointer, + value Indices, value Name, + value B) { + return LLVMBuildInBoundsGEP(Builder_val(B), Pointer, + (LLVMValueRef *) Op_val(Indices), + Wosize_val(Indices), String_val(Name)); +} + +/* llvalue -> int -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_struct_gep(LLVMValueRef Pointer, + value Index, value Name, + value B) { + return LLVMBuildStructGEP(Builder_val(B), Pointer, + Int_val(Index), String_val(Name)); +} + +/* string -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_global_string(value Str, value Name, value B) { + return LLVMBuildGlobalString(Builder_val(B), String_val(Str), + String_val(Name)); +} + +/* string -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_global_stringptr(value Str, value Name, + value B) { + return LLVMBuildGlobalStringPtr(Builder_val(B), String_val(Str), + String_val(Name)); +} + +/*--... Casts ..............................................................--*/ + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_trunc(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildTrunc(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_zext(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildZExt(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_sext(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildSExt(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fptoui(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildFPToUI(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fptosi(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildFPToSI(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_uitofp(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildUIToFP(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_sitofp(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildSIToFP(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fptrunc(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildFPTrunc(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fpext(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildFPExt(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_prttoint(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildPtrToInt(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_inttoptr(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildIntToPtr(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_bitcast(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildBitCast(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_zext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildZExtOrBitCast(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_sext_or_bitcast(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildSExtOrBitCast(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_trunc_or_bitcast(LLVMValueRef X, + LLVMTypeRef Ty, value Name, + value B) { + return LLVMBuildTruncOrBitCast(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_pointercast(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildPointerCast(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_intcast(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildIntCast(Builder_val(B), X, Ty, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fpcast(LLVMValueRef X, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildFPCast(Builder_val(B), X, Ty, String_val(Name)); +} + +/*--... Comparisons ........................................................--*/ + +/* Icmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_icmp(value Pred, + LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildICmp(Builder_val(B), Int_val(Pred) + LLVMIntEQ, LHS, RHS, + String_val(Name)); +} + +/* Fcmp.t -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_fcmp(value Pred, + LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildFCmp(Builder_val(B), Int_val(Pred), LHS, RHS, + String_val(Name)); +} + +/*--... Miscellaneous instructions .........................................--*/ + +/* (llvalue * llbasicblock) list -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_phi(value Incoming, value Name, value B) { + value Hd, Tl; + LLVMValueRef FirstValue, PhiNode; + + assert(Incoming != Val_int(0) && "Empty list passed to Llvm.build_phi!"); + + Hd = Field(Incoming, 0); + FirstValue = (LLVMValueRef) Field(Hd, 0); + PhiNode = LLVMBuildPhi(Builder_val(B), LLVMTypeOf(FirstValue), + String_val(Name)); + + for (Tl = Incoming; Tl != Val_int(0); Tl = Field(Tl, 1)) { + value Hd = Field(Tl, 0); + LLVMAddIncoming(PhiNode, (LLVMValueRef*) &Field(Hd, 0), + (LLVMBasicBlockRef*) &Field(Hd, 1), 1); + } + + return PhiNode; +} + +/* lltype -> string -> llbuilder -> value */ +CAMLprim LLVMValueRef llvm_build_empty_phi(LLVMTypeRef Type, value Name, value B) { + LLVMValueRef PhiNode; + + return LLVMBuildPhi(Builder_val(B), Type, String_val(Name)); + + return PhiNode; +} + +/* llvalue -> llvalue array -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_call(LLVMValueRef Fn, value Params, + value Name, value B) { + return LLVMBuildCall(Builder_val(B), Fn, (LLVMValueRef *) Op_val(Params), + Wosize_val(Params), String_val(Name)); +} + +/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_select(LLVMValueRef If, + LLVMValueRef Then, LLVMValueRef Else, + value Name, value B) { + return LLVMBuildSelect(Builder_val(B), If, Then, Else, String_val(Name)); +} + +/* llvalue -> lltype -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_va_arg(LLVMValueRef List, LLVMTypeRef Ty, + value Name, value B) { + return LLVMBuildVAArg(Builder_val(B), List, Ty, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_extractelement(LLVMValueRef Vec, + LLVMValueRef Idx, + value Name, value B) { + return LLVMBuildExtractElement(Builder_val(B), Vec, Idx, String_val(Name)); +} + +/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_insertelement(LLVMValueRef Vec, + LLVMValueRef Element, + LLVMValueRef Idx, + value Name, value B) { + return LLVMBuildInsertElement(Builder_val(B), Vec, Element, Idx, + String_val(Name)); +} + +/* llvalue -> llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_shufflevector(LLVMValueRef V1, LLVMValueRef V2, + LLVMValueRef Mask, + value Name, value B) { + return LLVMBuildShuffleVector(Builder_val(B), V1, V2, Mask, String_val(Name)); +} + +/* llvalue -> int -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_extractvalue(LLVMValueRef Aggregate, + value Idx, value Name, value B) { + return LLVMBuildExtractValue(Builder_val(B), Aggregate, Int_val(Idx), + String_val(Name)); +} + +/* llvalue -> llvalue -> int -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_insertvalue(LLVMValueRef Aggregate, + LLVMValueRef Val, value Idx, + value Name, value B) { + return LLVMBuildInsertValue(Builder_val(B), Aggregate, Val, Int_val(Idx), + String_val(Name)); +} + +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_is_null(LLVMValueRef Val, value Name, + value B) { + return LLVMBuildIsNull(Builder_val(B), Val, String_val(Name)); +} + +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_is_not_null(LLVMValueRef Val, value Name, + value B) { + return LLVMBuildIsNotNull(Builder_val(B), Val, String_val(Name)); +} + +/* llvalue -> llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_ptrdiff(LLVMValueRef LHS, LLVMValueRef RHS, + value Name, value B) { + return LLVMBuildPtrDiff(Builder_val(B), LHS, RHS, String_val(Name)); +} + +/* llvalue -> string -> llbuilder -> llvalue */ +CAMLprim LLVMValueRef llvm_build_freeze(LLVMValueRef X, + value Name, value B) { + return LLVMBuildFreeze(Builder_val(B), X, String_val(Name)); +} + +/*===-- Memory buffers ----------------------------------------------------===*/ + +/* string -> llmemorybuffer + raises IoError msg on error */ +CAMLprim value llvm_memorybuffer_of_file(value Path) { + CAMLparam1(Path); + char *Message; + LLVMMemoryBufferRef MemBuf; + + if (LLVMCreateMemoryBufferWithContentsOfFile(String_val(Path), + &MemBuf, &Message)) + llvm_raise(*caml_named_value("Llvm.IoError"), Message); + + CAMLreturn((value) MemBuf); +} + +/* unit -> llmemorybuffer + raises IoError msg on error */ +CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_stdin(value Unit) { + char *Message; + LLVMMemoryBufferRef MemBuf; + + if (LLVMCreateMemoryBufferWithSTDIN(&MemBuf, &Message)) + llvm_raise(*caml_named_value("Llvm.IoError"), Message); + + return MemBuf; +} + +/* ?name:string -> string -> llmemorybuffer */ +CAMLprim LLVMMemoryBufferRef llvm_memorybuffer_of_string(value Name, value String) { + LLVMMemoryBufferRef MemBuf; + const char *NameCStr; + + if(Name == Val_int(0)) + NameCStr = ""; + else + NameCStr = String_val(Field(Name, 0)); + + MemBuf = LLVMCreateMemoryBufferWithMemoryRangeCopy( + String_val(String), caml_string_length(String), NameCStr); + + return MemBuf; +} + +/* llmemorybuffer -> string */ +CAMLprim value llvm_memorybuffer_as_string(LLVMMemoryBufferRef MemBuf) { + value String = caml_alloc_string(LLVMGetBufferSize(MemBuf)); + memcpy(String_val(String), LLVMGetBufferStart(MemBuf), + LLVMGetBufferSize(MemBuf)); + + return String; +} + +/* llmemorybuffer -> unit */ +CAMLprim value llvm_memorybuffer_dispose(LLVMMemoryBufferRef MemBuf) { + LLVMDisposeMemoryBuffer(MemBuf); + return Val_unit; +} + +/*===-- Pass Managers -----------------------------------------------------===*/ + +/* unit -> [ `Module ] PassManager.t */ +CAMLprim LLVMPassManagerRef llvm_passmanager_create(value Unit) { + return LLVMCreatePassManager(); +} + +/* llmodule -> [ `Function ] PassManager.t -> bool */ +CAMLprim value llvm_passmanager_run_module(LLVMModuleRef M, + LLVMPassManagerRef PM) { + return Val_bool(LLVMRunPassManager(PM, M)); +} + +/* [ `Function ] PassManager.t -> bool */ +CAMLprim value llvm_passmanager_initialize(LLVMPassManagerRef FPM) { + return Val_bool(LLVMInitializeFunctionPassManager(FPM)); +} + +/* llvalue -> [ `Function ] PassManager.t -> bool */ +CAMLprim value llvm_passmanager_run_function(LLVMValueRef F, + LLVMPassManagerRef FPM) { + return Val_bool(LLVMRunFunctionPassManager(FPM, F)); +} + +/* [ `Function ] PassManager.t -> bool */ +CAMLprim value llvm_passmanager_finalize(LLVMPassManagerRef FPM) { + return Val_bool(LLVMFinalizeFunctionPassManager(FPM)); +} + +/* PassManager.any PassManager.t -> unit */ +CAMLprim value llvm_passmanager_dispose(LLVMPassManagerRef PM) { + LLVMDisposePassManager(PM); + return Val_unit; +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/CMakeLists.txt new file mode 100644 index 000000000..adee0fcec --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_target + OCAML llvm_target + OCAMLDEP llvm + C target_ocaml + LLVM target) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/llvm_target.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/llvm_target.ml new file mode 100644 index 000000000..0922ebe55 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/llvm_target.ml @@ -0,0 +1,135 @@ +(*===-- llvm_target.ml - LLVM OCaml Interface ------------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +module Endian = struct + type t = + | Big + | Little +end + +module CodeGenOptLevel = struct + type t = + | None + | Less + | Default + | Aggressive +end + +module RelocMode = struct + type t = + | Default + | Static + | PIC + | DynamicNoPIC +end + +module CodeModel = struct + type t = + | Default + | JITDefault + | Small + | Kernel + | Medium + | Large +end + +module CodeGenFileType = struct + type t = + | AssemblyFile + | ObjectFile +end + +exception Error of string + +let () = Callback.register_exception "Llvm_target.Error" (Error "") + +module DataLayout = struct + type t + + external of_string : string -> t = "llvm_datalayout_of_string" + external as_string : t -> string = "llvm_datalayout_as_string" + external byte_order : t -> Endian.t = "llvm_datalayout_byte_order" + external pointer_size : t -> int = "llvm_datalayout_pointer_size" + external intptr_type : Llvm.llcontext -> t -> Llvm.lltype + = "llvm_datalayout_intptr_type" + external qualified_pointer_size : int -> t -> int + = "llvm_datalayout_qualified_pointer_size" + external qualified_intptr_type : Llvm.llcontext -> int -> t -> Llvm.lltype + = "llvm_datalayout_qualified_intptr_type" + external size_in_bits : Llvm.lltype -> t -> Int64.t + = "llvm_datalayout_size_in_bits" + external store_size : Llvm.lltype -> t -> Int64.t + = "llvm_datalayout_store_size" + external abi_size : Llvm.lltype -> t -> Int64.t + = "llvm_datalayout_abi_size" + external abi_align : Llvm.lltype -> t -> int + = "llvm_datalayout_abi_align" + external stack_align : Llvm.lltype -> t -> int + = "llvm_datalayout_stack_align" + external preferred_align : Llvm.lltype -> t -> int + = "llvm_datalayout_preferred_align" + external preferred_align_of_global : Llvm.llvalue -> t -> int + = "llvm_datalayout_preferred_align_of_global" + external element_at_offset : Llvm.lltype -> Int64.t -> t -> int + = "llvm_datalayout_element_at_offset" + external offset_of_element : Llvm.lltype -> int -> t -> Int64.t + = "llvm_datalayout_offset_of_element" +end + +module Target = struct + type t + + external default_triple : unit -> string = "llvm_target_default_triple" + external first : unit -> t option = "llvm_target_first" + external succ : t -> t option = "llvm_target_succ" + external by_name : string -> t option = "llvm_target_by_name" + external by_triple : string -> t = "llvm_target_by_triple" + external name : t -> string = "llvm_target_name" + external description : t -> string = "llvm_target_description" + external has_jit : t -> bool = "llvm_target_has_jit" + external has_target_machine : t -> bool = "llvm_target_has_target_machine" + external has_asm_backend : t -> bool = "llvm_target_has_asm_backend" + + let all () = + let rec step elem lst = + match elem with + | Some target -> step (succ target) (target :: lst) + | None -> lst + in + step (first ()) [] +end + +module TargetMachine = struct + type t + + external create : triple:string -> ?cpu:string -> ?features:string -> + ?level:CodeGenOptLevel.t -> ?reloc_mode:RelocMode.t -> + ?code_model:CodeModel.t -> Target.t -> t + = "llvm_create_targetmachine_bytecode" + "llvm_create_targetmachine_native" + external target : t -> Target.t + = "llvm_targetmachine_target" + external triple : t -> string + = "llvm_targetmachine_triple" + external cpu : t -> string + = "llvm_targetmachine_cpu" + external features : t -> string + = "llvm_targetmachine_features" + external data_layout : t -> DataLayout.t + = "llvm_targetmachine_data_layout" + external add_analysis_passes : [< Llvm.PassManager.any ] Llvm.PassManager.t -> t -> unit + = "llvm_targetmachine_add_analysis_passes" + external set_verbose_asm : bool -> t -> unit + = "llvm_targetmachine_set_verbose_asm" + external emit_to_file : Llvm.llmodule -> CodeGenFileType.t -> string -> + t -> unit + = "llvm_targetmachine_emit_to_file" + external emit_to_memory_buffer : Llvm.llmodule -> CodeGenFileType.t -> + t -> Llvm.llmemorybuffer + = "llvm_targetmachine_emit_to_memory_buffer" +end diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/llvm_target.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/llvm_target.mli new file mode 100644 index 000000000..8d310793b --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/llvm_target.mli @@ -0,0 +1,219 @@ +(*===-- llvm_target.mli - LLVM OCaml Interface -----------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Target Information. + + This interface provides an OCaml API for LLVM target information, + the classes in the Target library. *) + +module Endian : sig + type t = + | Big + | Little +end + +module CodeGenOptLevel : sig + type t = + | None + | Less + | Default + | Aggressive +end + +module RelocMode : sig + type t = + | Default + | Static + | PIC + | DynamicNoPIC +end + +module CodeModel : sig + type t = + | Default + | JITDefault + | Small + | Kernel + | Medium + | Large +end + +module CodeGenFileType : sig + type t = + | AssemblyFile + | ObjectFile +end + +(** {6 Exceptions} *) + +exception Error of string + +(** {6 Data Layout} *) + +module DataLayout : sig + type t + + (** [of_string rep] parses the data layout string representation [rep]. + See the constructor [llvm::DataLayout::DataLayout]. *) + val of_string : string -> t + + (** [as_string dl] is the string representation of the data layout [dl]. + See the method [llvm::DataLayout::getStringRepresentation]. *) + val as_string : t -> string + + (** Returns the byte order of a target, either [Endian.Big] or + [Endian.Little]. + See the method [llvm::DataLayout::isLittleEndian]. *) + val byte_order : t -> Endian.t + + (** Returns the pointer size in bytes for a target. + See the method [llvm::DataLayout::getPointerSize]. *) + val pointer_size : t -> int + + (** Returns the integer type that is the same size as a pointer on a target. + See the method [llvm::DataLayout::getIntPtrType]. *) + val intptr_type : Llvm.llcontext -> t -> Llvm.lltype + + (** Returns the pointer size in bytes for a target in a given address space. + See the method [llvm::DataLayout::getPointerSize]. *) + val qualified_pointer_size : int -> t -> int + + (** Returns the integer type that is the same size as a pointer on a target + in a given address space. + See the method [llvm::DataLayout::getIntPtrType]. *) + val qualified_intptr_type : Llvm.llcontext -> int -> t -> Llvm.lltype + + (** Computes the size of a type in bits for a target. + See the method [llvm::DataLayout::getTypeSizeInBits]. *) + val size_in_bits : Llvm.lltype -> t -> Int64.t + + (** Computes the storage size of a type in bytes for a target. + See the method [llvm::DataLayout::getTypeStoreSize]. *) + val store_size : Llvm.lltype -> t -> Int64.t + + (** Computes the ABI size of a type in bytes for a target. + See the method [llvm::DataLayout::getTypeAllocSize]. *) + val abi_size : Llvm.lltype -> t -> Int64.t + + (** Computes the ABI alignment of a type in bytes for a target. + See the method [llvm::DataLayout::getTypeABISize]. *) + val abi_align : Llvm.lltype -> t -> int + + (** Computes the call frame alignment of a type in bytes for a target. + See the method [llvm::DataLayout::getTypeABISize]. *) + val stack_align : Llvm.lltype -> t -> int + + (** Computes the preferred alignment of a type in bytes for a target. + See the method [llvm::DataLayout::getTypeABISize]. *) + val preferred_align : Llvm.lltype -> t -> int + + (** Computes the preferred alignment of a global variable in bytes for + a target. See the method [llvm::DataLayout::getPreferredAlignment]. *) + val preferred_align_of_global : Llvm.llvalue -> t -> int + + (** Computes the structure element that contains the byte offset for a target. + See the method [llvm::StructLayout::getElementContainingOffset]. *) + val element_at_offset : Llvm.lltype -> Int64.t -> t -> int + + (** Computes the byte offset of the indexed struct element for a target. + See the method [llvm::StructLayout::getElementContainingOffset]. *) + val offset_of_element : Llvm.lltype -> int -> t -> Int64.t +end + +(** {6 Target} *) + +module Target : sig + type t + + (** [default_triple ()] returns the default target triple for current + platform. *) + val default_triple : unit -> string + + (** [first ()] returns the first target in the registered targets + list, or [None]. *) + val first : unit -> t option + + (** [succ t] returns the next target after [t], or [None] + if [t] was the last target. *) + val succ : t -> t option + + (** [all ()] returns a list of known targets. *) + val all : unit -> t list + + (** [by_name name] returns [Some t] if a target [t] named [name] is + registered, or [None] otherwise. *) + val by_name : string -> t option + + (** [by_triple triple] returns a target for a triple [triple], or raises + [Error] if [triple] does not correspond to a registered target. *) + val by_triple : string -> t + + (** Returns the name of a target. See [llvm::Target::getName]. *) + val name : t -> string + + (** Returns the description of a target. + See [llvm::Target::getDescription]. *) + val description : t -> string + + (** Returns [true] if the target has a JIT. *) + val has_jit : t -> bool + + (** Returns [true] if the target has a target machine associated. *) + val has_target_machine : t -> bool + + (** Returns [true] if the target has an ASM backend (required for + emitting output). *) + val has_asm_backend : t -> bool +end + +(** {6 Target Machine} *) + +module TargetMachine : sig + type t + + (** Creates a new target machine. + See [llvm::Target::createTargetMachine]. *) + val create : triple:string -> ?cpu:string -> ?features:string -> + ?level:CodeGenOptLevel.t -> ?reloc_mode:RelocMode.t -> + ?code_model:CodeModel.t -> Target.t -> t + + (** Returns the Target used in a TargetMachine *) + val target : t -> Target.t + + (** Returns the triple used while creating this target machine. See + [llvm::TargetMachine::getTriple]. *) + val triple : t -> string + + (** Returns the CPU used while creating this target machine. See + [llvm::TargetMachine::getCPU]. *) + val cpu : t -> string + + (** Returns the data layout of this target machine. *) + val data_layout : t -> DataLayout.t + + (** Returns the feature string used while creating this target machine. See + [llvm::TargetMachine::getFeatureString]. *) + val features : t -> string + + (** Adds the target-specific analysis passes to the pass manager. + See [llvm::TargetMachine::addAnalysisPasses]. *) + val add_analysis_passes : [< Llvm.PassManager.any ] Llvm.PassManager.t -> t -> unit + + (** Sets the assembly verbosity of this target machine. + See [llvm::TargetMachine::setAsmVerbosity]. *) + val set_verbose_asm : bool -> t -> unit + + (** Emits assembly or object data for the given module to the given + file or raise [Error]. *) + val emit_to_file : Llvm.llmodule -> CodeGenFileType.t -> string -> t -> unit + + (** Emits assembly or object data for the given module to a fresh memory + buffer or raise [Error]. *) + val emit_to_memory_buffer : Llvm.llmodule -> CodeGenFileType.t -> t -> + Llvm.llmemorybuffer +end diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/target_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/target_ocaml.c new file mode 100644 index 000000000..cf48fbe45 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/target/target_ocaml.c @@ -0,0 +1,347 @@ +/*===-- target_ocaml.c - LLVM OCaml Glue ------------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Core.h" +#include "llvm-c/Target.h" +#include "llvm-c/TargetMachine.h" +#include "caml/alloc.h" +#include "caml/fail.h" +#include "caml/memory.h" +#include "caml/custom.h" +#include "caml/callback.h" + +void llvm_raise(value Prototype, char *Message); +value llvm_string_of_message(char* Message); + +/*===---- Data Layout -----------------------------------------------------===*/ + +#define DataLayout_val(v) (*(LLVMTargetDataRef *)(Data_custom_val(v))) + +static void llvm_finalize_data_layout(value DataLayout) { + LLVMDisposeTargetData(DataLayout_val(DataLayout)); +} + +static struct custom_operations llvm_data_layout_ops = { + (char *) "Llvm_target.DataLayout.t", + llvm_finalize_data_layout, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default +}; + +value llvm_alloc_data_layout(LLVMTargetDataRef DataLayout) { + value V = alloc_custom(&llvm_data_layout_ops, sizeof(LLVMTargetDataRef), + 0, 1); + DataLayout_val(V) = DataLayout; + return V; +} + +/* string -> DataLayout.t */ +CAMLprim value llvm_datalayout_of_string(value StringRep) { + return llvm_alloc_data_layout(LLVMCreateTargetData(String_val(StringRep))); +} + +/* DataLayout.t -> string */ +CAMLprim value llvm_datalayout_as_string(value TD) { + char *StringRep = LLVMCopyStringRepOfTargetData(DataLayout_val(TD)); + value Copy = copy_string(StringRep); + LLVMDisposeMessage(StringRep); + return Copy; +} + +/* DataLayout.t -> Endian.t */ +CAMLprim value llvm_datalayout_byte_order(value DL) { + return Val_int(LLVMByteOrder(DataLayout_val(DL))); +} + +/* DataLayout.t -> int */ +CAMLprim value llvm_datalayout_pointer_size(value DL) { + return Val_int(LLVMPointerSize(DataLayout_val(DL))); +} + +/* Llvm.llcontext -> DataLayout.t -> Llvm.lltype */ +CAMLprim LLVMTypeRef llvm_datalayout_intptr_type(LLVMContextRef C, value DL) { + return LLVMIntPtrTypeInContext(C, DataLayout_val(DL)); +} + +/* int -> DataLayout.t -> int */ +CAMLprim value llvm_datalayout_qualified_pointer_size(value AS, value DL) { + return Val_int(LLVMPointerSizeForAS(DataLayout_val(DL), Int_val(AS))); +} + +/* Llvm.llcontext -> int -> DataLayout.t -> Llvm.lltype */ +CAMLprim LLVMTypeRef llvm_datalayout_qualified_intptr_type(LLVMContextRef C, + value AS, + value DL) { + return LLVMIntPtrTypeForASInContext(C, DataLayout_val(DL), Int_val(AS)); +} + +/* Llvm.lltype -> DataLayout.t -> Int64.t */ +CAMLprim value llvm_datalayout_size_in_bits(LLVMTypeRef Ty, value DL) { + return caml_copy_int64(LLVMSizeOfTypeInBits(DataLayout_val(DL), Ty)); +} + +/* Llvm.lltype -> DataLayout.t -> Int64.t */ +CAMLprim value llvm_datalayout_store_size(LLVMTypeRef Ty, value DL) { + return caml_copy_int64(LLVMStoreSizeOfType(DataLayout_val(DL), Ty)); +} + +/* Llvm.lltype -> DataLayout.t -> Int64.t */ +CAMLprim value llvm_datalayout_abi_size(LLVMTypeRef Ty, value DL) { + return caml_copy_int64(LLVMABISizeOfType(DataLayout_val(DL), Ty)); +} + +/* Llvm.lltype -> DataLayout.t -> int */ +CAMLprim value llvm_datalayout_abi_align(LLVMTypeRef Ty, value DL) { + return Val_int(LLVMABIAlignmentOfType(DataLayout_val(DL), Ty)); +} + +/* Llvm.lltype -> DataLayout.t -> int */ +CAMLprim value llvm_datalayout_stack_align(LLVMTypeRef Ty, value DL) { + return Val_int(LLVMCallFrameAlignmentOfType(DataLayout_val(DL), Ty)); +} + +/* Llvm.lltype -> DataLayout.t -> int */ +CAMLprim value llvm_datalayout_preferred_align(LLVMTypeRef Ty, value DL) { + return Val_int(LLVMPreferredAlignmentOfType(DataLayout_val(DL), Ty)); +} + +/* Llvm.llvalue -> DataLayout.t -> int */ +CAMLprim value llvm_datalayout_preferred_align_of_global(LLVMValueRef GlobalVar, + value DL) { + return Val_int(LLVMPreferredAlignmentOfGlobal(DataLayout_val(DL), GlobalVar)); +} + +/* Llvm.lltype -> Int64.t -> DataLayout.t -> int */ +CAMLprim value llvm_datalayout_element_at_offset(LLVMTypeRef Ty, value Offset, + value DL) { + return Val_int(LLVMElementAtOffset(DataLayout_val(DL), Ty, + Int64_val(Offset))); +} + +/* Llvm.lltype -> int -> DataLayout.t -> Int64.t */ +CAMLprim value llvm_datalayout_offset_of_element(LLVMTypeRef Ty, value Index, + value DL) { + return caml_copy_int64(LLVMOffsetOfElement(DataLayout_val(DL), Ty, + Int_val(Index))); +} + +/*===---- Target ----------------------------------------------------------===*/ + +static value llvm_target_option(LLVMTargetRef Target) { + if(Target != NULL) { + value Result = caml_alloc_small(1, 0); + Store_field(Result, 0, (value) Target); + return Result; + } + + return Val_int(0); +} + +/* unit -> string */ +CAMLprim value llvm_target_default_triple(value Unit) { + char *TripleCStr = LLVMGetDefaultTargetTriple(); + value TripleStr = caml_copy_string(TripleCStr); + LLVMDisposeMessage(TripleCStr); + + return TripleStr; +} + +/* unit -> Target.t option */ +CAMLprim value llvm_target_first(value Unit) { + return llvm_target_option(LLVMGetFirstTarget()); +} + +/* Target.t -> Target.t option */ +CAMLprim value llvm_target_succ(LLVMTargetRef Target) { + return llvm_target_option(LLVMGetNextTarget(Target)); +} + +/* string -> Target.t option */ +CAMLprim value llvm_target_by_name(value Name) { + return llvm_target_option(LLVMGetTargetFromName(String_val(Name))); +} + +/* string -> Target.t */ +CAMLprim LLVMTargetRef llvm_target_by_triple(value Triple) { + LLVMTargetRef T; + char *Error; + + if(LLVMGetTargetFromTriple(String_val(Triple), &T, &Error)) + llvm_raise(*caml_named_value("Llvm_target.Error"), Error); + + return T; +} + +/* Target.t -> string */ +CAMLprim value llvm_target_name(LLVMTargetRef Target) { + return caml_copy_string(LLVMGetTargetName(Target)); +} + +/* Target.t -> string */ +CAMLprim value llvm_target_description(LLVMTargetRef Target) { + return caml_copy_string(LLVMGetTargetDescription(Target)); +} + +/* Target.t -> bool */ +CAMLprim value llvm_target_has_jit(LLVMTargetRef Target) { + return Val_bool(LLVMTargetHasJIT(Target)); +} + +/* Target.t -> bool */ +CAMLprim value llvm_target_has_target_machine(LLVMTargetRef Target) { + return Val_bool(LLVMTargetHasTargetMachine(Target)); +} + +/* Target.t -> bool */ +CAMLprim value llvm_target_has_asm_backend(LLVMTargetRef Target) { + return Val_bool(LLVMTargetHasAsmBackend(Target)); +} + +/*===---- Target Machine --------------------------------------------------===*/ + +#define TargetMachine_val(v) (*(LLVMTargetMachineRef *)(Data_custom_val(v))) + +static void llvm_finalize_target_machine(value Machine) { + LLVMDisposeTargetMachine(TargetMachine_val(Machine)); +} + +static struct custom_operations llvm_target_machine_ops = { + (char *) "Llvm_target.TargetMachine.t", + llvm_finalize_target_machine, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default +}; + +static value llvm_alloc_targetmachine(LLVMTargetMachineRef Machine) { + value V = alloc_custom(&llvm_target_machine_ops, sizeof(LLVMTargetMachineRef), + 0, 1); + TargetMachine_val(V) = Machine; + return V; +} + +/* triple:string -> ?cpu:string -> ?features:string + ?level:CodeGenOptLevel.t -> ?reloc_mode:RelocMode.t + ?code_model:CodeModel.t -> Target.t -> TargetMachine.t */ +CAMLprim value llvm_create_targetmachine_native(value Triple, value CPU, + value Features, value OptLevel, value RelocMode, + value CodeModel, LLVMTargetRef Target) { + LLVMTargetMachineRef Machine; + const char *CPUStr = "", *FeaturesStr = ""; + LLVMCodeGenOptLevel OptLevelEnum = LLVMCodeGenLevelDefault; + LLVMRelocMode RelocModeEnum = LLVMRelocDefault; + LLVMCodeModel CodeModelEnum = LLVMCodeModelDefault; + + if(CPU != Val_int(0)) + CPUStr = String_val(Field(CPU, 0)); + if(Features != Val_int(0)) + FeaturesStr = String_val(Field(Features, 0)); + if(OptLevel != Val_int(0)) + OptLevelEnum = Int_val(Field(OptLevel, 0)); + if(RelocMode != Val_int(0)) + RelocModeEnum = Int_val(Field(RelocMode, 0)); + if(CodeModel != Val_int(0)) + CodeModelEnum = Int_val(Field(CodeModel, 0)); + + Machine = LLVMCreateTargetMachine(Target, String_val(Triple), CPUStr, + FeaturesStr, OptLevelEnum, RelocModeEnum, CodeModelEnum); + + return llvm_alloc_targetmachine(Machine); +} + +CAMLprim value llvm_create_targetmachine_bytecode(value *argv, int argn) { + return llvm_create_targetmachine_native(argv[0], argv[1], argv[2], argv[3], + argv[4], argv[5], (LLVMTargetRef) argv[6]); +} + +/* TargetMachine.t -> Target.t */ +CAMLprim LLVMTargetRef llvm_targetmachine_target(value Machine) { + return LLVMGetTargetMachineTarget(TargetMachine_val(Machine)); +} + +/* TargetMachine.t -> string */ +CAMLprim value llvm_targetmachine_triple(value Machine) { + return llvm_string_of_message(LLVMGetTargetMachineTriple( + TargetMachine_val(Machine))); +} + +/* TargetMachine.t -> string */ +CAMLprim value llvm_targetmachine_cpu(value Machine) { + return llvm_string_of_message(LLVMGetTargetMachineCPU( + TargetMachine_val(Machine))); +} + +/* TargetMachine.t -> string */ +CAMLprim value llvm_targetmachine_features(value Machine) { + return llvm_string_of_message(LLVMGetTargetMachineFeatureString( + TargetMachine_val(Machine))); +} + +/* TargetMachine.t -> DataLayout.t */ +CAMLprim value llvm_targetmachine_data_layout(value Machine) { + return llvm_alloc_data_layout(LLVMCreateTargetDataLayout( + TargetMachine_val(Machine))); +} + +/* bool -> TargetMachine.t -> unit */ +CAMLprim value llvm_targetmachine_set_verbose_asm(value Verb, value Machine) { + LLVMSetTargetMachineAsmVerbosity(TargetMachine_val(Machine), Bool_val(Verb)); + return Val_unit; +} + +/* Llvm.llmodule -> CodeGenFileType.t -> string -> TargetMachine.t -> unit */ +CAMLprim value llvm_targetmachine_emit_to_file(LLVMModuleRef Module, + value FileType, value FileName, value Machine) { + char *ErrorMessage; + + if(LLVMTargetMachineEmitToFile(TargetMachine_val(Machine), Module, + String_val(FileName), Int_val(FileType), + &ErrorMessage)) { + llvm_raise(*caml_named_value("Llvm_target.Error"), ErrorMessage); + } + + return Val_unit; +} + +/* Llvm.llmodule -> CodeGenFileType.t -> TargetMachine.t -> + Llvm.llmemorybuffer */ +CAMLprim LLVMMemoryBufferRef llvm_targetmachine_emit_to_memory_buffer( + LLVMModuleRef Module, value FileType, + value Machine) { + char *ErrorMessage; + LLVMMemoryBufferRef Buffer; + + if(LLVMTargetMachineEmitToMemoryBuffer(TargetMachine_val(Machine), Module, + Int_val(FileType), &ErrorMessage, + &Buffer)) { + llvm_raise(*caml_named_value("Llvm_target.Error"), ErrorMessage); + } + + return Buffer; +} + +/* TargetMachine.t -> Llvm.PassManager.t -> unit */ +CAMLprim value llvm_targetmachine_add_analysis_passes(LLVMPassManagerRef PM, + value Machine) { + LLVMAddAnalysisPasses(TargetMachine_val(Machine), PM); + return Val_unit; +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/CMakeLists.txt new file mode 100644 index 000000000..beb869401 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/CMakeLists.txt @@ -0,0 +1,5 @@ +add_subdirectory(ipo) +add_subdirectory(passmgr_builder) +add_subdirectory(scalar_opts) +add_subdirectory(utils) +add_subdirectory(vectorize) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/CMakeLists.txt new file mode 100644 index 000000000..4b8784fad --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_ipo + OCAML llvm_ipo + OCAMLDEP llvm + C ipo_ocaml + LLVM ipo) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c new file mode 100644 index 000000000..9fcaa1053 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c @@ -0,0 +1,110 @@ +/*===-- ipo_ocaml.c - LLVM OCaml Glue ---------------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Transforms/IPO.h" +#include "caml/mlvalues.h" +#include "caml/misc.h" + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_argument_promotion(LLVMPassManagerRef PM) { + LLVMAddArgumentPromotionPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_constant_merge(LLVMPassManagerRef PM) { + LLVMAddConstantMergePass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_merge_functions(LLVMPassManagerRef PM) { + LLVMAddMergeFunctionsPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_dead_arg_elimination(LLVMPassManagerRef PM) { + LLVMAddDeadArgEliminationPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_function_attrs(LLVMPassManagerRef PM) { + LLVMAddFunctionAttrsPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_function_inlining(LLVMPassManagerRef PM) { + LLVMAddFunctionInliningPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_always_inliner(LLVMPassManagerRef PM) { + LLVMAddAlwaysInlinerPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_global_dce(LLVMPassManagerRef PM) { + LLVMAddGlobalDCEPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_global_optimizer(LLVMPassManagerRef PM) { + LLVMAddGlobalOptimizerPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_ip_constant_propagation(LLVMPassManagerRef PM) { + LLVMAddIPConstantPropagationPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_prune_eh(LLVMPassManagerRef PM) { + LLVMAddPruneEHPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_ipsccp(LLVMPassManagerRef PM) { + LLVMAddIPSCCPPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> all_but_main:bool -> unit */ +CAMLprim value llvm_add_internalize(LLVMPassManagerRef PM, value AllButMain) { + LLVMAddInternalizePass(PM, Bool_val(AllButMain)); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_strip_dead_prototypes(LLVMPassManagerRef PM) { + LLVMAddStripDeadPrototypesPass(PM); + return Val_unit; +} + +/* [`Module] Llvm.PassManager.t -> unit */ +CAMLprim value llvm_add_strip_symbols(LLVMPassManagerRef PM) { + LLVMAddStripSymbolsPass(PM); + return Val_unit; +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml new file mode 100644 index 000000000..1fb5594fc --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml @@ -0,0 +1,53 @@ +(*===-- llvm_ipo.ml - LLVM OCaml Interface --------------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +external add_argument_promotion + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_argument_promotion" +external add_constant_merge + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_constant_merge" +external add_merge_functions + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_merge_functions" +external add_dead_arg_elimination + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_dead_arg_elimination" +external add_function_attrs + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_function_attrs" +external add_function_inlining + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_function_inlining" +external add_always_inliner + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_always_inliner" +external add_global_dce + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_global_dce" +external add_global_optimizer + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_global_optimizer" +external add_ipc_propagation + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_ip_constant_propagation" +external add_prune_eh + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_prune_eh" +external add_ipsccp + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_ipsccp" +external add_internalize + : [ `Module ] Llvm.PassManager.t -> all_but_main:bool -> unit + = "llvm_add_internalize" +external add_strip_dead_prototypes + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_strip_dead_prototypes" +external add_strip_symbols + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_strip_symbols" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli new file mode 100644 index 000000000..6507c5d92 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli @@ -0,0 +1,87 @@ +(*===-- llvm_ipo.mli - LLVM OCaml Interface -------------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** IPO Transforms. + + This interface provides an OCaml API for LLVM interprocedural optimizations, the + classes in the [LLVMIPO] library. *) + +(** See the [llvm::createAddArgumentPromotionPass] function. *) +external add_argument_promotion + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_argument_promotion" + +(** See the [llvm::createConstantMergePass] function. *) +external add_constant_merge + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_constant_merge" + +(** See the [llvm::createMergeFunctionsPass] function. *) +external add_merge_functions + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_merge_functions" + +(** See the [llvm::createDeadArgEliminationPass] function. *) +external add_dead_arg_elimination + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_dead_arg_elimination" + +(** See the [llvm::createFunctionAttrsPass] function. *) +external add_function_attrs + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_function_attrs" + +(** See the [llvm::createFunctionInliningPass] function. *) +external add_function_inlining + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_function_inlining" + +(** See the [llvm::createAlwaysInlinerPass] function. *) +external add_always_inliner + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_always_inliner" + +(** See the [llvm::createGlobalDCEPass] function. *) +external add_global_dce + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_global_dce" + +(** See the [llvm::createGlobalOptimizerPass] function. *) +external add_global_optimizer + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_global_optimizer" + +(** See the [llvm::createIPConstantPropagationPass] function. *) +external add_ipc_propagation + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_ip_constant_propagation" + +(** See the [llvm::createPruneEHPass] function. *) +external add_prune_eh + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_prune_eh" + +(** See the [llvm::createIPSCCPPass] function. *) +external add_ipsccp + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_ipsccp" + +(** See the [llvm::createInternalizePass] function. *) +external add_internalize + : [ `Module ] Llvm.PassManager.t -> all_but_main:bool -> unit + = "llvm_add_internalize" + +(** See the [llvm::createStripDeadPrototypesPass] function. *) +external add_strip_dead_prototypes + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_strip_dead_prototypes" + +(** See the [llvm::createStripSymbolsPass] function. *) +external add_strip_symbols + : [ `Module ] Llvm.PassManager.t -> unit + = "llvm_add_strip_symbols" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/CMakeLists.txt new file mode 100644 index 000000000..b012863d8 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_passmgr_builder + OCAML llvm_passmgr_builder + OCAMLDEP llvm + C passmgr_builder_ocaml + LLVM ipo) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/llvm_passmgr_builder.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/llvm_passmgr_builder.ml new file mode 100644 index 000000000..f143eaf26 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/llvm_passmgr_builder.ml @@ -0,0 +1,31 @@ +(*===-- llvm_passmgr_builder.ml - LLVM OCaml Interface --------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +type t + +external create : unit -> t + = "llvm_pmbuilder_create" +external set_opt_level : int -> t -> unit + = "llvm_pmbuilder_set_opt_level" +external set_size_level : int -> t -> unit + = "llvm_pmbuilder_set_size_level" +external set_disable_unit_at_a_time : bool -> t -> unit + = "llvm_pmbuilder_set_disable_unit_at_a_time" +external set_disable_unroll_loops : bool -> t -> unit + = "llvm_pmbuilder_set_disable_unroll_loops" +external use_inliner_with_threshold : int -> t -> unit + = "llvm_pmbuilder_use_inliner_with_threshold" +external populate_function_pass_manager + : [ `Function ] Llvm.PassManager.t -> t -> unit + = "llvm_pmbuilder_populate_function_pass_manager" +external populate_module_pass_manager + : [ `Module ] Llvm.PassManager.t -> t -> unit + = "llvm_pmbuilder_populate_module_pass_manager" +external populate_lto_pass_manager + : [ `Module ] Llvm.PassManager.t -> internalize:bool -> run_inliner:bool -> t -> unit + = "llvm_pmbuilder_populate_lto_pass_manager" \ No newline at end of file diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/llvm_passmgr_builder.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/llvm_passmgr_builder.mli new file mode 100644 index 000000000..8bb1005e6 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/llvm_passmgr_builder.mli @@ -0,0 +1,53 @@ +(*===-- llvm_passmgr_builder.mli - LLVM OCaml Interface -------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Pass Manager Builder. + + This interface provides an OCaml API for LLVM pass manager builder + from the [LLVMCore] library. *) + +type t + +(** See the [llvm::PassManagerBuilder] function. *) +external create : unit -> t + = "llvm_pmbuilder_create" + +(** See the [llvm::PassManagerBuilder::OptLevel] function. *) +external set_opt_level : int -> t -> unit + = "llvm_pmbuilder_set_opt_level" + +(** See the [llvm::PassManagerBuilder::SizeLevel] function. *) +external set_size_level : int -> t -> unit + = "llvm_pmbuilder_set_size_level" + +(** See the [llvm::PassManagerBuilder::DisableUnitAtATime] function. *) +external set_disable_unit_at_a_time : bool -> t -> unit + = "llvm_pmbuilder_set_disable_unit_at_a_time" + +(** See the [llvm::PassManagerBuilder::DisableUnrollLoops] function. *) +external set_disable_unroll_loops : bool -> t -> unit + = "llvm_pmbuilder_set_disable_unroll_loops" + +(** See the [llvm::PassManagerBuilder::Inliner] function. *) +external use_inliner_with_threshold : int -> t -> unit + = "llvm_pmbuilder_use_inliner_with_threshold" + +(** See the [llvm::PassManagerBuilder::populateFunctionPassManager] function. *) +external populate_function_pass_manager + : [ `Function ] Llvm.PassManager.t -> t -> unit + = "llvm_pmbuilder_populate_function_pass_manager" + +(** See the [llvm::PassManagerBuilder::populateModulePassManager] function. *) +external populate_module_pass_manager + : [ `Module ] Llvm.PassManager.t -> t -> unit + = "llvm_pmbuilder_populate_module_pass_manager" + +(** See the [llvm::PassManagerBuilder::populateLTOPassManager] function. *) +external populate_lto_pass_manager + : [ `Module ] Llvm.PassManager.t -> internalize:bool -> run_inliner:bool -> t -> unit + = "llvm_pmbuilder_populate_lto_pass_manager" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/passmgr_builder_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/passmgr_builder_ocaml.c new file mode 100644 index 000000000..6d1f72efd --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/passmgr_builder/passmgr_builder_ocaml.c @@ -0,0 +1,111 @@ +/*===-- passmgr_builder_ocaml.c - LLVM OCaml Glue ---------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Transforms/PassManagerBuilder.h" +#include "caml/mlvalues.h" +#include "caml/custom.h" +#include "caml/misc.h" + +#define PMBuilder_val(v) (*(LLVMPassManagerBuilderRef *)(Data_custom_val(v))) + +static void llvm_finalize_pmbuilder(value PMB) { + LLVMPassManagerBuilderDispose(PMBuilder_val(PMB)); +} + +static struct custom_operations pmbuilder_ops = { + (char *) "Llvm_passmgr_builder.t", + llvm_finalize_pmbuilder, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default, + custom_compare_ext_default +}; + +static value alloc_pmbuilder(LLVMPassManagerBuilderRef Ref) { + value Val = alloc_custom(&pmbuilder_ops, + sizeof(LLVMPassManagerBuilderRef), 0, 1); + PMBuilder_val(Val) = Ref; + return Val; +} + +/* t -> unit */ +CAMLprim value llvm_pmbuilder_create(value Unit) { + return alloc_pmbuilder(LLVMPassManagerBuilderCreate()); +} + +/* int -> t -> unit */ +CAMLprim value llvm_pmbuilder_set_opt_level(value OptLevel, value PMB) { + LLVMPassManagerBuilderSetOptLevel(PMBuilder_val(PMB), Int_val(OptLevel)); + return Val_unit; +} + +/* int -> t -> unit */ +CAMLprim value llvm_pmbuilder_set_size_level(value SizeLevel, value PMB) { + LLVMPassManagerBuilderSetSizeLevel(PMBuilder_val(PMB), Int_val(SizeLevel)); + return Val_unit; +} + +/* int -> t -> unit */ +CAMLprim value llvm_pmbuilder_use_inliner_with_threshold( + value Threshold, value PMB) { + LLVMPassManagerBuilderSetOptLevel(PMBuilder_val(PMB), Int_val(Threshold)); + return Val_unit; +} + +/* bool -> t -> unit */ +CAMLprim value llvm_pmbuilder_set_disable_unit_at_a_time( + value DisableUnitAtATime, value PMB) { + LLVMPassManagerBuilderSetDisableUnitAtATime( + PMBuilder_val(PMB), Bool_val(DisableUnitAtATime)); + return Val_unit; +} + +/* bool -> t -> unit */ +CAMLprim value llvm_pmbuilder_set_disable_unroll_loops( + value DisableUnroll, value PMB) { + LLVMPassManagerBuilderSetDisableUnrollLoops( + PMBuilder_val(PMB), Bool_val(DisableUnroll)); + return Val_unit; +} + +/* [ `Function ] Llvm.PassManager.t -> t -> unit */ +CAMLprim value llvm_pmbuilder_populate_function_pass_manager( + LLVMPassManagerRef PM, value PMB) { + LLVMPassManagerBuilderPopulateFunctionPassManager( + PMBuilder_val(PMB), PM); + return Val_unit; +} + +/* [ `Module ] Llvm.PassManager.t -> t -> unit */ +CAMLprim value llvm_pmbuilder_populate_module_pass_manager( + LLVMPassManagerRef PM, value PMB) { + LLVMPassManagerBuilderPopulateModulePassManager( + PMBuilder_val(PMB), PM); + return Val_unit; +} + +/* [ `Module ] Llvm.PassManager.t -> + internalize:bool -> run_inliner:bool -> t -> unit */ +CAMLprim value llvm_pmbuilder_populate_lto_pass_manager( + LLVMPassManagerRef PM, value Internalize, value RunInliner, + value PMB) { + LLVMPassManagerBuilderPopulateLTOPassManager( + PMBuilder_val(PMB), PM, + Bool_val(Internalize), Bool_val(RunInliner)); + return Val_unit; +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/CMakeLists.txt new file mode 100644 index 000000000..98c7c6861 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_scalar_opts + OCAML llvm_scalar_opts + OCAMLDEP llvm + C scalar_opts_ocaml + LLVM scalaropts) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/llvm_scalar_opts.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/llvm_scalar_opts.ml new file mode 100644 index 000000000..4d9055339 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/llvm_scalar_opts.ml @@ -0,0 +1,131 @@ +(*===-- llvm_scalar_opts.ml - LLVM OCaml Interface ------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +external add_aggressive_dce + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_aggressive_dce" +external add_dce + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_dce" +external add_alignment_from_assumptions + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_alignment_from_assumptions" +external add_cfg_simplification + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_cfg_simplification" +external add_dead_store_elimination + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_dead_store_elimination" +external add_scalarizer + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_scalarizer" +external add_merged_load_store_motion + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_merged_load_store_motion" +external add_gvn + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_gvn" +external add_ind_var_simplification + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_ind_var_simplify" +external add_instruction_combination + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_instruction_combining" +external add_jump_threading + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_jump_threading" +external add_licm + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_licm" +external add_loop_deletion + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_deletion" +external add_loop_idiom + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_idiom" +external add_loop_rotation + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_rotate" +external add_loop_reroll + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_reroll" +external add_loop_unroll + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_unroll" +external add_loop_unswitch + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_unswitch" +external add_memcpy_opt + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_memcpy_opt" +external add_partially_inline_lib_calls + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_partially_inline_lib_calls" +external add_lower_atomic + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_lower_atomic" +external add_lower_switch + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_lower_switch" +external add_memory_to_register_promotion + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_promote_memory_to_register" +external add_reassociation + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_reassociation" +external add_sccp + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_sccp" +external add_scalar_repl_aggregation + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_scalar_repl_aggregates" +external add_scalar_repl_aggregation_ssa + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_scalar_repl_aggregates_ssa" +external add_scalar_repl_aggregation_with_threshold + : int -> [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_scalar_repl_aggregates_with_threshold" +external add_lib_call_simplification + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_simplify_lib_calls" +external add_tail_call_elimination + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_tail_call_elimination" +external add_constant_propagation + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_constant_propagation" +external add_memory_to_register_demotion + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_demote_memory_to_register" +external add_verifier + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_verifier" +external add_correlated_value_propagation + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_correlated_value_propagation" +external add_early_cse + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_early_cse" +external add_lower_expect_intrinsic + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_lower_expect_intrinsic" +external add_lower_constant_intrinsics + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_lower_constant_intrinsics" +external add_type_based_alias_analysis + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_type_based_alias_analysis" +external add_scoped_no_alias_alias_analysis + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_scoped_no_alias_aa" +external add_basic_alias_analysis + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_basic_alias_analysis" +external add_unify_function_exit_nodes + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_unify_function_exit_nodes" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/llvm_scalar_opts.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/llvm_scalar_opts.mli new file mode 100644 index 000000000..117218f06 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/llvm_scalar_opts.mli @@ -0,0 +1,217 @@ +(*===-- llvm_scalar_opts.mli - LLVM OCaml Interface -----------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Scalar Transforms. + + This interface provides an OCaml API for LLVM scalar transforms, the + classes in the [LLVMScalarOpts] library. *) + +(** See the [llvm::createAggressiveDCEPass] function. *) +external add_aggressive_dce + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_aggressive_dce" + +(** See the [llvm::createDCEPass] function. *) +external add_dce + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_dce" + +(** See the [llvm::createAlignmentFromAssumptionsPass] function. *) +external add_alignment_from_assumptions + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_alignment_from_assumptions" + +(** See the [llvm::createCFGSimplificationPass] function. *) +external add_cfg_simplification + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_cfg_simplification" + +(** See [llvm::createDeadStoreEliminationPass] function. *) +external add_dead_store_elimination + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_dead_store_elimination" + +(** See [llvm::createScalarizerPass] function. *) +external add_scalarizer + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_scalarizer" + +(** See [llvm::createMergedLoadStoreMotionPass] function. *) +external add_merged_load_store_motion + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_merged_load_store_motion" + +(** See the [llvm::createGVNPass] function. *) +external add_gvn + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_gvn" + +(** See the [llvm::createIndVarSimplifyPass] function. *) +external add_ind_var_simplification + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_ind_var_simplify" + +(** See the [llvm::createInstructionCombiningPass] function. *) +external add_instruction_combination + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_instruction_combining" + +(** See the [llvm::createJumpThreadingPass] function. *) +external add_jump_threading + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_jump_threading" + +(** See the [llvm::createLICMPass] function. *) +external add_licm + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_licm" + +(** See the [llvm::createLoopDeletionPass] function. *) +external add_loop_deletion + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_deletion" + +(** See the [llvm::createLoopIdiomPass] function. *) +external add_loop_idiom + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_idiom" + +(** See the [llvm::createLoopRotatePass] function. *) +external add_loop_rotation + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_rotate" + +(** See the [llvm::createLoopRerollPass] function. *) +external add_loop_reroll + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_reroll" + +(** See the [llvm::createLoopUnrollPass] function. *) +external add_loop_unroll + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_unroll" + +(** See the [llvm::createLoopUnswitchPass] function. *) +external add_loop_unswitch + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_loop_unswitch" + +(** See the [llvm::createMemCpyOptPass] function. *) +external add_memcpy_opt + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_memcpy_opt" + +(** See the [llvm::createPartiallyInlineLibCallsPass] function. *) +external add_partially_inline_lib_calls + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_partially_inline_lib_calls" + +(** See the [llvm::createLowerAtomicPass] function. *) +external add_lower_atomic + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_lower_atomic" + +(** See the [llvm::createLowerSwitchPass] function. *) +external add_lower_switch + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_lower_switch" + +(** See the [llvm::createPromoteMemoryToRegisterPass] function. *) +external add_memory_to_register_promotion + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_promote_memory_to_register" + +(** See the [llvm::createReassociatePass] function. *) +external add_reassociation + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_reassociation" + +(** See the [llvm::createSCCPPass] function. *) +external add_sccp + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_sccp" + +(** See the [llvm::createSROAPass] function. *) +external add_scalar_repl_aggregation + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_scalar_repl_aggregates" + +(** See the [llvm::createSROAPass] function. *) +external add_scalar_repl_aggregation_ssa + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_scalar_repl_aggregates_ssa" + +(** See the [llvm::createSROAPass] function. *) +external add_scalar_repl_aggregation_with_threshold + : int -> [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_scalar_repl_aggregates_with_threshold" + +(** See the [llvm::createSimplifyLibCallsPass] function. *) +external add_lib_call_simplification + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_simplify_lib_calls" + +(** See the [llvm::createTailCallEliminationPass] function. *) +external add_tail_call_elimination + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_tail_call_elimination" + +(** See the [llvm::createConstantPropagationPass] function. *) +external add_constant_propagation + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_constant_propagation" + +(** See the [llvm::createDemoteMemoryToRegisterPass] function. *) +external add_memory_to_register_demotion + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_demote_memory_to_register" + +(** See the [llvm::createVerifierPass] function. *) +external add_verifier + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_verifier" + +(** See the [llvm::createCorrelatedValuePropagationPass] function. *) +external add_correlated_value_propagation + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_correlated_value_propagation" + +(** See the [llvm::createEarlyCSE] function. *) +external add_early_cse + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_early_cse" + +(** See the [llvm::createLowerExpectIntrinsicPass] function. *) +external add_lower_expect_intrinsic + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_lower_expect_intrinsic" + +(** See the [llvm::createLowerConstantIntrinsicsPass] function. *) +external add_lower_constant_intrinsics + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_lower_constant_intrinsics" + +(** See the [llvm::createTypeBasedAliasAnalysisPass] function. *) +external add_type_based_alias_analysis + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_type_based_alias_analysis" + +(** See the [llvm::createScopedNoAliasAAPass] function. *) +external add_scoped_no_alias_alias_analysis + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_scoped_no_alias_aa" + +(** See the [llvm::createBasicAliasAnalysisPass] function. *) +external add_basic_alias_analysis + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_basic_alias_analysis" + +(** See the [llvm::createUnifyFunctionExitNodesPass] function. *) +external add_unify_function_exit_nodes + : [< Llvm.PassManager.any ] Llvm.PassManager.t -> unit + = "llvm_add_unify_function_exit_nodes" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/scalar_opts_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/scalar_opts_ocaml.c new file mode 100644 index 000000000..8d10989bd --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/scalar_opts/scalar_opts_ocaml.c @@ -0,0 +1,267 @@ +/*===-- scalar_opts_ocaml.c - LLVM OCaml Glue -------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Transforms/Scalar.h" +#include "llvm-c/Transforms/Utils.h" +#include "caml/mlvalues.h" +#include "caml/misc.h" + +/* [ unit */ +CAMLprim value llvm_add_aggressive_dce(LLVMPassManagerRef PM) { + LLVMAddAggressiveDCEPass(PM); + return Val_unit; +} + +CAMLprim value llvm_add_dce(LLVMPassManagerRef PM) { + LLVMAddDCEPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_alignment_from_assumptions(LLVMPassManagerRef PM) { + LLVMAddAlignmentFromAssumptionsPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_cfg_simplification(LLVMPassManagerRef PM) { + LLVMAddCFGSimplificationPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_dead_store_elimination(LLVMPassManagerRef PM) { + LLVMAddDeadStoreEliminationPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_scalarizer(LLVMPassManagerRef PM) { + LLVMAddScalarizerPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_merged_load_store_motion(LLVMPassManagerRef PM) { + LLVMAddMergedLoadStoreMotionPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_gvn(LLVMPassManagerRef PM) { + LLVMAddGVNPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_ind_var_simplify(LLVMPassManagerRef PM) { + LLVMAddIndVarSimplifyPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_instruction_combining(LLVMPassManagerRef PM) { + LLVMAddInstructionCombiningPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_jump_threading(LLVMPassManagerRef PM) { + LLVMAddJumpThreadingPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_licm(LLVMPassManagerRef PM) { + LLVMAddLICMPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_loop_deletion(LLVMPassManagerRef PM) { + LLVMAddLoopDeletionPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_loop_idiom(LLVMPassManagerRef PM) { + LLVMAddLoopIdiomPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_loop_rotate(LLVMPassManagerRef PM) { + LLVMAddLoopRotatePass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_loop_reroll(LLVMPassManagerRef PM) { + LLVMAddLoopRerollPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_loop_unroll(LLVMPassManagerRef PM) { + LLVMAddLoopUnrollPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_loop_unswitch(LLVMPassManagerRef PM) { + LLVMAddLoopUnswitchPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_memcpy_opt(LLVMPassManagerRef PM) { + LLVMAddMemCpyOptPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_partially_inline_lib_calls(LLVMPassManagerRef PM) { + LLVMAddPartiallyInlineLibCallsPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_lower_atomic(LLVMPassManagerRef PM) { + LLVMAddLowerAtomicPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_lower_switch(LLVMPassManagerRef PM) { + LLVMAddLowerSwitchPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_promote_memory_to_register(LLVMPassManagerRef PM) { + LLVMAddPromoteMemoryToRegisterPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_reassociation(LLVMPassManagerRef PM) { + LLVMAddReassociatePass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_sccp(LLVMPassManagerRef PM) { + LLVMAddSCCPPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_scalar_repl_aggregates(LLVMPassManagerRef PM) { + LLVMAddScalarReplAggregatesPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_scalar_repl_aggregates_ssa(LLVMPassManagerRef PM) { + LLVMAddScalarReplAggregatesPassSSA(PM); + return Val_unit; +} + +/* int -> [ unit */ +CAMLprim value llvm_add_scalar_repl_aggregates_with_threshold(value threshold, + LLVMPassManagerRef PM) { + LLVMAddScalarReplAggregatesPassWithThreshold(PM, Int_val(threshold)); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_simplify_lib_calls(LLVMPassManagerRef PM) { + LLVMAddSimplifyLibCallsPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_tail_call_elimination(LLVMPassManagerRef PM) { + LLVMAddTailCallEliminationPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_constant_propagation(LLVMPassManagerRef PM) { + LLVMAddConstantPropagationPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_demote_memory_to_register(LLVMPassManagerRef PM) { + LLVMAddDemoteMemoryToRegisterPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_verifier(LLVMPassManagerRef PM) { + LLVMAddVerifierPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_correlated_value_propagation(LLVMPassManagerRef PM) { + LLVMAddCorrelatedValuePropagationPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_early_cse(LLVMPassManagerRef PM) { + LLVMAddEarlyCSEPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_lower_expect_intrinsic(LLVMPassManagerRef PM) { + LLVMAddLowerExpectIntrinsicPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_lower_constant_intrinsics(LLVMPassManagerRef PM) { + LLVMAddLowerConstantIntrinsicsPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_type_based_alias_analysis(LLVMPassManagerRef PM) { + LLVMAddTypeBasedAliasAnalysisPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_scoped_no_alias_aa(LLVMPassManagerRef PM) { + LLVMAddScopedNoAliasAAPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_basic_alias_analysis(LLVMPassManagerRef PM) { + LLVMAddBasicAliasAnalysisPass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_unify_function_exit_nodes(LLVMPassManagerRef PM) { + LLVMAddUnifyFunctionExitNodesPass(PM); + return Val_unit; +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/CMakeLists.txt new file mode 100644 index 000000000..37f3eb7d8 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_transform_utils + OCAML llvm_transform_utils + OCAMLDEP llvm + C transform_utils_ocaml + LLVM transformutils) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/llvm_transform_utils.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/llvm_transform_utils.ml new file mode 100644 index 000000000..20a50b107 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/llvm_transform_utils.ml @@ -0,0 +1,9 @@ +(*===-- llvm_transform_utils.ml - LLVM OCaml Interface --------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +external clone_module : Llvm.llmodule -> Llvm.llmodule = "llvm_clone_module" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/llvm_transform_utils.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/llvm_transform_utils.mli new file mode 100644 index 000000000..536f41dc4 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/llvm_transform_utils.mli @@ -0,0 +1,16 @@ +(*===-- llvm_transform_utils.mli - LLVM OCaml Interface -------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Transform Utilities. + + This interface provides an OCaml API for LLVM transform utilities, the + classes in the [LLVMTransformUtils] library. *) + +(** [clone_module m] returns an exact copy of module [m]. + See the [llvm::CloneModule] function. *) +external clone_module : Llvm.llmodule -> Llvm.llmodule = "llvm_clone_module" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/transform_utils_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/transform_utils_ocaml.c new file mode 100644 index 000000000..918eec146 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/utils/transform_utils_ocaml.c @@ -0,0 +1,31 @@ +/*===-- transform_utils_ocaml.c - LLVM OCaml Glue ---------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Core.h" +#include "caml/mlvalues.h" +#include "caml/misc.h" + +/* + * Do not move directly into external. This function is here to pull in + * -lLLVMTransformUtils, which would otherwise be not linked on static builds, + * as ld can't see the reference from OCaml code. + */ + +/* llmodule -> llmodule */ +CAMLprim LLVMModuleRef llvm_clone_module(LLVMModuleRef M) { + return LLVMCloneModule(M); +} diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/CMakeLists.txt b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/CMakeLists.txt new file mode 100644 index 000000000..af0ffce56 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/CMakeLists.txt @@ -0,0 +1,5 @@ +add_ocaml_library(llvm_vectorize + OCAML llvm_vectorize + OCAMLDEP llvm + C vectorize_ocaml + LLVM vectorize) diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/llvm_vectorize.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/llvm_vectorize.ml new file mode 100644 index 000000000..a2e280e15 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/llvm_vectorize.ml @@ -0,0 +1,14 @@ +(*===-- llvm_vectorize.ml - LLVM OCaml Interface --------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +external add_loop_vectorize + : [ unit + = "llvm_add_loop_vectorize" +external add_slp_vectorize + : [ unit + = "llvm_add_slp_vectorize" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/llvm_vectorize.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/llvm_vectorize.mli new file mode 100644 index 000000000..7376d9e6d --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/llvm_vectorize.mli @@ -0,0 +1,22 @@ +(*===-- llvm_vectorize.mli - LLVM OCaml Interface -------------*- OCaml -*-===* + * + * Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. + * See https://llvm.org/LICENSE.txt for license information. + * SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception + * + *===----------------------------------------------------------------------===*) + +(** Vectorize Transforms. + + This interface provides an OCaml API for LLVM vectorize transforms, the + classes in the [LLVMVectorize] library. *) + +(** See the [llvm::createLoopVectorizePass] function. *) +external add_loop_vectorize + : [ unit + = "llvm_add_loop_vectorize" + +(** See the [llvm::createSLPVectorizerPass] function. *) +external add_slp_vectorize + : [ unit + = "llvm_add_slp_vectorize" diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/vectorize_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/vectorize_ocaml.c new file mode 100644 index 000000000..ba9c132c8 --- /dev/null +++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/vectorize/vectorize_ocaml.c @@ -0,0 +1,32 @@ +/*===-- vectorize_ocaml.c - LLVM OCaml Glue ---------------------*- C++ -*-===*\ +|* *| +|* Part of the LLVM Project, under the Apache License v2.0 with LLVM *| +|* Exceptions. *| +|* See https://llvm.org/LICENSE.txt for license information. *| +|* SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception *| +|* *| +|*===----------------------------------------------------------------------===*| +|* *| +|* This file glues LLVM's OCaml interface to its C interface. These functions *| +|* are by and large transparent wrappers to the corresponding C functions. *| +|* *| +|* Note that these functions intentionally take liberties with the CAMLparamX *| +|* macros, since most of the parameters are not GC heap objects. *| +|* *| +\*===----------------------------------------------------------------------===*/ + +#include "llvm-c/Transforms/Vectorize.h" +#include "caml/mlvalues.h" +#include "caml/misc.h" + +/* [ unit */ +CAMLprim value llvm_add_loop_vectorize(LLVMPassManagerRef PM) { + LLVMAddLoopVectorizePass(PM); + return Val_unit; +} + +/* [ unit */ +CAMLprim value llvm_add_slp_vectorize(LLVMPassManagerRef PM) { + LLVMAddSLPVectorizePass(PM); + return Val_unit; +}