OCaml parameter attribute bindings from PR2752.

Incomplete, but better than nothing.


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

3 files changed, 121 insertions, 1 deletions

diff --git a/bindings/ocaml/llvm/llvm.ml b/bindings/ocaml/llvm/llvm.ml
index 438663e..a3a614d 100644
--- a/bindings/ocaml/llvm/llvm.ml
+++ b/bindings/ocaml/llvm/llvm.ml
@@ -64,6 +64,21 @@ module CallConv = struct
   let x86_fastcall = 65
 end
 
+module Attribute = struct
+  type t =
+  | Zext
+  | Sext
+  | Noreturn
+  | Inreg
+  | Structret
+  | Nounwind
+  | Noalias
+  | Byval
+  | Nest
+  | Readnone
+  | Readonly
+end
+
 module Icmp = struct
   type t =
   | Eq
@@ -418,7 +433,10 @@ 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
 
-(* TODO: param attrs *)
+external add_function_attr : llvalue -> Attribute.t -> unit
+                           = "llvm_add_function_attr"
+external remove_function_attr : llvalue -> Attribute.t -> unit
+                              = "llvm_remove_function_attr"
 
 (*--... Operations on params ...............................................--*)
 external params : llvalue -> llvalue array = "llvm_params"
@@ -469,6 +487,13 @@ 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 add_param_attr : llvalue -> Attribute.t -> unit
+                        = "llvm_add_param_attr"
+external remove_param_attr : llvalue -> Attribute.t -> unit
+                           = "llvm_remove_param_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"
@@ -586,6 +611,10 @@ external instruction_call_conv: llvalue -> int
                               = "llvm_instruction_call_conv"
 external set_instruction_call_conv: int -> llvalue -> unit
                                   = "llvm_set_instruction_call_conv"
+external add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
+                                    = "llvm_add_instruction_param_attr"
+external remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
+                                       = "llvm_remove_instruction_param_attr"
 
 (*--... 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 06d4b21..421c20c 100644
--- a/bindings/ocaml/llvm/llvm.mli
+++ b/bindings/ocaml/llvm/llvm.mli
@@ -111,6 +111,21 @@ module CallConv : sig
                               convention from C. *)
 end
 
+module Attribute : sig
+  type t =
+  | Zext
+  | Sext
+  | Noreturn
+  | Inreg
+  | Structret
+  | Nounwind
+  | Noalias
+  | Byval
+  | Nest
+  | Readnone
+  | Readonly
+end
+
 (** The predicate for an integer comparison ([icmp]) instruction.
     See the [llvm::ICmpInst::Predicate] enumeration. *)
 module Icmp : sig
@@ -931,6 +946,15 @@ external gc : llvalue -> string option = "llvm_gc"
     [gc]. See the method [llvm::Function::setGC]. *)
 external set_gc : string option -> llvalue -> unit = "llvm_set_gc"
 
+(** [add_function_attr f a] adds attribute [a] to the return type of function
+    [f]. *)
+external add_function_attr : llvalue -> Attribute.t -> unit
+                           = "llvm_add_function_attr"
+
+(** [remove_function_attr f a] removes attribute [a] from the return type of
+    function [f]. *)
+external remove_function_attr : llvalue -> Attribute.t -> unit
+                              = "llvm_remove_function_attr"
 
 (** {7 Operations on params} *)
 
@@ -984,6 +1008,16 @@ 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]. *)
+external add_param_attr : llvalue -> Attribute.t -> unit = "llvm_add_param_attr"
+
+(** [remove_param_attr p a] removes attribute [a] from parameter [p]. *)
+external remove_param_attr : llvalue -> Attribute.t -> unit
+                           = "llvm_remove_param_attr"
+
+(** [set_param_alignment p a] set the alignment of parameter [p] to [a]. *)
+external set_param_alignment : llvalue -> int -> unit
+                             = "llvm_set_param_alignment"
 
 (** {7 Operations on basic blocks} *)
 
@@ -1127,6 +1161,18 @@ external instruction_call_conv: llvalue -> int
 external set_instruction_call_conv: int -> llvalue -> unit
                                   = "llvm_set_instruction_call_conv"
 
+(** [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. *)
+external add_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
+  = "llvm_add_instruction_param_attr"
+
+(** [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. *)
+external remove_instruction_param_attr : llvalue -> int -> Attribute.t -> unit
+  = "llvm_remove_instruction_param_attr"
+
 (** {Operations on call instructions (only)} *)
 
 (** [is_tail_call ci] is [true] if the call instruction [ci] is flagged as
diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 35cd7d2..c4eba13 100644
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -665,6 +665,17 @@ CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
   return Val_unit;
 }
 
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_add_function_attr(LLVMValueRef Arg, value PA) {
+  LLVMAddFunctionAttr(Arg, 1<<Int_val(PA));
+  return Val_unit;
+}
+
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_remove_function_attr(LLVMValueRef Arg, value PA) {
+  LLVMRemoveFunctionAttr(Arg, 1<<Int_val(PA));
+  return Val_unit;
+}
 /*--... Operations on parameters ...........................................--*/
 
 DEFINE_ITERATORS(param, Param, LLVMValueRef, LLVMValueRef, LLVMGetParamParent)
@@ -681,6 +692,24 @@ CAMLprim value llvm_params(LLVMValueRef Fn, value Index) {
   return Params;
 }
 
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_add_param_attr(LLVMValueRef Arg, value PA) {
+  LLVMAddAttribute(Arg, 1<<Int_val(PA));
+  return Val_unit;
+}
+
+/* llvalue -> Attribute.t -> unit */
+CAMLprim value llvm_remove_param_attr(LLVMValueRef Arg, value PA) {
+  LLVMRemoveAttribute(Arg, 1<<Int_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(
@@ -733,6 +762,22 @@ CAMLprim value llvm_set_instruction_call_conv(value CC, LLVMValueRef Inst) {
   return Val_unit;
 }
 
+/* llvalue -> int -> Attribute.t -> unit */
+CAMLprim value llvm_add_instruction_param_attr(LLVMValueRef Instr,
+                                               value index,
+                                               value PA) {
+  LLVMAddInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
+  return Val_unit;
+}
+
+/* llvalue -> int -> Attribute.t -> unit */
+CAMLprim value llvm_remove_instruction_param_attr(LLVMValueRef Instr,
+                                                  value index,
+                                                  value PA) {
+  LLVMRemoveInstrAttribute(Instr, Int_val(index), 1<<Int_val(PA));
+  return Val_unit;
+}
+
 /*--... Operations on call instructions (only) .............................--*/
 
 /* llvalue -> bool */