bindings: named struct support

[oota-llvm.git] / bindings / ocaml / llvm / llvm_ocaml.c

diff --git a/bindings/ocaml/llvm/llvm_ocaml.c b/bindings/ocaml/llvm/llvm_ocaml.c
index 14bdbdd068ac6b9e03c1063c0321108020e0ef90..be6e808d73318d23374fdae623091caff017a75c 100644 (file)
--- a/bindings/ocaml/llvm/llvm_ocaml.c
+++ b/bindings/ocaml/llvm/llvm_ocaml.c
@@ -172,6 +172,10 @@ CAMLprim value llvm_classify_type(LLVMTypeRef Ty) {
   return Val_int(LLVMGetTypeKind(Ty));
 }
 
+CAMLprim value llvm_type_is_sized(LLVMTypeRef Ty) {
+    return Val_bool(LLVMTypeIsSized(Ty));
+}
+
 /* lltype -> llcontext */
 CAMLprim LLVMContextRef llvm_type_context(LLVMTypeRef Ty) {
   return LLVMGetTypeContext(Ty);
@@ -288,18 +292,32 @@ CAMLprim LLVMTypeRef llvm_packed_struct_type(LLVMContextRef C,
                                  Wosize_val(ElementTypes), 1);
 }
 
+/* llcontext -> string -> lltype */
+CAMLprim LLVMTypeRef llvm_named_struct_type(LLVMContextRef C,
+                                            value Name) {
+  return LLVMStructCreateNamed(C, String_val(Name));
+}
+
+CAMLprim value llvm_struct_set_body(LLVMTypeRef Ty,
+                                    value ElementTypes,
+                                    value Packed) {
+  LLVMStructSetBody(Ty, (LLVMTypeRef *) ElementTypes,
+                    Wosize_val(ElementTypes), Bool_val(Packed));
+  return Val_unit;
+}
+
 /* lltype -> string option */
 CAMLprim value llvm_struct_name(LLVMTypeRef Ty)
 {
-    CAMLparam0();
-    const char *C = LLVMGetStructName(Ty);
-    if (C) {
-       CAMLlocal1(result);
-       result = caml_alloc_small(1, 0);
-       Store_field(result, 0, caml_copy_string(C));
-       CAMLreturn(result);
-    }
-    CAMLreturn(Val_int(0));
+  CAMLparam0();
+  const char *C = LLVMGetStructName(Ty);
+  if (C) {
+    CAMLlocal1(result);
+    result = caml_alloc_small(1, 0);
+    Store_field(result, 0, caml_copy_string(C));
+    CAMLreturn(result);
+  }
+  CAMLreturn(Val_int(0));
 }
 
 /* lltype -> lltype array */
@@ -314,6 +332,11 @@ CAMLprim value llvm_is_packed(LLVMTypeRef StructTy) {
   return Val_bool(LLVMIsPackedStruct(StructTy));
 }
 
+/* lltype -> bool */
+CAMLprim value llvm_is_opaque(LLVMTypeRef StructTy) {
+  return Val_bool(LLVMIsOpaqueStruct(StructTy));
+}
+
 /*--... Operations on array, pointer, and vector types .....................--*/
 
 /* lltype -> int -> lltype */
@@ -371,6 +394,69 @@ CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) {
   return LLVMTypeOf(Val);
 }
 
+/* keep in sync with ValueKind.t */
+enum ValueKind {
+  NullValue=0,
+  Argument,
+  BasicBlock,
+  InlineAsm,
+  MDNode,
+  MDString,
+  BlockAddress,
+  ConstantAggregateZero,
+  ConstantArray,
+  ConstantExpr,
+  ConstantFP,
+  ConstantInt,
+  ConstantPointerNull,
+  ConstantStruct,
+  ConstantVector,
+  Function,
+  GlobalAlias,
+  GlobalVariable,
+  UndefValue,
+  Instruction
+};
+
+/* llvalue -> ValueKind.t */
+#define DEFINE_CASE(Val, Kind) \
+    do {if (LLVMIsA##Kind(Val)) CAMLreturn(Val_int(Kind));} while(0)
+
+CAMLprim value llvm_classify_value(LLVMValueRef Val) {
+  CAMLparam0();
+  if (!Val)
+    CAMLreturn(Val_int(NullValue));
+  if (LLVMIsAConstant(Val)) {
+    DEFINE_CASE(Val, BlockAddress);
+    DEFINE_CASE(Val, ConstantAggregateZero);
+    DEFINE_CASE(Val, ConstantArray);
+    DEFINE_CASE(Val, ConstantExpr);
+    DEFINE_CASE(Val, ConstantFP);
+    DEFINE_CASE(Val, ConstantInt);
+    DEFINE_CASE(Val, ConstantPointerNull);
+    DEFINE_CASE(Val, ConstantStruct);
+    DEFINE_CASE(Val, ConstantVector);
+  }
+  if (LLVMIsAInstruction(Val)) {
+    CAMLlocal1(result);
+    result = caml_alloc_small(1, 0);
+    Store_field(result, 0, Val_int(LLVMGetInstructionOpcode(Val)));
+    CAMLreturn(result);
+  }
+  if (LLVMIsAGlobalValue(Val)) {
+    DEFINE_CASE(Val, Function);
+    DEFINE_CASE(Val, GlobalAlias);
+    DEFINE_CASE(Val, GlobalVariable);
+  }
+  DEFINE_CASE(Val, Argument);
+  DEFINE_CASE(Val, BasicBlock);
+  DEFINE_CASE(Val, InlineAsm);
+  DEFINE_CASE(Val, MDNode);
+  DEFINE_CASE(Val, MDString);
+  DEFINE_CASE(Val, UndefValue);
+  failwith("Unknown Value class");
+}
+
 /* llvalue -> string */
 CAMLprim value llvm_value_name(LLVMValueRef Val) {
   return copy_string(LLVMGetValueName(Val));
@@ -423,6 +509,12 @@ CAMLprim value llvm_is_undef(LLVMValueRef Val) {
   return Val_bool(LLVMIsUndef(Val));
 }
 
+/* llvalue -> Opcode.t */
+CAMLprim value llvm_constexpr_get_opcode(LLVMValueRef Val) {
+  return LLVMIsAConstantExpr(Val) ?
+      Val_int(LLVMGetConstOpcode(Val)) : Val_int(0);
+}
+
 /*--... Operations on instructions .........................................--*/
 
 /* llvalue -> bool */
@@ -471,20 +563,20 @@ CAMLprim LLVMValueRef llvm_mdnode(LLVMContextRef C, value ElementVals) {
 
 /* llvalue -> string option */
 CAMLprim value llvm_get_mdstring(LLVMValueRef V) {
-    CAMLparam0();
-    const char *S;
-    unsigned Len;
-
-    if ((S = LLVMGetMDString(V, &Len))) {
-       CAMLlocal2(Option, Str);
-
-       Str = caml_alloc_string(Len);
-       memcpy(String_val(Str), S, Len);
-       Option = alloc(1,0);
-       Store_field(Option, 0, Str);
-       CAMLreturn(Option);
-    }
-    CAMLreturn(Val_int(0));
+  CAMLparam0();
+  const char *S;
+  unsigned Len;
+
+  if ((S = LLVMGetMDString(V, &Len))) {
+    CAMLlocal2(Option, Str);
+
+    Str = caml_alloc_string(Len);
+    memcpy(String_val(Str), S, Len);
+    Option = alloc(1,0);
+    Store_field(Option, 0, Str);
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
 }
 
 CAMLprim value llvm_get_namedmd(LLVMModuleRef M, value name)
@@ -508,6 +600,19 @@ CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N,
   return LLVMConstInt(IntTy, Int64_val(N), Bool_val(SExt));
 }
 
+/* llvalue -> Int64.t */
+CAMLprim value llvm_int64_of_const(LLVMValueRef Const)
+{
+  CAMLparam0();
+  if (LLVMIsAConstantInt(Const) &&
+      LLVMGetIntTypeWidth(LLVMTypeOf(Const)) <= 64) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = caml_copy_int64(LLVMConstIntGetSExtValue(Const));
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
 /* lltype -> string -> int -> llvalue */
 CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S,
                                                value Radix) {
@@ -555,6 +660,11 @@ CAMLprim LLVMValueRef llvm_const_struct(LLVMContextRef C, value ElementVals) {
                                   Wosize_val(ElementVals), 0);
 }
 
+/* lltype -> llvalue array -> llvalue */
+CAMLprim LLVMValueRef llvm_const_named_struct(LLVMTypeRef Ty, value ElementVals) {
+    return LLVMConstNamedStruct(Ty, (LLVMValueRef *) Op_val(ElementVals),  Wosize_val(ElementVals));
+}
+
 /* llcontext -> llvalue array -> llvalue */
 CAMLprim LLVMValueRef llvm_const_packed_struct(LLVMContextRef C,
                                                value ElementVals) {
@@ -1009,6 +1119,28 @@ CAMLprim value llvm_value_is_block(LLVMValueRef Val) {
 DEFINE_ITERATORS(instr, Instruction, LLVMBasicBlockRef, LLVMValueRef,
                  LLVMGetInstructionParent)
 
+/* llvalue -> Opcode.t */
+CAMLprim value llvm_instr_get_opcode(LLVMValueRef Inst) {
+  LLVMOpcode o;
+  if (!LLVMIsAInstruction(Inst))
+      failwith("Not an instruction");
+  o = LLVMGetInstructionOpcode(Inst);
+  assert (o <= LLVMUnwind );
+  return Val_int(o);
+}
+
+/* llvalue -> ICmp.t */
+CAMLprim value llvm_instr_icmp_predicate(LLVMValueRef Val) {
+  CAMLparam0();
+  int x = LLVMGetICmpPredicate(Val);
+  if (x) {
+    value Option = alloc(1, 0);
+    Field(Option, 0) = Val_int(x - LLVMIntEQ);
+    CAMLreturn(Option);
+  }
+  CAMLreturn(Val_int(0));
+}
+
 
 /*--... Operations on call sites ...........................................--*/