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

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"

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

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 */

include/llvm-c/Core.h

@@ -504,6 +504,8 @@ unsigned LLVMGetFunctionCallConv(LLVMValueRef Fn);
 void LLVMSetFunctionCallConv(LLVMValueRef Fn, unsigned CC);
 const char *LLVMGetGC(LLVMValueRef Fn);
 void LLVMSetGC(LLVMValueRef Fn, const char *Name);
+void LLVMAddFunctionAttr(LLVMValueRef Fn, LLVMAttribute PA);
+void LLVMRemoveFunctionAttr(LLVMValueRef Fn, LLVMAttribute PA);
 
 /* Operations on parameters */
 unsigned LLVMCountParams(LLVMValueRef Fn);

lib/VMCore/Core.cpp

@@ -776,6 +776,20 @@ void LLVMSetGC(LLVMValueRef Fn, const char *GC) {
     F->clearGC();
 }
 
+void LLVMAddFunctionAttr(LLVMValueRef Fn, LLVMAttribute PA) {
+  Function *Func = unwrap<Function>(Fn);
+  const AttrListPtr PAL = Func->getAttributes();
+  const AttrListPtr PALnew = PAL.addAttr(0, PA);
+  Func->setAttributes(PALnew);
+}
+
+void LLVMRemoveFunctionAttr(LLVMValueRef Fn, LLVMAttribute PA) {
+  Function *Func = unwrap<Function>(Fn);
+  const AttrListPtr PAL = Func->getAttributes();
+  const AttrListPtr PALnew = PAL.removeAttr(0, PA);
+  Func->setAttributes(PALnew);
+}
+
 /*--.. Operations on parameters ............................................--*/
 
 unsigned LLVMCountParams(LLVMValueRef FnRef) {

test/Bindings/Ocaml/vmcore.ml

@@ -626,6 +626,12 @@ 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);
@@ -988,6 +994,10 @@ let test_builder () =
     insist (not (is_tail_call ci));
     set_tail_call true ci;
     insist (is_tail_call ci);
+    add_instruction_param_attr ci 0 Attribute.Nounwind;
+    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 inst46 = build_icmp Icmp.Eq p1 p2 "Inst46" atentry in
          ignore (build_select inst46 p1 p2 "Inst47" atentry);