llvm.org GIT mirror llvm / ec7270c
[OCaml] Impement Llvm_irreader, bindings to LLVM assembly parser git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@194138 91177308-0d34-0410-b5e6-96231b3b80d8 Peter Zotov 7 years ago
7 changed file(s) with 185 addition(s) and 1 deletion(s). Raw diff Collapse all Expand all
77 ##===----------------------------------------------------------------------===##
88
99 LEVEL := ../..
10 DIRS = llvm bitreader bitwriter analysis target executionengine transforms linker
10 DIRS = llvm bitreader bitwriter irreader analysis target executionengine \
11 transforms linker
1112 ExtraMakefiles = $(PROJ_OBJ_DIR)/Makefile.ocaml
1213
1314 ocamldoc:
0 ##===- bindings/ocaml/irreader/Makefile --------------------*- Makefile -*-===##
1 #
2 # The LLVM Compiler Infrastructure
3 #
4 # This file is distributed under the University of Illinois Open Source
5 # License. See LICENSE.TXT for details.
6 #
7 ##===----------------------------------------------------------------------===##
8 #
9 # This is the makefile for the Objective Caml Llvm_irreader interface.
10 #
11 ##===----------------------------------------------------------------------===##
12
13 LEVEL := ../../..
14 LIBRARYNAME := llvm_irreader
15 UsedComponents := irreader
16 UsedOcamlInterfaces := llvm
17
18 include ../Makefile.ocaml
0 /*===-- irreader_ocaml.c - LLVM OCaml Glue ----------------------*- C++ -*-===*\
1 |* *|
2 |* The LLVM Compiler Infrastructure *|
3 |* *|
4 |* This file is distributed under the University of Illinois Open Source *|
5 |* License. See LICENSE.TXT for details. *|
6 |* *|
7 |*===----------------------------------------------------------------------===*|
8 |* *|
9 |* This file glues LLVM's OCaml interface to its C interface. These functions *|
10 |* are by and large transparent wrappers to the corresponding C functions. *|
11 |* *|
12 \*===----------------------------------------------------------------------===*/
13
14 #include "llvm-c/IRReader.h"
15 #include "caml/alloc.h"
16 #include "caml/fail.h"
17 #include "caml/memory.h"
18
19 /* Can't use the recommended caml_named_value mechanism for backwards
20 compatibility reasons. This is largely equivalent. */
21 static value llvm_irreader_error_exn;
22
23 CAMLprim value llvm_register_irreader_exns(value Error) {
24 llvm_irreader_error_exn = Field(Error, 0);
25 register_global_root(&llvm_irreader_error_exn);
26 return Val_unit;
27 }
28
29 static void llvm_raise(value Prototype, char *Message) {
30 CAMLparam1(Prototype);
31 CAMLlocal1(CamlMessage);
32
33 CamlMessage = copy_string(Message);
34 LLVMDisposeMessage(Message);
35
36 raise_with_arg(Prototype, CamlMessage);
37 abort(); /* NOTREACHED */
38 #ifdef CAMLnoreturn
39 CAMLnoreturn; /* Silences warnings, but is missing in some versions. */
40 #endif
41 }
42
43
44 /*===-- Modules -----------------------------------------------------------===*/
45
46 /* Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule */
47 CAMLprim value llvm_parse_ir(LLVMContextRef C,
48 LLVMMemoryBufferRef MemBuf) {
49 CAMLparam0();
50 CAMLlocal2(Variant, MessageVal);
51 LLVMModuleRef M;
52 char *Message;
53
54 if (LLVMParseIRInContext(C, MemBuf, &M, &Message))
55 llvm_raise(llvm_irreader_error_exn, Message);
56
57 CAMLreturn((value) M);
58 }
0 (*===-- llvm_irreader.ml - LLVM OCaml Interface ---------------*- OCaml -*-===*
1 *
2 * The LLVM Compiler Infrastructure
3 *
4 * This file is distributed under the University of Illinois Open Source
5 * License. See LICENSE.TXT for details.
6 *
7 *===----------------------------------------------------------------------===*)
8
9
10 exception Error of string
11
12 external register_exns : exn -> unit = "llvm_register_irreader_exns"
13 let _ = register_exns (Error "")
14
15 external parse_ir : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule
16 = "llvm_parse_ir"
0 (*===-- llvm_irreader.mli - LLVM OCaml Interface --------------*- OCaml -*-===*
1 *
2 * The LLVM Compiler Infrastructure
3 *
4 * This file is distributed under the University of Illinois Open Source
5 * License. See LICENSE.TXT for details.
6 *
7 *===----------------------------------------------------------------------===*)
8
9 (** IR reader.
10
11 This interface provides an OCaml API for the LLVM assembly reader, the
12 classes in the IRReader library. *)
13
14 exception Error of string
15
16 (** [parse_ir context mb] parses the IR for a new module [m] from the
17 memory buffer [mb] in the context [context]. Returns [m] if successful, or
18 raises [Error msg] otherwise, where [msg] is a description of the error
19 encountered. See the function [llvm::ParseIR]. *)
20 val parse_ir : Llvm.llcontext -> Llvm.llmemorybuffer -> Llvm.llmodule
4545 archive(native) = "llvm_ipo.cmxa"
4646 )
4747
48 package "irreader" (
49 requires = "llvm"
50 version = "@PACKAGE_VERSION@"
51 description = "IR assembly reader for LLVM"
52 archive(byte) = "llvm_irreader.cma"
53 archive(native) = "llvm_irreader.cmxa"
54 )
55
4856 package "scalar_opts" (
4957 requires = "llvm"
5058 version = "@PACKAGE_VERSION@"
0 (* RUN: rm -rf %t.builddir
1 * RUN: mkdir -p %t.builddir
2 * RUN: cp %s %t.builddir
3 * RUN: %ocamlopt -g -warn-error A llvm.cmxa llvm_irreader.cmxa %t.builddir/irreader.ml -o %t
4 * RUN: %t
5 * XFAIL: vg_leak
6 *)
7
8 (* Note: It takes several seconds for ocamlopt to link an executable with
9 libLLVMCore.a, so it's better to write a big test than a bunch of
10 little ones. *)
11
12 open Llvm
13 open Llvm_irreader
14
15 let context = global_context ()
16
17 (* Tiny unit test framework - really just to help find which line is busted *)
18 let print_checkpoints = false
19
20 let suite name f =
21 if print_checkpoints then
22 prerr_endline (name ^ ":");
23 f ()
24
25 let _ =
26 Printexc.record_backtrace true
27
28 let insist cond =
29 if not cond then failwith "insist"
30
31
32 (*===-- IR Reader ---------------------------------------------------------===*)
33
34 let test_irreader () =
35 begin
36 let buf = MemoryBuffer.of_string "@foo = global i32 42" in
37 let m = parse_ir context buf in
38 match lookup_global "foo" m with
39 | Some foo ->
40 insist ((global_initializer foo) = (const_int (i32_type context) 42))
41 | None ->
42 failwith "global"
43 end;
44
45 begin
46 let buf = MemoryBuffer.of_string "@foo = global garble" in
47 try
48 ignore (parse_ir context buf);
49 failwith "parsed"
50 with Llvm_irreader.Error _ ->
51 ()
52 end
53
54
55 (*===-- Driver ------------------------------------------------------------===*)
56
57 let _ =
58 suite "irreader" test_irreader