Add metadata functions to llvm-c and ocaml.

git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@97375 91177308-0d34-0410-b5e6-96231b3b80d8

3 files changed, 170 insertions, 0 deletions

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 0c2cebd..837f6a3 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -148,6 +148,7 @@ type ('a, 'b) llrev_pos =
 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 -> int = "llvm_mdkind_id"
 
 (*===-- Modules -----------------------------------------------------------===*)
 external create_module : llcontext -> string -> llmodule = "llvm_create_module"
@@ -245,6 +246,16 @@ external undef : lltype -> llvalue = "LLVMGetUndef"
 external is_null : llvalue -> bool = "llvm_is_null"
 external is_undef : llvalue -> bool = "llvm_is_undef"
 
+(*--... Operations on instructions .........................................--*)
+external has_metadata : llvalue -> bool = "llvm_has_metadata"
+external metadata : llvalue -> int -> llvalue option = "llvm_metadata"
+external set_metadata : llvalue -> int -> llvalue -> unit = "llvm_set_metadata"
+external clear_metadata : llvalue -> int -> unit = "llvm_clear_metadata"
+
+(*--... Operations on metadata .......,.....................................--*)
+external mdstring : llcontext -> string -> llvalue = "llvm_mdstring"
+external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode"
+
 (*--... Operations on scalar constants .....................................--*)
 external const_int : lltype -> int -> llvalue = "llvm_const_int"
 external const_of_int64 : lltype -> Int64.t -> bool -> llvalue
@@ -695,6 +706,17 @@ 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"
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 98ba05f..5a15642 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -221,6 +221,11 @@ external dispose_context : llcontext -> unit = "llvm_dispose_context"
 (** See the function [llvm::getGlobalContext]. *)
 external global_context : unit -> llcontext = "llvm_global_context"
 
+(** [mdkind_id context name] returns the MDKind ID that corresponds to the
+    name [name] in the context [context].  See the function
+    [llvm::LLVMContext::getMDKindID]. *)
+external mdkind_id : llcontext -> string -> int = "llvm_mdkind_id"
+
 
 (** {6 Modules} *)
 
@@ -525,6 +530,39 @@ external is_null : llvalue -> bool = "llvm_is_null"
 external is_undef : llvalue -> bool = "llvm_is_undef"
 
 
+(** {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]. *)
+external has_metadata : llvalue -> bool = "llvm_has_metadata"
+
+(** [metadata i kind] optionally returns the metadata associated with the
+    kind [kind] in the instruction [i] See the function
+    [llvm::Instruction::getMetadata]. *)
+external metadata : llvalue -> int -> llvalue option = "llvm_metadata"
+
+(** [set_metadata i kind md] sets the metadata [md] of kind [kind] in the
+    instruction [i]. See the function [llvm::Instruction::setMetadata]. *)
+external set_metadata : llvalue -> int -> llvalue -> unit = "llvm_set_metadata"
+
+(** [clear_metadata i kind] clears the metadata of kind [kind] in the
+    instruction [i]. See the function [llvm::Instruction::setMetadata]. *)
+external clear_metadata : llvalue -> int -> unit = "llvm_clear_metadata"
+
+
+(** {7 Operations on metadata} *)
+
+(** [mdstring c s] returns the MDString of the string [s] in the context [c].
+    See the method [llvm::MDNode::get]. *)
+external mdstring : llcontext -> string -> llvalue = "llvm_mdstring"
+
+(** [mdnode c elts] returns the MDNode containing the values [elts] in the
+    context [c].
+    See the method [llvm::MDNode::get]. *)
+external mdnode : llcontext -> llvalue array -> llvalue = "llvm_mdnode"
+
+
 (** {7 Operations on scalar constants} *)
 
 (** [const_int ty i] returns the integer constant of type [ty] and value [i].
@@ -1451,6 +1489,30 @@ external insertion_block : llbuilder -> llbasicblock = "llvm_insertion_block"
 external insert_into_builder : llvalue -> string -> llbuilder -> unit
                              = "llvm_insert_into_builder"
 
+(** {7 Metadata} *)
+
+(** [set_current_debug_location b md] sets the current debug location [md] in
+    the builder [b].
+    See the method [llvm::IRBuilder::SetDebugLocation]. *)
+external set_current_debug_location : llbuilder -> llvalue -> unit
+                                    = "llvm_set_current_debug_location"
+
+(** [clear_current_debug_location b] clears the current debug location in the
+    builder [b]. *)
+external clear_current_debug_location : llbuilder -> unit
+                                      = "llvm_clear_current_debug_location"
+
+(** [current_debug_location b] returns the current debug location, or None
+    if none is currently set.
+    See the method [llvm::IRBuilder::GetDebugLocation]. *)
+external current_debug_location : llbuilder -> llvalue option
+                                = "llvm_current_debug_location"
+
+(** [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]. *)
+external set_inst_debug_location : llbuilder -> llvalue -> unit
+                                 = "llvm_set_inst_debug_location"
 
 (** {7 Terminators} *)
 
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 2b6eb56..e56af1e 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -110,6 +110,13 @@ 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);
+}
+
 /*===-- Modules -----------------------------------------------------------===*/
 
 /* llcontext -> string -> llmodule */
@@ -438,6 +445,52 @@ CAMLprim value llvm_is_undef(LLVMValueRef Val) {
   return Val_bool(LLVMIsUndef(Val));
 }
 
+/*--... 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));
+}
+
 /*--... Operations on scalar constants .....................................--*/
 
 /* lltype -> int -> llvalue */
@@ -1006,6 +1059,39 @@ CAMLprim value llvm_insert_into_builder(LLVMValueRef I, value Name, value B) {
   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 */