[OCaml] Code simplification using option allocation functions

[jberdine]

Summary

Using the caml_alloc_some and ptr_to_option functions that
allocate OCaml option values enables simplifications in many
cases. These simplifications also result in avoiding unnecessary
double initialization in many cases, so yield a minor optimization as
well.

Also, change to avoid using the old unprefixed functions such as
alloc_small and instead use the current caml_alloc_small.

A few of the changed functions were slightly rewritten in the
early-return style.

llvm/bindings/ocaml/llvm/llvm_ocaml.c

 \*===----------------------------------------------------------------------===*/
 
 #include <assert.h>
 #include <stdlib.h>
 #include <string.h>
 #include "llvm-c/Core.h"
 #include "llvm-c/Support.h"
 #include "llvm/Config/llvm-config.h"
 #include "caml/memory.h"
 #include "caml/fail.h"
 #include "caml/callback.h"
 #include "llvm_ocaml.h"
 
 #if OCAML_VERSION < 41200
 value caml_alloc_some(value v) {
   CAMLparam1(v);
   value Some = caml_alloc_small(1, 0);
CAMLprim value llvm_parse_command_line_options(value Overview, value Args) {
   } else {
     COverview = String_val(Field(Overview, 0));
   }
   LLVMParseCommandLineOptions(Wosize_val(Args), (const char* const*) Op_val(Args), COverview);
   return Val_unit;
 }
 
 static value alloc_variant(int tag, void *Value) {
-  value Iter = alloc_small(1, tag);
+  value Iter = caml_alloc_small(1, tag);
   Field(Iter, 0) = Val_op(Value);
   return Iter;
 }
 
 /* Macro to convert the C first/next/last/prev idiom to the Ocaml llpos/
    llrev_pos idiom. */
 #define DEFINE_ITERATORS(camlname, cname, pty, cty, pfun) \
   /* llmodule -> ('a, 'b) llpos */                        \
if (LLVMContextGetDiagnosticHandler(C) ==
     remove_global_root(Handler);
     free(Handler);
   }
 }
 
 /* llcontext -> (Diagnostic.t -> unit) option -> unit */
 CAMLprim value llvm_set_diagnostic_handler(LLVMContextRef C, value Handler) {
   llvm_remove_diagnostic_handler(C);
-  if (Handler == Val_int(0)) {
+  if (Handler == Val_none) {
     LLVMContextSetDiagnosticHandler(C, NULL, NULL);
   } else {
     value *DiagnosticContext = malloc(sizeof(value));
     if (DiagnosticContext == NULL)
       caml_raise_out_of_memory();
     caml_register_global_root(DiagnosticContext);
     *DiagnosticContext = Field(Handler, 0);
     LLVMContextSetDiagnosticHandler(C, llvm_diagnostic_handler_trampoline,
CAMLprim value llvm_struct_set_body(LLVMTypeRef Ty,
   return Val_unit;
 }
 
 /* lltype -> string option */
 CAMLprim value llvm_struct_name(LLVMTypeRef Ty) {
   const char *CStr = LLVMGetStructName(Ty);
   size_t Len;
   if (!CStr)
-    return Val_int(0);
+    return Val_none;
   Len = strlen(CStr);
   return cstr_to_string_option(CStr, Len);
 }
 
 /* lltype -> lltype array */
 CAMLprim value llvm_struct_element_types(LLVMTypeRef StructTy) {
   value Tys = caml_alloc_tuple_uninit(LLVMCountStructElementTypes(StructTy));
   LLVMGetStructElementTypes(StructTy, (LLVMTypeRef *)Op_val(Tys));
CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
   return LLVMLabelTypeInContext(Context);
 }
 
 /* llcontext -> lltype */
 CAMLprim LLVMTypeRef llvm_x86_mmx_type(LLVMContextRef Context) {
   return LLVMX86MMXTypeInContext(Context);
 }
 
-CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
-{
+CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name) {
   CAMLparam1(Name);
   LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
-  if (Ty) {
-    value Option = alloc(1, 0);
-    Field(Option, 0) = (value) Ty;
-    CAMLreturn(Option);
-  }
-  CAMLreturn(Val_int(0));
+  CAMLreturn(ptr_to_option(Ty));
 }
 
 /*===-- VALUES ------------------------------------------------------------===*/
 
 /* llvalue -> lltype */
 CAMLprim LLVMTypeRef llvm_type_of(LLVMValueRef Val) {
   return LLVMTypeOf(Val);
 }

 /* 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));
+  CAMLreturn(ptr_to_option(LLVMGetMetadata(Val, Int_val(MDKindID))));
 }
 
 /* llvalue -> int -> llvalue -> unit */
 CAMLprim value llvm_set_metadata(LLVMValueRef Val, value MDKindID,
                                  LLVMValueRef MD) {
   LLVMSetMetadata(Val, Int_val(MDKindID), MD);
   return Val_unit;
 }

 
 /* lltype -> Int64.t -> bool -> llvalue */
 CAMLprim LLVMValueRef llvm_const_of_int64(LLVMTypeRef IntTy, value N,
                                           value SExt) {
   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));
+CAMLprim value llvm_int64_of_const(LLVMValueRef Const) {
+  if (!(LLVMIsAConstantInt(Const)) ||
+      !(LLVMGetIntTypeWidth(LLVMTypeOf(Const)) <= 64))
+    return Val_none;
+  return caml_alloc_some(caml_copy_int64(LLVMConstIntGetSExtValue(Const)));
 }
 
 /* lltype -> string -> int -> llvalue */
 CAMLprim LLVMValueRef llvm_const_int_of_string(LLVMTypeRef IntTy, value S,
                                                value Radix) {
   return LLVMConstIntOfStringAndSize(IntTy, String_val(S), caml_string_length(S),
                                      Int_val(Radix));
 }
 
 /* lltype -> float -> llvalue */
 CAMLprim LLVMValueRef llvm_const_float(LLVMTypeRef RealTy, value N) {
   return LLVMConstReal(RealTy, Double_val(N));
 }
 
-
 /* llvalue -> float */
-CAMLprim value llvm_float_of_const(LLVMValueRef Const)
-{
-  CAMLparam0();
-  CAMLlocal1(Option);
+CAMLprim value llvm_float_of_const(LLVMValueRef Const) {
   LLVMBool LosesInfo;
   double Result;
 
-  if (LLVMIsAConstantFP(Const)) {
-    Result = LLVMConstRealGetDouble(Const, &LosesInfo);
-    if (LosesInfo)
-        CAMLreturn(Val_int(0));
-
-    Option = alloc(1, 0);
-    Field(Option, 0) = caml_copy_double(Result);
-    CAMLreturn(Option);
-  }
+  if (!LLVMIsAConstantFP(Const))
+    return Val_none;
+
+    return Val_none;
 
-  CAMLreturn(Val_int(0));
+  return caml_alloc_some(caml_copy_double(Result));
 }
 
 /* lltype -> string -> llvalue */
 CAMLprim LLVMValueRef llvm_const_float_of_string(LLVMTypeRef RealTy, value S) {
   return LLVMConstRealOfStringAndSize(RealTy, String_val(S),
                                       caml_string_length(S));
 }
 
return LLVMConstVector((LLVMValueRef*) Op_val(ElementVals),
                          Wosize_val(ElementVals));
 }
 
 /* llvalue -> string option */
 CAMLprim value llvm_string_of_const(LLVMValueRef Const) {
   size_t Len;
   const char *CStr;
   if (!LLVMIsAConstantDataSequential(Const) || !LLVMIsConstantString(Const))
-    return Val_int(0);
+    return Val_none;
   CStr = LLVMGetAsString(Const, &Len);
   return cstr_to_string_option(CStr, Len);
 }
 
 /* llvalue -> int -> llvalue */
 CAMLprim LLVMValueRef llvm_const_element(LLVMValueRef Const, value N) {
   return LLVMGetElementAsConstant(Const, Int_val(N));
 }
CAMLprim value llvm_global_copy_all_metadata(LLVMValueRef Global) {
   LLVMDisposeValueMetadataEntries(Entries);
   CAMLreturn(Array);
 }
 
 /*--... Operations on uses .................................................--*/
 
 /* llvalue -> lluse option */
 CAMLprim value llvm_use_begin(LLVMValueRef Val) {
-  CAMLparam0();
-  LLVMUseRef First;
-  if ((First = LLVMGetFirstUse(Val))) {
-    value Option = alloc(1, 0);
-    Field(Option, 0) = (value) First;
-    CAMLreturn(Option);
-  }
-  CAMLreturn(Val_int(0));
+  return ptr_to_option(LLVMGetFirstUse(Val));
 }
 
 /* lluse -> lluse option */
 CAMLprim value llvm_use_succ(LLVMUseRef U) {
-  CAMLparam0();
-  LLVMUseRef Next;
-  if ((Next = LLVMGetNextUse(U))) {
-    value Option = alloc(1, 0);
-    Field(Option, 0) = (value) Next;
-    CAMLreturn(Option);
-  }
-  CAMLreturn(Val_int(0));
+  return ptr_to_option(LLVMGetNextUse(U));
 }
 
 /* lluse -> llvalue */
 CAMLprim LLVMValueRef llvm_user(LLVMUseRef UR) {
   return LLVMGetUser(UR);
 }
 
 /* lluse -> llvalue */
CAMLprim LLVMValueRef llvm_declare_qualified_global(LLVMTypeRef Ty, value Name,
   }
   return LLVMAddGlobalInAddressSpace(M, Ty, String_val(Name),
                                      Int_val(AddressSpace));
 }
 
 /* string -> llmodule -> llvalue option */
 CAMLprim value llvm_lookup_global(value Name, LLVMModuleRef M) {
   CAMLparam1(Name);
-  LLVMValueRef GlobalVar;
-  if ((GlobalVar = LLVMGetNamedGlobal(M, String_val(Name)))) {
-    value Option = alloc(1, 0);
-    Field(Option, 0) = (value) GlobalVar;
-    CAMLreturn(Option);
-  }
-  CAMLreturn(Val_int(0));
+  CAMLreturn(ptr_to_option(LLVMGetNamedGlobal(M, String_val(Name))));
 }
 
 /* string -> llvalue -> llmodule -> llvalue */
 CAMLprim LLVMValueRef llvm_define_global(value Name, LLVMValueRef Initializer,
                                          LLVMModuleRef M) {
   LLVMValueRef GlobalVar = LLVMAddGlobal(M, LLVMTypeOf(Initializer),
                                          String_val(Name));
   LLVMSetInitializer(GlobalVar, Initializer);
if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
     return Fn;
   }
   return LLVMAddFunction(M, String_val(Name), Ty);
 }
 
 /* string -> llmodule -> llvalue option */
 CAMLprim value llvm_lookup_function(value Name, LLVMModuleRef M) {
   CAMLparam1(Name);
-  LLVMValueRef Fn;
-  if ((Fn = LLVMGetNamedFunction(M, String_val(Name)))) {
-    value Option = alloc(1, 0);
-    Field(Option, 0) = (value) Fn;
-    CAMLreturn(Option);
-  }
-  CAMLreturn(Val_int(0));
+  CAMLreturn(ptr_to_option(LLVMGetNamedFunction(M, String_val(Name))));
 }
 
 /* string -> lltype -> llmodule -> llvalue */
 CAMLprim LLVMValueRef llvm_define_function(value Name, LLVMTypeRef Ty,
                                            LLVMModuleRef M) {
   LLVMValueRef Fn = LLVMAddFunction(M, String_val(Name), Ty);
   LLVMAppendBasicBlockInContext(LLVMGetTypeContext(Ty), Fn, "entry");
   return Fn;

 /* int -> llvalue -> unit */
 CAMLprim value llvm_set_function_call_conv(value Id, LLVMValueRef Fn) {
   LLVMSetFunctionCallConv(Fn, Int_val(Id));
   return Val_unit;
 }
 
 /* llvalue -> string option */
 CAMLprim value llvm_gc(LLVMValueRef Fn) {
-  const char *GC;
-  CAMLparam0();
-  CAMLlocal2(Name, Option);
+  const char *GC = LLVMGetGC(Fn);
 
-  if ((GC = LLVMGetGC(Fn))) {
-    Name = caml_copy_string(GC);
+  if (!GC)
+    return Val_none;
 
-    Option = alloc(1, 0);
-    Field(Option, 0) = Name;
-    CAMLreturn(Option);
-  } else {
-    CAMLreturn(Val_int(0));
-  }
+  return caml_alloc_some(caml_copy_string(GC));
 }
 
 /* string option -> llvalue -> unit */
 CAMLprim value llvm_set_gc(value GC, LLVMValueRef Fn) {
-  LLVMSetGC(Fn, GC == Val_int(0)? 0 : String_val(Field(GC, 0)));
+  LLVMSetGC(Fn, GC == Val_none ? 0 : String_val(Field(GC, 0)));
   return Val_unit;
 }
 
 /* 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;

 }
 
 /*--... Operations on basic blocks .........................................--*/
 
 DEFINE_ITERATORS(
   block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
 
 /* llbasicblock -> llvalue option */
-CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
-{
-  CAMLparam0();
-  LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
-  if (Term) {
-    value Option = alloc(1, 0);
-    Field(Option, 0) = (value) Term;
-    CAMLreturn(Option);
-  }
-  CAMLreturn(Val_int(0));
+CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block) {
+  return ptr_to_option(LLVMGetBasicBlockTerminator(Block));
 }
 
 /* llvalue -> llbasicblock array */
 CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
   value MLArray = caml_alloc_tuple_uninit(LLVMCountBasicBlocks(Fn));
   LLVMGetBasicBlocks(Fn, (LLVMBasicBlockRef *)Op_val(MLArray));
   return MLArray;
 }
if (!LLVMIsAInstruction(Inst))
       failwith("Not an instruction");
   o = LLVMGetInstructionOpcode(Inst);
   assert(o <= LLVMFreeze);
   return Val_int(o);
 }
 
 /* llvalue -> ICmp.t option */
 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));
+  if (!x)
+    return Val_none;
+  return caml_alloc_some(Val_int(x - LLVMIntEQ));
 }
 
 /* llvalue -> FCmp.t option */
 CAMLprim value llvm_instr_fcmp_predicate(LLVMValueRef Val) {
-  CAMLparam0();
   int x = LLVMGetFCmpPredicate(Val);
-  if (x) {
-    value Option = alloc(1, 0);
-    Field(Option, 0) = Val_int(x - LLVMRealPredicateFalse);
-    CAMLreturn(Option);
-  }
-  CAMLreturn(Val_int(0));
+  if (!x)
+    return Val_none;
+  return caml_alloc_some(Val_int(x - LLVMRealPredicateFalse));
 }
 
 /* llvalue -> llvalue */
 CAMLprim LLVMValueRef llvm_instr_clone(LLVMValueRef Inst) {
   if (!LLVMIsAInstruction(Inst))
       failwith("Not an instruction");
   return LLVMInstructionClone(Inst);
 }

 /* 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));
+  return ptr_to_option(LLVMGetCurrentDebugLocation(Builder_val(B)));
 }
 
 /* llbuilder -> llvalue -> unit */
 CAMLprim value llvm_set_inst_debug_location(value B, LLVMValueRef V) {
   LLVMSetInstDebugLocation(Builder_val(B), V);
   return Val_unit;
 }