[OCaml] Adapt to the new attribute C API.

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

5 files changed, 355 insertions, 243 deletions

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 513fe0c9687..399fd2d27c2 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -15,6 +15,8 @@ type llvalue
 type lluse
 type llbasicblock
 type llbuilder
+type llattrkind
+type llattribute
 type llmemorybuffer
 type llmdkind
 
@@ -81,6 +83,25 @@ module CallConv = struct
   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
@@ -332,6 +353,47 @@ 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"
@@ -760,99 +822,27 @@ let rec fold_right_function_range f i e 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 -> int32 -> unit
+external llvm_add_function_attr : llvalue -> llattribute -> int -> unit
                                 = "llvm_add_function_attr"
-external llvm_remove_function_attr : llvalue -> int32 -> unit
-                                   = "llvm_remove_function_attr"
-external llvm_function_attr : llvalue -> int32 = "llvm_function_attr"
-
-let pack_attr (attr:Attribute.t) : int32 =
-  match attr with
-  Attribute.Zext                  -> Int32.shift_left 1l 0
-    | Attribute.Sext              -> Int32.shift_left 1l 1
-    | Attribute.Noreturn          -> Int32.shift_left 1l 2
-    | Attribute.Inreg             -> Int32.shift_left 1l 3
-    | Attribute.Structret         -> Int32.shift_left 1l 4
-    | Attribute.Nounwind          -> Int32.shift_left 1l 5
-    | Attribute.Noalias           -> Int32.shift_left 1l 6
-    | Attribute.Byval             -> Int32.shift_left 1l 7
-    | Attribute.Nest              -> Int32.shift_left 1l 8
-    | Attribute.Readnone          -> Int32.shift_left 1l 9
-    | Attribute.Readonly          -> Int32.shift_left 1l 10
-    | Attribute.Noinline          -> Int32.shift_left 1l 11
-    | Attribute.Alwaysinline      -> Int32.shift_left 1l 12
-    | Attribute.Optsize           -> Int32.shift_left 1l 13
-    | Attribute.Ssp               -> Int32.shift_left 1l 14
-    | Attribute.Sspreq            -> Int32.shift_left 1l 15
-    | Attribute.Alignment n       -> Int32.shift_left (Int32.of_int n) 16
-    | Attribute.Nocapture         -> Int32.shift_left 1l 21
-    | Attribute.Noredzone         -> Int32.shift_left 1l 22
-    | Attribute.Noimplicitfloat   -> Int32.shift_left 1l 23
-    | Attribute.Naked             -> Int32.shift_left 1l 24
-    | Attribute.Inlinehint        -> Int32.shift_left 1l 25
-    | Attribute.Stackalignment n  -> Int32.shift_left (Int32.of_int n) 26
-    | Attribute.ReturnsTwice      -> Int32.shift_left 1l 29
-    | Attribute.UWTable           -> Int32.shift_left 1l 30
-    | Attribute.NonLazyBind       -> Int32.shift_left 1l 31
-
-let unpack_attr (a : int32) : Attribute.t list =
-  let l = ref [] in
-  let check attr =
-      Int32.logand (pack_attr attr) a in
-  let checkattr attr =
-      if (check attr) <> 0l then begin
-          l := attr :: !l
-      end
-  in
-  checkattr Attribute.Zext;
-  checkattr Attribute.Sext;
-  checkattr Attribute.Noreturn;
-  checkattr Attribute.Inreg;
-  checkattr Attribute.Structret;
-  checkattr Attribute.Nounwind;
-  checkattr Attribute.Noalias;
-  checkattr Attribute.Byval;
-  checkattr Attribute.Nest;
-  checkattr Attribute.Readnone;
-  checkattr Attribute.Readonly;
-  checkattr Attribute.Noinline;
-  checkattr Attribute.Alwaysinline;
-  checkattr Attribute.Optsize;
-  checkattr Attribute.Ssp;
-  checkattr Attribute.Sspreq;
-  let align = Int32.logand (Int32.shift_right_logical a 16) 31l in
-  if align <> 0l then
-      l := Attribute.Alignment (Int32.to_int align) :: !l;
-  checkattr Attribute.Nocapture;
-  checkattr Attribute.Noredzone;
-  checkattr Attribute.Noimplicitfloat;
-  checkattr Attribute.Naked;
-  checkattr Attribute.Inlinehint;
-  let stackalign = Int32.logand (Int32.shift_right_logical a 26) 7l in
-  if stackalign <> 0l then
-      l := Attribute.Stackalignment (Int32.to_int stackalign) :: !l;
-  checkattr Attribute.ReturnsTwice;
-  checkattr Attribute.UWTable;
-  checkattr Attribute.NonLazyBind;
-  !l;;
-
-let add_function_attr llval attr =
-  llvm_add_function_attr llval (pack_attr attr)
-
-external add_target_dependent_function_attr
-    : llvalue -> string -> string -> unit
-    = "llvm_add_target_dependent_function_attr"
-
-let remove_function_attr llval attr =
-  llvm_remove_function_attr llval (pack_attr attr)
-
-let function_attr f = unpack_attr (llvm_function_attr f)
+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 llvm_param_attr : llvalue -> int32 = "llvm_param_attr"
-let param_attr p = unpack_attr (llvm_param_attr p)
 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"
@@ -899,20 +889,6 @@ let rec fold_right_param_range f init i e =
 let fold_right_params f fn init =
   fold_right_param_range f init (param_end fn) (At_start fn)
 
-external llvm_add_param_attr : llvalue -> int32 -> unit
-                                = "llvm_add_param_attr"
-external llvm_remove_param_attr : llvalue -> int32 -> unit
-                                = "llvm_remove_param_attr"
-
-let add_param_attr llval attr =
-  llvm_add_param_attr llval (pack_attr attr)
-
-let remove_param_attr llval attr =
-  llvm_remove_param_attr llval (pack_attr attr)
-
-external set_param_alignment : llvalue -> int -> unit
-                             = "llvm_set_param_alignment"
-
 (*--... Operations on basic blocks .........................................--*)
 external value_of_block : llbasicblock -> llvalue = "LLVMBasicBlockAsValue"
 external value_is_block : llvalue -> bool = "llvm_value_is_block"
@@ -1044,16 +1020,23 @@ external instruction_call_conv: llvalue -> int
 external set_instruction_call_conv: int -> llvalue -> unit
                                   = "llvm_set_instruction_call_conv"
 
-external llvm_add_instruction_param_attr : llvalue -> int -> int32 -> unit
-                                         = "llvm_add_instruction_param_attr"
-external llvm_remove_instruction_param_attr : llvalue -> int -> int32 -> unit
-                                         = "llvm_remove_instruction_param_attr"
-
-let add_instruction_param_attr llval i attr =
-  llvm_add_instruction_param_attr llval i (pack_attr attr)
-
-let remove_instruction_param_attr llval i attr =
-  llvm_remove_instruction_param_attr llval i (pack_attr attr)
+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 instructions (only) .............................--*)
 external is_tail_call : llvalue -> bool = "llvm_is_tail_call"
diff --git a/bindings/ocaml/llvm/llvm.mli b/bindings/ocaml/llvm/llvm.mli
index 0f973000f75..4068126e2cb 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -44,6 +44,12 @@ type llbasicblock
     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
@@ -130,36 +136,19 @@ module CallConv : sig
                               convention from C. *)
 end
 
-(** The attribute kind of a function parameter, result or the function itself.
-    See [llvm::Attribute::AttrKind]. *)
-module Attribute : sig
+(** 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 =
-  | 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
+  | Function
+  | Return
+  | Param of int
 end
 
 (** The predicate for an integer comparison ([icmp]) instruction.
@@ -443,6 +432,36 @@ val global_context : unit -> llcontext
 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
@@ -1547,21 +1566,21 @@ val gc : llvalue -> string option
     [gc]. See the method [llvm::Function::setGC]. *)
 val set_gc : string option -> llvalue -> unit
 
-(** [add_function_attr f a] adds attribute [a] to the return type of function
-    [f]. *)
-val add_function_attr : llvalue -> Attribute.t -> 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
 
-(** [add_target_dependent_function_attr f a] adds target-dependent attribute
-    [a] to function [f]. *)
-val add_target_dependent_function_attr : llvalue -> string -> string -> unit
+(** [function_attrs f i] returns the attributes for the function [f]
+    at position [i]. *)
+val function_attrs : llvalue -> AttrIndex.t -> llattribute array
 
-(** [function_attr f] returns the function attribute for the function [f].
-    See the method [llvm::Function::getAttributes] *)
-val function_attr : llvalue -> Attribute.t list
+(** [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_function_attr f a] removes attribute [a] from the return type of
-    function [f]. *)
-val remove_function_attr : llvalue -> Attribute.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} *)
@@ -1574,11 +1593,6 @@ val params : llvalue -> llvalue array
     See the method [llvm::Function::getArgumentList]. *)
 val param : llvalue -> int -> llvalue
 
-(** [param_attr p] returns the attributes of parameter [p].
-    See the methods [llvm::Function::getAttributes] and
-    [llvm::Attributes::getParamAttributes] *)
-val param_attr : llvalue -> Attribute.t list
-
 (** [param_parent p] returns the parent function that owns the parameter.
     See the method [llvm::Argument::getParent]. *)
 val param_parent : llvalue -> llvalue
@@ -1620,15 +1634,6 @@ val rev_iter_params : (llvalue -> unit) -> llvalue -> unit
     [b1,...,bN] are the parameters of function [fn]. Tail recursive. *)
 val fold_right_params : (llvalue -> 'a -> 'a) -> llvalue -> 'a -> 'a
 
-(** [add_param p a] adds attribute [a] to parameter [p]. *)
-val add_param_attr : llvalue -> Attribute.t -> unit
-
-(** [remove_param_attr p a] removes attribute [a] from parameter [p]. *)
-val remove_param_attr : llvalue -> Attribute.t -> unit
-
-(** [set_param_alignment p a] set the alignment of parameter [p] to [a]. *)
-val set_param_alignment : llvalue -> int -> unit
-
 
 (** {7 Operations on basic blocks} *)
 
@@ -1797,15 +1802,21 @@ val instruction_call_conv: llvalue -> int
     and [llvm::InvokeInst::setCallingConv]. *)
 val set_instruction_call_conv: int -> llvalue -> unit
 
-(** [add_instruction_param_attr ci i a] adds attribute [a] to the [i]th
-    parameter of the call or invoke instruction [ci]. [i]=0 denotes the return
-    value. *)
-val add_instruction_param_attr : llvalue -> int -> Attribute.t -> 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_instruction_param_attr ci i a] removes attribute [a] from the
-    [i]th parameter of the call or invoke instruction [ci]. [i]=0 denotes the
-    return value. *)
-val remove_instruction_param_attr : llvalue -> int -> Attribute.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 instructions (only)} *)
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index f968db8efd0..af04ea25c8a 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -185,6 +185,69 @@ CAMLprim value llvm_mdkind_id(LLVMContextRef C, value 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 */
@@ -1308,31 +1371,37 @@ CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
   return Val_unit;
 }
 
-/* llvalue -> int32 -> unit */
-CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
-  LLVMAddFunctionAttr(Arg, Int32_val(PA));
+/* 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 -> string -> string -> unit */
-CAMLprim value llvm_add_target_dependent_function_attr(
-                  LLVMValueRef Arg, value A, value V) {
-  LLVMAddTargetDependentFunctionAttr(Arg, String_val(A), String_val(V));
-  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 -> int32 */
-CAMLprim value llvm_function_attr(LLVMValueRef Fn)
-{
-    CAMLparam0();
-    CAMLreturn(caml_copy_int32(LLVMGetFunctionAttr(Fn)));
+/* 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 -> int32 -> unit */
-CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
-  LLVMRemoveFunctionAttr(Arg, Int32_val(PA));
+/* 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)
@@ -1342,13 +1411,6 @@ CAMLprim LLVMValueRef llvm_param(LLVMValueRef Fn, value Index) {
   return LLVMGetParam(Fn, Int_val(Index));
 }
 
-/* llvalue -> int */
-CAMLprim value llvm_param_attr(LLVMValueRef Param)
-{
-    CAMLparam0();
-    CAMLreturn(caml_copy_int32(LLVMGetAttribute(Param)));
-}
-
 /* llvalue -> llvalue */
 CAMLprim value llvm_params(LLVMValueRef Fn) {
   value Params = alloc(LLVMCountParams(Fn), 0);
@@ -1356,24 +1418,6 @@ CAMLprim value llvm_params(LLVMValueRef Fn) {
   return Params;
 }
 
-/* llvalue -> int32 -> unit */
-CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
-  LLVMAddAttribute(Arg, Int32_val(PA));
-  return Val_unit;
-}
-
-/* llvalue -> int32 -> unit */
-CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
-  LLVMRemoveAttribute(Arg, Int32_val(PA));
-  return Val_unit;
-}
-
-/* llvalue -> int -> unit */
-CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
-  LLVMSetParamAlignment(Arg, Int_val(align));
-  return Val_unit;
-}
-
 /*--... Operations on basic blocks .........................................--*/
 
 DEFINE_ITERATORS(
@@ -1500,19 +1544,34 @@ CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
   return Val_unit;
 }
 
-/* llvalue -> int -> int32 -> unit */
-CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
-                                               value index,
-                                               value PA) {
-  LLVMAddInstrAttribute(Instr, Int_val(index), Int32_val(PA));
+/* 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 -> int -> int32 -> unit */
-CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
-                                                  value index,
-                                                  value PA) {
-  LLVMRemoveInstrAttribute(Instr, Int_val(index), Int32_val(PA));
+/* 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;
 }
 
diff --git a/docs/ReleaseNotes.rst b/docs/ReleaseNotes.rst
index 6b75a79aa5c..95c2302855f 100644
--- a/docs/ReleaseNotes.rst
+++ b/docs/ReleaseNotes.rst
@@ -98,7 +98,8 @@ Changes to the AMDGPU Target
 Changes to the OCaml bindings
 -----------------------------
 
- During this release ...
+* The attribute API was completely overhauled, following the changes
+  to the C API.
 
 
 External Open Source Projects Using LLVM 4.0.0
diff --git a/test/Bindings/OCaml/core.ml b/test/Bindings/OCaml/core.ml
index ee8281f111a..105f1bc4f73 100644
--- a/test/Bindings/OCaml/core.ml
+++ b/test/Bindings/OCaml/core.ml
@@ -404,6 +404,42 @@ let test_constants () =
   end
 
 
+(*===-- Attributes --------------------------------------------------------===*)
+
+let test_attributes () =
+  group "enum attrs";
+  let nonnull_kind = enum_attr_kind "nonnull" in
+  let dereferenceable_kind = enum_attr_kind "dereferenceable" in
+  insist (nonnull_kind = (enum_attr_kind "nonnull"));
+  insist (nonnull_kind <> dereferenceable_kind);
+
+  let nonnull =
+    create_enum_attr context "nonnull" 0L in
+  let dereferenceable_4 =
+    create_enum_attr context "dereferenceable" 4L in
+  let dereferenceable_8 =
+    create_enum_attr context "dereferenceable" 8L in
+  insist (nonnull <> dereferenceable_4);
+  insist (dereferenceable_4 <> dereferenceable_8);
+  insist (nonnull = (create_enum_attr context "nonnull" 0L));
+  insist ((repr_of_attr nonnull) =
+          AttrRepr.Enum(nonnull_kind, 0L));
+  insist ((repr_of_attr dereferenceable_4) =
+          AttrRepr.Enum(dereferenceable_kind, 4L));
+  insist ((attr_of_repr context (repr_of_attr nonnull)) =
+          nonnull);
+  insist ((attr_of_repr context (repr_of_attr dereferenceable_4)) =
+          dereferenceable_4);
+
+  group "string attrs";
+  let foo_bar = create_string_attr context "foo" "bar" in
+  let foo_baz = create_string_attr context "foo" "baz" in
+  insist (foo_bar <> foo_baz);
+  insist (foo_bar = (create_string_attr context "foo" "bar"));
+  insist ((repr_of_attr foo_bar) = AttrRepr.String("foo", "bar"));
+  insist ((attr_of_repr context (repr_of_attr foo_bar)) = foo_bar);
+  ()
+
 (*===-- Global Values -----------------------------------------------------===*)
 
 let test_global_values () =
@@ -747,12 +783,6 @@ let test_params () =
     let p2 = param f 1 in
     set_value_name "One" p1;
     set_value_name "Two" p2;
-    add_param_attr p1 Attribute.Sext;
-    add_param_attr p2 Attribute.Noalias;
-    remove_param_attr p2 Attribute.Noalias;
-    add_function_attr f Attribute.Nounwind;
-    add_function_attr f Attribute.Noreturn;
-    remove_function_attr f Attribute.Noreturn;
 
     insist (Before p1 = param_begin f);
     insist (Before p2 = param_succ p1);
@@ -960,11 +990,25 @@ let test_builder () =
 
   group "function attribute";
   begin
-      ignore (add_function_attr fn Attribute.UWTable);
-      (* CHECK: X7{{.*}}#0{{.*}}personality{{.*}}@__gxx_personality_v0
-       * #0 is uwtable, defined at EOF.
-       *)
-      insist ([Attribute.UWTable] = function_attr fn);
+    let signext  = create_enum_attr context "signext" 0L in
+    let zeroext  = create_enum_attr context "zeroext" 0L in
+    let noalias  = create_enum_attr context "noalias" 0L in
+    let nounwind = create_enum_attr context "nounwind" 0L in
+    let no_sse   = create_string_attr context "no-sse" "" in
+
+    add_function_attr fn signext (AttrIndex.Param 0);
+    add_function_attr fn noalias (AttrIndex.Param 1);
+    insist ((function_attrs fn (AttrIndex.Param 1)) = [|noalias|]);
+    remove_enum_function_attr fn (enum_attr_kind "noalias") (AttrIndex.Param 1);
+    add_function_attr fn no_sse (AttrIndex.Param 1);
+    insist ((function_attrs fn (AttrIndex.Param 1)) = [|no_sse|]);
+    remove_string_function_attr fn "no-sse" (AttrIndex.Param 1);
+    insist ((function_attrs fn (AttrIndex.Param 1)) = [||]);
+    add_function_attr fn nounwind AttrIndex.Function;
+    add_function_attr fn zeroext AttrIndex.Return;
+
+    (* CHECK: define zeroext i32 @X7(i32 signext %P1, i32 %P2)
+     *)
   end;
 
   group "casts"; begin
@@ -1057,7 +1101,7 @@ let test_builder () =
   end;
 
   group "miscellaneous"; begin
-    (* CHECK: %build_call = tail call cc63 i32 @{{.*}}(i32 signext %P2, i32 %P1)
+    (* CHECK: %build_call = tail call cc63 zeroext i32 @{{.*}}(i32 signext %P2, i32 %P1)
      * CHECK: %build_select = select i1 %build_icmp, i32 %P1, i32 %P2
      * CHECK: %build_va_arg = va_arg i8** null, i32
      * CHECK: %build_extractelement = extractelement <4 x i32> %Vec1, i32 %P2
@@ -1073,9 +1117,23 @@ let test_builder () =
     insist (not (is_tail_call ci));
     set_tail_call true ci;
     insist (is_tail_call ci);
-    add_instruction_param_attr ci 1 Attribute.Sext;
-    add_instruction_param_attr ci 2 Attribute.Noalias;
-    remove_instruction_param_attr ci 2 Attribute.Noalias;
+
+    let signext  = create_enum_attr context "signext" 0L in
+    let zeroext  = create_enum_attr context "zeroext" 0L in
+    let noalias  = create_enum_attr context "noalias" 0L in
+    let noreturn = create_enum_attr context "noreturn" 0L in
+    let no_sse   = create_string_attr context "no-sse" "" in
+
+    add_call_site_attr ci signext (AttrIndex.Param 0);
+    add_call_site_attr ci noalias (AttrIndex.Param 1);
+    insist ((call_site_attrs ci (AttrIndex.Param 1)) = [|noalias|]);
+    remove_enum_call_site_attr ci (enum_attr_kind "noalias") (AttrIndex.Param 1);
+    add_call_site_attr ci no_sse (AttrIndex.Param 1);
+    insist ((call_site_attrs ci (AttrIndex.Param 1)) = [|no_sse|]);
+    remove_string_call_site_attr ci "no-sse" (AttrIndex.Param 1);
+    insist ((call_site_attrs ci (AttrIndex.Param 1)) = [||]);
+    add_call_site_attr ci noreturn AttrIndex.Function;
+    add_call_site_attr ci zeroext AttrIndex.Return;
 
     let inst46 = build_icmp Icmp.Eq p1 p2 "build_icmp" atentry in
     ignore (build_select inst46 p1 p2 "build_select" atentry);
@@ -1421,7 +1479,6 @@ let test_builder () =
   end
 
 (* End-of-file checks for things like metdata and attributes.
- * CHECK: attributes #0 = {{.*}}uwtable{{.*}}
  * CHECK: !llvm.module.flags = !{!0}
  * CHECK: !0 = !{i32 1, !"Debug Info Version", i32 3}
  * CHECK: !1 = !{i32 1, !"metadata test"}
@@ -1479,6 +1536,7 @@ let _ =
   suite "conversion"       test_conversion;
   suite "target"           test_target;
   suite "constants"        test_constants;
+  suite "attributes"       test_attributes;
   suite "global values"    test_global_values;
   suite "global variables" test_global_variables;
   suite "uses"             test_uses;