aboutsummaryrefslogtreecommitdiffstats
path: root/bindings
diff options
context:
space:
mode:
authorGordon Henriksen <gordonhenriksen@mac.com>2007-09-18 12:49:39 +0000
committerGordon Henriksen <gordonhenriksen@mac.com>2007-09-18 12:49:39 +0000
commit8ef426baa36639458f6777309db25c1768dc9c8a (patch)
tree45ef09f427e18bbf1afd9fd552a3d9fbf0f9e398 /bindings
parent54c7e1216415172ac1a2aaafa32668c97f845a2c (diff)
downloadexternal_llvm-8ef426baa36639458f6777309db25c1768dc9c8a.zip
external_llvm-8ef426baa36639458f6777309db25c1768dc9c8a.tar.gz
external_llvm-8ef426baa36639458f6777309db25c1768dc9c8a.tar.bz2
Adding ocaml language bindings for the vmcore and bitwriter libraries. These are
built atop the C language bindings, and user programs can link with them as such: # Bytecode ocamlc -cc g++ llvm.cma llvmbitwriter.cma -o example example.ml # Native ocamlopt -cc g++ llvm.cmxa llvmbitwriter.cmxa -o example.opt example.ml The vmcore.ml test exercises most/all of the APIs thus far bound. Unfortunately, they're not yet numerous enough to write hello world. But: $ cat example.ml (* example.ml *) open Llvm open Llvm_bitwriter let _ = let filename = Sys.argv.(1) in let m = create_module filename in let v = make_int_constant i32_type 42 false in let g = define_global "hello_world" v m in if not (write_bitcode_file m filename) then exit 1; dispose_module m; $ ocamlc -cc g++ llvm.cma llvm_bitwriter.cma -o example example.ml File "example.ml", line 11, characters 6-7: Warning Y: unused variable g. $ ./example example.bc $ llvm-dis < example.bc ; ModuleID = '<stdin>' @hello_world = global i32 42 ; <i32*> [#uses=0] The ocaml test cases provide effective tests for the C interfaces. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@42093 91177308-0d34-0410-b5e6-96231b3b80d8
Diffstat (limited to 'bindings')
-rw-r--r--bindings/Makefile18
-rw-r--r--bindings/README.txt3
-rw-r--r--bindings/ocaml/Makefile13
-rw-r--r--bindings/ocaml/bitwriter/Makefile23
-rw-r--r--bindings/ocaml/bitwriter/bitwriter_ocaml.c31
-rw-r--r--bindings/ocaml/bitwriter/llvm_bitwriter.ml18
-rw-r--r--bindings/ocaml/bitwriter/llvm_bitwriter.mli18
-rw-r--r--bindings/ocaml/llvm/Makefile24
-rw-r--r--bindings/ocaml/llvm/llvm.ml228
-rw-r--r--bindings/ocaml/llvm/llvm.mli170
-rw-r--r--bindings/ocaml/llvm/llvm_ocaml.c410
11 files changed, 956 insertions, 0 deletions
diff --git a/bindings/Makefile b/bindings/Makefile
new file mode 100644
index 0000000..82f84bc
--- /dev/null
+++ b/bindings/Makefile
@@ -0,0 +1,18 @@
+##===- bindings/Makefile -----------------------------------*- Makefile -*-===##
+#
+# The LLVM Compiler Infrastructure
+#
+# This file was developed by Gordon Henriksen and is distributed under the
+# University of Illinois Open Source License. See LICENSE.TXT for details.
+#
+##===----------------------------------------------------------------------===##
+
+LEVEL := ..
+
+include $(LEVEL)/Makefile.config
+
+ifdef OCAMLC
+PARALLEL_DIRS += ocaml
+endif
+
+include $(LEVEL)/Makefile.common
diff --git a/bindings/README.txt b/bindings/README.txt
new file mode 100644
index 0000000..7693cb2
--- /dev/null
+++ b/bindings/README.txt
@@ -0,0 +1,3 @@
+This directory contains bindings for the LLVM compiler infrastructure to allow
+programs written in languages other than C or C++ to take advantage of the LLVM
+infrastructure--for instance, a self-hosted compiler front-end.
diff --git a/bindings/ocaml/Makefile b/bindings/ocaml/Makefile
new file mode 100644
index 0000000..0fc6b1b
--- /dev/null
+++ b/bindings/ocaml/Makefile
@@ -0,0 +1,13 @@
+##===- bindings/ocaml/Makefile -----------------------------*- Makefile -*-===##
+#
+# The LLVM Compiler Infrastructure
+#
+# This file was developed by Gordon Henriksen and is distributed under the
+# University of Illinois Open Source License. See LICENSE.TXT for details.
+#
+##===----------------------------------------------------------------------===##
+
+LEVEL := ../..
+DIRS = llvm bitwriter
+
+include $(LEVEL)/Makefile.common
diff --git a/bindings/ocaml/bitwriter/Makefile b/bindings/ocaml/bitwriter/Makefile
new file mode 100644
index 0000000..aef41f5
--- /dev/null
+++ b/bindings/ocaml/bitwriter/Makefile
@@ -0,0 +1,23 @@
+##===- bindings/ocaml/llvm/Makefile ------------------------*- Makefile -*-===##
+#
+# The LLVM Compiler Infrastructure
+#
+# This file was developed by the LLVM research group and is distributed under
+# the University of Illinois Open Source License. See LICENSE.TXT for details.
+#
+##===----------------------------------------------------------------------===##
+#
+# This is the makefile for the llvm-ml interface. Reference materials on
+# installing ocaml libraries:
+#
+# https://fedoraproject.org/wiki/Packaging/OCaml
+# http://pkg-ocaml-maint.alioth.debian.org/ocaml_packaging_policy.txt
+#
+##===----------------------------------------------------------------------===##
+
+LEVEL := ../../..
+LIBRARYNAME := llvm_bitwriter
+DONT_BUILD_RELINKED := 1
+UsedComponents := bitwriter
+
+include ../Makefile.ocaml
diff --git a/bindings/ocaml/bitwriter/bitwriter_ocaml.c b/bindings/ocaml/bitwriter/bitwriter_ocaml.c
new file mode 100644
index 0000000..4abfa9f
--- /dev/null
+++ b/bindings/ocaml/bitwriter/bitwriter_ocaml.c
@@ -0,0 +1,31 @@
+/*===-- bitwriter_ocaml.c - LLVM Ocaml Glue ---------------------*- C++ -*-===*\
+|* *|
+|* The LLVM Compiler Infrastructure *|
+|* *|
+|* This file was developed by Gordon Henriksen and is distributed under the *|
+|* University of Illinois Open Source License. See LICENSE.TXT for details. *|
+|* *|
+|*===----------------------------------------------------------------------===*|
+|* *|
+|* This file 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"
+
+/*===-- Modules -----------------------------------------------------------===*/
+
+/* Llvm.llmodule -> string -> bool */
+CAMLprim value llvm_write_bitcode_file(value M, value Path) {
+ CAMLparam1(Path);
+ int res = LLVMWriteBitcodeToFile((LLVMModuleRef) M, String_val(Path));
+ CAMLreturn(Val_bool(res == 0));
+}
diff --git a/bindings/ocaml/bitwriter/llvm_bitwriter.ml b/bindings/ocaml/bitwriter/llvm_bitwriter.ml
new file mode 100644
index 0000000..c9264b1
--- /dev/null
+++ b/bindings/ocaml/bitwriter/llvm_bitwriter.ml
@@ -0,0 +1,18 @@
+(*===-- llvm_bitwriter.ml - LLVM Ocaml Interface ----------------*- C++ -*-===*
+ *
+ * The LLVM Compiler Infrastructure
+ *
+ * This file was developed by Gordon Henriksen and is distributed under the
+ * University of Illinois Open Source License. See LICENSE.TXT for details.
+ *
+ *===----------------------------------------------------------------------===
+ *
+ * This interface provides an ocaml API for the LLVM intermediate
+ * representation, the classes in the VMCore library.
+ *
+ *===----------------------------------------------------------------------===*)
+
+
+(* Writes the bitcode for module the given path. Returns true if successful. *)
+external write_bitcode_file : Llvm.llmodule -> string -> bool
+ = "llvm_write_bitcode_file"
diff --git a/bindings/ocaml/bitwriter/llvm_bitwriter.mli b/bindings/ocaml/bitwriter/llvm_bitwriter.mli
new file mode 100644
index 0000000..3b7c6d4
--- /dev/null
+++ b/bindings/ocaml/bitwriter/llvm_bitwriter.mli
@@ -0,0 +1,18 @@
+(*===-- llvm_bitwriter.mli - LLVM Ocaml Interface ---------------*- C++ -*-===*
+ *
+ * The LLVM Compiler Infrastructure
+ *
+ * This file was developed by Gordon Henriksen and is distributed under the
+ * University of Illinois Open Source License. See LICENSE.TXT for details.
+ *
+ *===----------------------------------------------------------------------===
+ *
+ * This interface provides an ocaml API for the LLVM bitcode writer, the
+ * classes in the classes in the Bitwriter library.
+ *
+ *===----------------------------------------------------------------------===*)
+
+
+(* Writes the bitcode for module the given path. Returns true if successful. *)
+external write_bitcode_file : Llvm.llmodule -> string -> bool
+ = "llvm_write_bitcode_file"
diff --git a/bindings/ocaml/llvm/Makefile b/bindings/ocaml/llvm/Makefile
new file mode 100644
index 0000000..cbfb75c
--- /dev/null
+++ b/bindings/ocaml/llvm/Makefile
@@ -0,0 +1,24 @@
+##===- bindings/ocaml/bitwriter/Makefile -------------------*- Makefile -*-===##
+#
+# The LLVM Compiler Infrastructure
+#
+# This file was developed by the LLVM research group and is distributed under
+# the University of Illinois Open Source License. See LICENSE.TXT for details.
+#
+##===----------------------------------------------------------------------===##
+#
+# This is the makefile for the llvm-ml interface. Reference materials on
+# installing ocaml libraries:
+#
+# https://fedoraproject.org/wiki/Packaging/OCaml
+# http://pkg-ocaml-maint.alioth.debian.org/ocaml_packaging_policy.txt
+#
+##===----------------------------------------------------------------------===##
+
+LEVEL := ../../..
+LIBRARYNAME := llvm
+DONT_BUILD_RELINKED := 1
+UsedComponents := core
+UsedOcamLibs := llvm
+
+include ../Makefile.ocaml
diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
new file mode 100644
index 0000000..18a9e21
--- /dev/null
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -0,0 +1,228 @@
+(*===-- tools/ml/llvm.ml - LLVM Ocaml Interface ---------------------------===*
+ *
+ * The LLVM Compiler Infrastructure
+ *
+ * This file was developed by Gordon Henriksen and is distributed under the
+ * University of Illinois Open Source License. See LICENSE.TXT for details.
+ *
+ *===----------------------------------------------------------------------===
+ *
+ * This interface provides an ocaml API for the LLVM intermediate
+ * representation, the classes in the VMCore library.
+ *
+ *===----------------------------------------------------------------------===*)
+
+
+(* These abstract types correlate directly to the LLVM VMCore classes. *)
+type llmodule
+type lltype
+type llvalue
+
+type type_kind =
+ Void_type
+| Float_type
+| Double_type
+| X86fp80_type
+| Fp128_type
+| Ppc_fp128_type
+| Label_type
+| Integer_type
+| Function_type
+| Struct_type
+| Array_type
+| Pointer_type
+| Opaque_type
+| Vector_type
+
+type linkage =
+ External_linkage
+| Link_once_linkage
+| Weak_linkage
+| Appending_linkage
+| Internal_linkage
+| Dllimport_linkage
+| Dllexport_linkage
+| External_weak_linkage
+| Ghost_linkage
+
+type visibility =
+ Default_visibility
+| Hidden_visibility
+| Protected_visibility
+
+
+(*===-- Modules -----------------------------------------------------------===*)
+
+(* Creates a module with the supplied module ID. Modules are not garbage
+ collected; it is mandatory to call dispose_module to free memory. *)
+external create_module : string -> llmodule = "llvm_create_module"
+
+(* Disposes a module. All references to subordinate objects are invalidated;
+ referencing them will invoke undefined behavior. *)
+external dispose_module : llmodule -> unit = "llvm_dispose_module"
+
+(* Adds a named type to the module's symbol table. Returns true if successful.
+ If such a name already exists, then no entry is added and returns false. *)
+external add_type_name : string -> lltype -> llmodule -> bool
+ = "llvm_add_type_name"
+
+
+(*===-- Types -------------------------------------------------------------===*)
+
+external classify_type : lltype -> type_kind = "llvm_classify_type"
+external refine_abstract_type : lltype -> lltype -> unit
+ = "llvm_refine_abstract_type"
+
+(*--... Operations on integer types ........................................--*)
+external _i1_type : unit -> lltype = "llvm_i1_type"
+external _i8_type : unit -> lltype = "llvm_i8_type"
+external _i16_type : unit -> lltype = "llvm_i16_type"
+external _i32_type : unit -> lltype = "llvm_i32_type"
+external _i64_type : unit -> lltype = "llvm_i64_type"
+
+let i1_type = _i1_type ()
+let i8_type = _i8_type ()
+let i16_type = _i16_type ()
+let i32_type = _i32_type ()
+let i64_type = _i64_type ()
+
+external make_integer_type : int -> lltype = "llvm_make_integer_type"
+external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth"
+
+(*--... Operations on real types ...........................................--*)
+external _float_type : unit -> lltype = "llvm_float_type"
+external _double_type : unit -> lltype = "llvm_double_type"
+external _x86fp80_type : unit -> lltype = "llvm_x86fp80_type"
+external _fp128_type : unit -> lltype = "llvm_fp128_type"
+external _ppc_fp128_type : unit -> lltype = "llvm_ppc_fp128_type"
+
+let float_type = _float_type ()
+let double_type = _double_type ()
+let x86fp80_type = _x86fp80_type ()
+let fp128_type = _fp128_type ()
+let ppc_fp128_type = _ppc_fp128_type ()
+
+(*--... Operations on function types .......................................--*)
+(* FIXME: handle parameter attributes *)
+external make_function_type : lltype -> lltype array -> bool -> lltype
+ = "llvm_make_function_type"
+external is_var_arg : lltype -> bool = "llvm_is_var_arg"
+external return_type : lltype -> lltype = "llvm_return_type"
+external param_types : lltype -> lltype array = "llvm_param_types"
+
+(*--... Operations on struct types .........................................--*)
+external make_struct_type : lltype array -> bool -> lltype
+ = "llvm_make_struct_type"
+external element_types : lltype -> lltype array = "llvm_element_types"
+external is_packed : lltype -> bool = "llvm_is_packed"
+
+(*--... Operations on pointer, vector, and array types .....................--*)
+external make_array_type : lltype -> int -> lltype = "llvm_make_array_type"
+external make_pointer_type : lltype -> lltype = "llvm_make_pointer_type"
+external make_vector_type : lltype -> int -> lltype = "llvm_make_vector_type"
+
+external element_type : lltype -> lltype = "llvm_element_type"
+external array_length : lltype -> int = "llvm_array_length"
+external vector_size : lltype -> int = "llvm_vector_size"
+
+(*--... Operations on other types ..........................................--*)
+external make_opaque_type : unit -> lltype = "llvm_make_opaque_type"
+external _void_type : unit -> lltype = "llvm_void_type"
+external _label_type : unit -> lltype = "llvm_label_type"
+
+let void_type = _void_type ()
+let label_type = _label_type ()
+
+
+(*===-- 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"
+
+(*--... Operations on constants of (mostly) any type .......................--*)
+external make_null : lltype -> llvalue = "llvm_make_null"
+external make_all_ones : lltype -> llvalue = "llvm_make_all_ones"
+external make_undef : lltype -> llvalue = "llvm_make_undef"
+external is_null : llvalue -> bool = "llvm_is_null"
+
+(*--... Operations on scalar constants .....................................--*)
+external make_int_constant : lltype -> int -> bool -> llvalue
+ = "llvm_make_int_constant"
+external make_real_constant : lltype -> float -> llvalue
+ = "llvm_make_real_constant"
+
+(*--... Operations on composite constants ..................................--*)
+external make_string_constant : string -> bool -> llvalue
+ = "llvm_make_string_constant"
+external make_array_constant : lltype -> llvalue array -> llvalue
+ = "llvm_make_array_constant"
+external make_struct_constant : llvalue array -> bool -> llvalue
+ = "llvm_make_struct_constant"
+external make_vector_constant : llvalue array -> llvalue
+ = "llvm_make_vector_constant"
+
+(*--... Operations on global variables, functions, and aliases (globals) ...--*)
+external is_declaration : llvalue -> bool = "llvm_is_declaration"
+external linkage : llvalue -> linkage = "llvm_linkage"
+external set_linkage : linkage -> llvalue -> unit = "llvm_set_linkage"
+external section : llvalue -> string = "llvm_section"
+external set_section : string -> llvalue -> unit = "llvm_set_section"
+external visibility : llvalue -> visibility = "llvm_visibility"
+external set_visibility : visibility -> llvalue -> unit = "llvm_set_visibility"
+external alignment : llvalue -> int = "llvm_alignment"
+external set_alignment : int -> llvalue -> unit = "llvm_set_alignment"
+
+(*--... Operations on global variables .....................................--*)
+external declare_global : lltype -> string -> llmodule -> llvalue
+ = "llvm_declare_global"
+external define_global : string -> llvalue -> llmodule -> llvalue
+ = "llvm_define_global"
+external delete_global : llvalue -> unit = "llvm_delete_global"
+external global_initializer : llvalue -> llvalue = "llvm_global_initializer"
+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"
+
+
+(*===-- Non-Externs -------------------------------------------------------===*)
+(* These functions are built using the externals, so must be declared late. *)
+
+let concat2 sep arr =
+ let s = ref "" in
+ if 0 < Array.length arr then begin
+ s := !s ^ arr.(0);
+ for i = 1 to (Array.length arr) - 1 do
+ s := !s ^ sep ^ arr.(i)
+ done
+ end;
+ !s
+
+let rec string_of_lltype ty =
+ match classify_type ty with
+ Integer_type -> "i" ^ string_of_int (integer_bitwidth ty)
+ | Pointer_type -> (string_of_lltype (element_type ty)) ^ "*"
+ | Struct_type ->
+ let s = "{ " ^ (concat2 ", " (
+ Array.map string_of_lltype (element_types ty)
+ )) ^ " }" in
+ if is_packed ty
+ then "<" ^ s ^ ">"
+ else s
+ | Array_type -> "[" ^ (string_of_int (array_length ty)) ^
+ " x " ^ (string_of_lltype (element_type ty)) ^ "]"
+ | Vector_type -> "<" ^ (string_of_int (vector_size ty)) ^
+ " x " ^ (string_of_lltype (element_type ty)) ^ ">"
+ | Opaque_type -> "opaque"
+ | Function_type -> string_of_lltype (return_type ty) ^
+ " (" ^ (concat2 ", " (
+ Array.map string_of_lltype (param_types ty)
+ )) ^ ")"
+ | Label_type -> "label"
+ | Ppc_fp128_type -> "ppc_fp128"
+ | Fp128_type -> "fp128"
+ | X86fp80_type -> "x86_fp80"
+ | Double_type -> "double"
+ | Float_type -> "float"
+ | Void_type -> "void"
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
new file mode 100644
index 0000000..7e14cd7
--- /dev/null
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -0,0 +1,170 @@
+(*===-- tools/ml/llvm.ml - LLVM Ocaml Interface ---------------------------===*
+ *
+ * The LLVM Compiler Infrastructure
+ *
+ * This file was developed by Gordon Henriksen and is distributed under the
+ * University of Illinois Open Source License. See LICENSE.TXT for details.
+ *
+ *===----------------------------------------------------------------------===
+ *
+ * This interface provides an ocaml API for the LLVM intermediate
+ * representation, the classes in the VMCore library.
+ *
+ *===----------------------------------------------------------------------===*)
+
+
+(* These abstract types correlate directly to the LLVM VMCore classes. *)
+type llmodule
+type lltype
+type llvalue
+
+type type_kind =
+ Void_type
+| Float_type
+| Double_type
+| X86fp80_type
+| Fp128_type
+| Ppc_fp128_type
+| Label_type
+| Integer_type
+| Function_type
+| Struct_type
+| Array_type
+| Pointer_type
+| Opaque_type
+| Vector_type
+
+type linkage =
+ External_linkage
+| Link_once_linkage
+| Weak_linkage
+| Appending_linkage
+| Internal_linkage
+| Dllimport_linkage
+| Dllexport_linkage
+| External_weak_linkage
+| Ghost_linkage
+
+type visibility =
+ Default_visibility
+| Hidden_visibility
+| Protected_visibility
+
+
+(*===-- Modules -----------------------------------------------------------===*)
+
+(* Creates a module with the supplied module ID. Modules are not garbage
+ collected; it is mandatory to call dispose_module to free memory. *)
+external create_module : string -> llmodule = "llvm_create_module"
+
+(* Disposes a module. All references to subordinate objects are invalidated;
+ referencing them will invoke undefined behavior. *)
+external dispose_module : llmodule -> unit = "llvm_dispose_module"
+
+(* Adds a named type to the module's symbol table. Returns true if successful.
+ If such a name already exists, then no entry is added and returns false. *)
+external add_type_name : string -> lltype -> llmodule -> bool
+ = "llvm_add_type_name"
+
+
+(*===-- Types -------------------------------------------------------------===*)
+external classify_type : lltype -> type_kind = "llvm_classify_type"
+external refine_abstract_type : lltype -> lltype -> unit
+ = "llvm_refine_abstract_type"
+val string_of_lltype : lltype -> string
+
+(*--... Operations on integer types ........................................--*)
+val i1_type : lltype
+val i8_type : lltype
+val i16_type : lltype
+val i32_type : lltype
+val i64_type : lltype
+external make_integer_type : int -> lltype = "llvm_make_integer_type"
+external integer_bitwidth : lltype -> int = "llvm_integer_bitwidth"
+
+(*--... Operations on real types ...........................................--*)
+val float_type : lltype
+val double_type : lltype
+val x86fp80_type : lltype
+val fp128_type : lltype
+val ppc_fp128_type : lltype
+
+(*--... Operations on function types .......................................--*)
+(* FIXME: handle parameter attributes *)
+external make_function_type : lltype -> lltype array -> bool -> lltype
+ = "llvm_make_function_type"
+external is_var_arg : lltype -> bool = "llvm_is_var_arg"
+external return_type : lltype -> lltype = "llvm_return_type"
+external param_types : lltype -> lltype array = "llvm_param_types"
+
+(*--... Operations on struct types .........................................--*)
+external make_struct_type : lltype array -> bool -> lltype
+ = "llvm_make_struct_type"
+external element_types : lltype -> lltype array = "llvm_element_types"
+external is_packed : lltype -> bool = "llvm_is_packed"
+
+(*--... Operations on pointer, vector, and array types .....................--*)
+external make_array_type : lltype -> int -> lltype = "llvm_make_array_type"
+external make_pointer_type : lltype -> lltype = "llvm_make_pointer_type"
+external make_vector_type : lltype -> int -> lltype = "llvm_make_vector_type"
+
+external element_type : lltype -> lltype = "llvm_element_type"
+external array_length : lltype -> int = "llvm_array_length"
+external vector_size : lltype -> int = "llvm_vector_size"
+
+(*--... Operations on other types ..........................................--*)
+external make_opaque_type : unit -> lltype = "llvm_make_opaque_type"
+val void_type : lltype
+val label_type : lltype
+
+
+(*===-- 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"
+
+(*--... Operations on constants of (mostly) any type .......................--*)
+external make_null : lltype -> llvalue = "llvm_make_null"
+external make_all_ones : lltype -> llvalue = "llvm_make_all_ones"
+external make_undef : lltype -> llvalue = "llvm_make_undef"
+external is_null : llvalue -> bool = "llvm_is_null"
+
+(*--... Operations on scalar constants .....................................--*)
+external make_int_constant : lltype -> int -> bool -> llvalue
+ = "llvm_make_int_constant"
+external make_real_constant : lltype -> float -> llvalue
+ = "llvm_make_real_constant"
+
+(*--... Operations on composite constants ..................................--*)
+external make_string_constant : string -> bool -> llvalue
+ = "llvm_make_string_constant"
+external make_array_constant : lltype -> llvalue array -> llvalue
+ = "llvm_make_array_constant"
+external make_struct_constant : llvalue array -> bool -> llvalue
+ = "llvm_make_struct_constant"
+external make_vector_constant : llvalue array -> llvalue
+ = "llvm_make_vector_constant"
+
+(*--... Operations on global variables, functions, and aliases (globals) ...--*)
+external is_declaration : llvalue -> bool = "llvm_is_declaration"
+external linkage : llvalue -> linkage = "llvm_linkage"
+external set_linkage : linkage -> llvalue -> unit = "llvm_set_linkage"
+external section : llvalue -> string = "llvm_section"
+external set_section : string -> llvalue -> unit = "llvm_set_section"
+external visibility : llvalue -> visibility = "llvm_visibility"
+external set_visibility : visibility -> llvalue -> unit = "llvm_set_visibility"
+external alignment : llvalue -> int = "llvm_alignment"
+external set_alignment : int -> llvalue -> unit = "llvm_set_alignment"
+
+(*--... Operations on global variables .....................................--*)
+external declare_global : lltype -> string -> llmodule -> llvalue
+ = "llvm_declare_global"
+external define_global : string -> llvalue -> llmodule -> llvalue
+ = "llvm_define_global"
+external delete_global : llvalue -> unit = "llvm_delete_global"
+external global_initializer : llvalue -> llvalue = "llvm_global_initializer"
+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"
+
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
new file mode 100644
index 0000000..3191cb0
--- /dev/null
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -0,0 +1,410 @@
+/*===-- llvm_ocaml.h - LLVM Ocaml Glue --------------------------*- C++ -*-===*\
+|* *|
+|* The LLVM Compiler Infrastructure *|
+|* *|
+|* This file was developed by Gordon Henriksen and is distributed under the *|
+|* University of Illinois Open Source License. See LICENSE.TXT for details. *|
+|* *|
+|*===----------------------------------------------------------------------===*|
+|* *|
+|* This file 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/alloc.h"
+#include "caml/mlvalues.h"
+#include "caml/memory.h"
+#include "stdio.h"
+
+
+/*===-- Modules -----------------------------------------------------------===*/
+
+/* string -> llmodule */
+CAMLprim value llvm_create_module(value ModuleID) {
+ return (value) LLVMModuleCreateWithName(String_val(ModuleID));
+}
+
+/* llmodule -> unit */
+CAMLprim value llvm_dispose_module(value M) {
+ LLVMDisposeModule((LLVMModuleRef) M);
+ return Val_unit;
+}
+
+/* string -> lltype -> llmodule -> bool */
+CAMLprim value llvm_add_type_name(value Name, value Ty, value M) {
+ int res = LLVMAddTypeName((LLVMModuleRef) M,
+ String_val(Name), (LLVMTypeRef) Ty);
+ return Val_bool(res == 0);
+}
+
+
+/*===-- Types -------------------------------------------------------------===*/
+
+/* lltype -> type_kind */
+CAMLprim value llvm_classify_type(value Ty) {
+ return Val_int(LLVMGetTypeKind((LLVMTypeRef) Ty));
+}
+
+/* lltype -> lltype -> unit */
+CAMLprim value llvm_refine_abstract_type(value ConcreteTy, value AbstractTy) {
+ LLVMRefineAbstractType((LLVMTypeRef) AbstractTy, (LLVMTypeRef) ConcreteTy);
+ return (value) Val_unit;
+}
+
+/*--... Operations on integer types ........................................--*/
+
+/* unit -> lltype */
+CAMLprim value llvm_i1_type (value Unit) { return (value) LLVMInt1Type(); }
+CAMLprim value llvm_i8_type (value Unit) { return (value) LLVMInt8Type(); }
+CAMLprim value llvm_i16_type(value Unit) { return (value) LLVMInt16Type(); }
+CAMLprim value llvm_i32_type(value Unit) { return (value) LLVMInt32Type(); }
+CAMLprim value llvm_i64_type(value Unit) { return (value) LLVMInt64Type(); }
+
+/* int -> lltype */
+CAMLprim value llvm_make_integer_type(value Width) {
+ return (value) LLVMCreateIntegerType(Int_val(Width));
+}
+
+/* lltype -> int */
+CAMLprim value llvm_integer_bitwidth(value IntegerTy) {
+ return Val_int(LLVMGetIntegerTypeWidth((LLVMTypeRef) IntegerTy));
+}
+
+/*--... Operations on real types ...........................................--*/
+
+/* unit -> lltype */
+CAMLprim value llvm_float_type(value Unit) {
+ return (value) LLVMFloatType();
+}
+
+/* unit -> lltype */
+CAMLprim value llvm_double_type(value Unit) {
+ return (value) LLVMDoubleType();
+}
+
+/* unit -> lltype */
+CAMLprim value llvm_x86fp80_type(value Unit) {
+ return (value) LLVMX86FP80Type();
+}
+
+/* unit -> lltype */
+CAMLprim value llvm_fp128_type(value Unit) {
+ return (value) LLVMFP128Type();
+}
+
+/* unit -> lltype */
+CAMLprim value llvm_ppc_fp128_type(value Unit) {
+ return (value) LLVMPPCFP128Type();
+}
+
+/*--... Operations on function types .......................................--*/
+
+/* lltype -> lltype array -> bool -> lltype */
+CAMLprim value llvm_make_function_type(value RetTy, value ParamTys,
+ value IsVarArg) {
+ return (value) LLVMCreateFunctionType((LLVMTypeRef) RetTy,
+ (LLVMTypeRef *) ParamTys,
+ Wosize_val(ParamTys),
+ Bool_val(IsVarArg));
+}
+
+/* lltype -> bool */
+CAMLprim value llvm_is_var_arg(value FunTy) {
+ return Val_bool(LLVMIsFunctionVarArg((LLVMTypeRef) FunTy));
+}
+
+/* lltype -> lltype */
+CAMLprim value llvm_return_type(value FunTy) {
+ return (value) LLVMGetFunctionReturnType((LLVMTypeRef) FunTy);
+}
+
+/* lltype -> lltype array */
+CAMLprim value llvm_param_types(value FunTy) {
+ unsigned Count = LLVMGetFunctionParamCount((LLVMTypeRef) FunTy);
+ LLVMTypeRef *FunTys = alloca(Count * sizeof(LLVMTypeRef));
+
+ /* copy into an ocaml array */
+ unsigned i;
+ value ParamTys = caml_alloc(Count, 0);
+
+ LLVMGetFunctionParamTypes((LLVMTypeRef) FunTy, FunTys);
+ for (i = 0; i != Count; ++i)
+ Store_field(ParamTys, i, (value) FunTys[i]);
+
+ return ParamTys;
+}
+
+/*--... Operations on struct types .........................................--*/
+
+/* lltype array -> bool -> lltype */
+CAMLprim value llvm_make_struct_type(value ElementTypes, value Packed) {
+ return (value) LLVMCreateStructType((LLVMTypeRef *) ElementTypes,
+ Wosize_val(ElementTypes),
+ Bool_val(Packed));
+}
+
+/* lltype -> lltype array */
+CAMLprim value llvm_element_types(value StructTy) {
+ unsigned Count = LLVMGetStructElementCount((LLVMTypeRef) StructTy);
+ LLVMTypeRef *Tys = alloca(Count * sizeof(LLVMTypeRef));
+
+ /* copy into an ocaml array */
+ unsigned i;
+ value ElementTys = caml_alloc(Count, 0);
+
+ LLVMGetStructElementTypes((LLVMTypeRef) StructTy, Tys);
+ for (i = 0; i != Count; ++i)
+ Store_field(ElementTys, i, (value) Tys[i]);
+
+ return ElementTys;
+}
+
+CAMLprim value llvm_is_packed(value StructTy) {
+ return Val_bool(LLVMIsPackedStruct((LLVMTypeRef) StructTy));
+}
+
+/*--... Operations on array, pointer, and vector types .....................--*/
+
+/* lltype -> int -> lltype */
+CAMLprim value llvm_make_array_type(value ElementTy, value Count) {
+ return (value) LLVMCreateArrayType((LLVMTypeRef) ElementTy, Int_val(Count));
+}
+
+/* lltype -> lltype */
+CAMLprim value llvm_make_pointer_type(value ElementTy) {
+ return (value) LLVMCreatePointerType((LLVMTypeRef) ElementTy);
+}
+
+/* lltype -> int -> lltype */
+CAMLprim value llvm_make_vector_type(value ElementTy, value Count) {
+ return (value) LLVMCreateVectorType((LLVMTypeRef) ElementTy, Int_val(Count));
+}
+
+/* lltype -> lltype */
+CAMLprim value llvm_element_type(value Ty) {
+ return (value) LLVMGetElementType((LLVMTypeRef) Ty);
+}
+
+/* lltype -> int */
+CAMLprim value llvm_array_length(value ArrayTy) {
+ return Val_int(LLVMGetArrayLength((LLVMTypeRef) ArrayTy));
+}
+
+/* lltype -> int */
+CAMLprim value llvm_vector_size(value VectorTy) {
+ return Val_int(LLVMGetVectorSize((LLVMTypeRef) VectorTy));
+}
+
+/*--... Operations on other types ..........................................--*/
+
+/* unit -> lltype */
+CAMLprim value llvm_void_type (value Unit) { return (value) LLVMVoidType(); }
+CAMLprim value llvm_label_type(value Unit) { return (value) LLVMLabelType(); }
+
+/* unit -> lltype */
+CAMLprim value llvm_make_opaque_type(value Unit) {
+ return (value) LLVMCreateOpaqueType();
+}
+
+
+/*===-- VALUES ------------------------------------------------------------===*/
+
+/* llvalue -> lltype */
+CAMLprim value llvm_type_of(value Val) {
+ return (value) LLVMGetTypeOfValue((LLVMValueRef) Val);
+}
+
+/* llvalue -> string */
+CAMLprim value llvm_value_name(value Val) {
+ return caml_copy_string(LLVMGetValueName((LLVMValueRef) Val));
+}
+
+/* string -> llvalue -> unit */
+CAMLprim value llvm_set_value_name(value Name, value Val) {
+ LLVMSetValueName((LLVMValueRef) Val, String_val(Name));
+ return Val_unit;
+}
+
+/*--... Operations on constants of (mostly) any type .......................--*/
+
+/* lltype -> llvalue */
+CAMLprim value llvm_make_null(value Ty) {
+ return (value) LLVMGetNull((LLVMTypeRef) Ty);
+}
+
+/* lltype -> llvalue */
+CAMLprim value llvm_make_all_ones(value Ty) {
+ return (value) LLVMGetAllOnes((LLVMTypeRef) Ty);
+}
+
+/* lltype -> llvalue */
+CAMLprim value llvm_make_undef(value Ty) {
+ return (value) LLVMGetUndef((LLVMTypeRef) Ty);
+}
+
+/* llvalue -> bool */
+CAMLprim value llvm_is_null(value Val) {
+ return Val_bool(LLVMIsNull((LLVMValueRef) Val));
+}
+
+/*--... Operations on scalar constants .....................................--*/
+
+/* lltype -> int -> bool -> llvalue */
+CAMLprim value llvm_make_int_constant(value IntTy, value N, value SExt) {
+ /* GCC warns if we use the ternary operator. */
+ unsigned long long N2;
+ if (Bool_val(SExt))
+ N2 = (intnat) Int_val(N);
+ else
+ N2 = (uintnat) Int_val(N);
+
+ return (value) LLVMGetIntConstant((LLVMTypeRef) IntTy, N2, Bool_val(SExt));
+}
+
+/* lltype -> float -> llvalue */
+CAMLprim value llvm_make_real_constant(value RealTy, value N) {
+ return (value) LLVMGetRealConstant((LLVMTypeRef) RealTy, Double_val(N));
+}
+
+/*--... Operations on composite constants ..................................--*/
+
+/* string -> bool -> llvalue */
+CAMLprim value llvm_make_string_constant(value Str, value NullTerminate) {
+ return (value) LLVMGetStringConstant(String_val(Str),
+ Wosize_val(Str),
+ Bool_val(NullTerminate) == 0);
+}
+
+/* lltype -> llvalue array -> llvalue */
+CAMLprim value llvm_make_array_constant(value ElementTy, value ElementVals) {
+ return (value) LLVMGetArrayConstant((LLVMTypeRef) ElementTy,
+ (LLVMValueRef*) Op_val(ElementVals),
+ Wosize_val(ElementVals));
+}
+
+/* llvalue array -> bool -> llvalue */
+CAMLprim value llvm_make_struct_constant(value ElementVals, value Packed) {
+ return (value) LLVMGetStructConstant((LLVMValueRef*) Op_val(ElementVals),
+ Wosize_val(ElementVals),
+ Bool_val(Packed));
+}
+
+/* llvalue array -> llvalue */
+CAMLprim value llvm_make_vector_constant(value ElementVals) {
+ return (value) LLVMGetVectorConstant((LLVMValueRef*) Op_val(ElementVals),
+ Wosize_val(ElementVals));
+}
+
+/*--... Operations on global variables, functions, and aliases (globals) ...--*/
+
+/* llvalue -> bool */
+CAMLprim value llvm_is_declaration(value Global) {
+ return Val_bool(LLVMIsDeclaration((LLVMValueRef) Global));
+}
+
+/* llvalue -> linkage */
+CAMLprim value llvm_linkage(value Global) {
+ return Val_int(LLVMGetLinkage((LLVMValueRef) Global));
+}
+
+/* linkage -> llvalue -> unit */
+CAMLprim value llvm_set_linkage(value Linkage, value Global) {
+ LLVMSetLinkage((LLVMValueRef) Global, Int_val(Linkage));
+ return Val_unit;
+}
+
+/* llvalue -> string */
+CAMLprim value llvm_section(value Global) {
+ return caml_copy_string(LLVMGetSection((LLVMValueRef) Global));
+}
+
+/* string -> llvalue -> unit */
+CAMLprim value llvm_set_section(value Section, value Global) {
+ LLVMSetSection((LLVMValueRef) Global, String_val(Section));
+ return Val_unit;
+}
+
+/* llvalue -> visibility */
+CAMLprim value llvm_visibility(value Global) {
+ return Val_int(LLVMGetVisibility((LLVMValueRef) Global));
+}
+
+/* visibility -> llvalue -> unit */
+CAMLprim value llvm_set_visibility(value Viz, value Global) {
+ LLVMSetVisibility((LLVMValueRef) Global, Int_val(Viz));
+ return Val_unit;
+}
+
+/* llvalue -> int */
+CAMLprim value llvm_alignment(value Global) {
+ return Val_int(LLVMGetAlignment((LLVMValueRef) Global));
+}
+
+/* int -> llvalue -> unit */
+CAMLprim value llvm_set_alignment(value Bytes, value Global) {
+ LLVMSetAlignment((LLVMValueRef) Global, Int_val(Bytes));
+ return Val_unit;
+}
+
+/*--... Operations on global variables .....................................--*/
+
+/* lltype -> string -> llmodule -> llvalue */
+CAMLprim value llvm_add_global(value Ty, value Name, value M) {
+ return (value) LLVMAddGlobal((LLVMModuleRef) M,
+ (LLVMTypeRef) Ty, String_val(Name));
+}
+
+/* lltype -> string -> llmodule -> llvalue */
+CAMLprim value llvm_declare_global(value Ty, value Name, value M) {
+ return (value) LLVMAddGlobal((LLVMModuleRef) M,
+ (LLVMTypeRef) Ty, String_val(Name));
+}
+
+/* string -> llvalue -> llmodule -> llvalue */
+CAMLprim value llvm_define_global(value Name, value ConstantVal, value M) {
+ LLVMValueRef Initializer = (LLVMValueRef) ConstantVal;
+ LLVMValueRef GlobalVar = LLVMAddGlobal((LLVMModuleRef) M,
+ LLVMGetTypeOfValue(Initializer),
+ String_val(Name));
+ LLVMSetInitializer(GlobalVar, Initializer);
+ return (value) GlobalVar;
+}
+
+/* llvalue -> unit */
+CAMLprim value llvm_delete_global(value GlobalVar) {
+ LLVMDeleteGlobal((LLVMValueRef) GlobalVar);
+ return Val_unit;
+}
+
+/* llvalue -> llvalue */
+CAMLprim value llvm_global_initializer(value GlobalVar) {
+ return (value) LLVMGetInitializer((LLVMValueRef) GlobalVar);
+}
+
+/* llvalue -> llvalue -> unit */
+CAMLprim value llvm_set_initializer(value ConstantVal, value GlobalVar) {
+ LLVMSetInitializer((LLVMValueRef) GlobalVar, (LLVMValueRef) ConstantVal);
+ return Val_unit;
+}
+
+/* llvalue -> unit */
+CAMLprim value llvm_remove_initializer(value GlobalVar) {
+ LLVMSetInitializer((LLVMValueRef) GlobalVar, NULL);
+ return Val_unit;
+}
+
+/* llvalue -> bool */
+CAMLprim value llvm_is_thread_local(value GlobalVar) {
+ return Val_bool(LLVMIsThreadLocal((LLVMValueRef) GlobalVar));
+}
+
+/* bool -> llvalue -> unit */
+CAMLprim value llvm_set_thread_local(value IsThreadLocal, value GlobalVar) {
+ LLVMSetThreadLocal((LLVMValueRef) GlobalVar, Bool_val(IsThreadLocal));
+ return Val_unit;
+}