[OCaml] Add (get/set)_module_identifer functions

[vaivaswatha]

Summary

Also

1. Fix a bug that crept in when fixing a buildbot failure in https://github.com/llvm/llvm-project/commit/f7be9db6220cb39f0eaa12d2af3abedf0d86c303
2. Use mlsize_t for cstr_to_string as that is what caml_alloc_string specifies.

[jberdine]

LGTM

llvm/bindings/ocaml/llvm/llvm.mli

550

llvm/bindings/ocaml/llvm/llvm_ocaml.c

47

It might be more clear to use mlsize_t as that is what caml_alloc_string requires, and push any conversion that might be needed to the clients.

[vaivaswatha]

Use mlsize_t for cstr_to_string as suggested in the review.

[vaivaswatha]

Whitespace changes

[jberdine]

llvm/bindings/ocaml/llvm/llvm_ocaml.c

342

Does this still warn without the cast? I was expecting this cast to be not needed anymore.

[vaivaswatha]

llvm/bindings/ocaml/llvm/llvm_ocaml.c

342

I didn't get a warning on my system. I added this to make the conversion explicit, because size_t can be strictly larger than mlsize_t which is defined to be unsigned long. I'm not sure if other systems might throw a warning though.

[jberdine]

llvm/bindings/ocaml/llvm/llvm_ocaml.c

342

Ok, that's fine. Just note that the rest of this code is not following that convention currently. See e.g. llvm_get_string_attr_value which passes an unsigned Length to caml_alloc_string. Also, caml_string_length returns an mlsize_t which is implicitly converted to size_t in a number of places.

[vaivaswatha]

llvm/bindings/ocaml/llvm/llvm_ocaml.c

342

Passing unsigned to mlsize_t should be safe right? At most it will be a widening.

[jberdine]

llvm/bindings/ocaml/llvm/llvm_ocaml.c

342

That is my understanding, yes. The definition of mlsize_t is here which uses uintnat defined here. Note that uintnat is defined conditionally based on the size of pointers. So AFAIU it will be compatible with size_t or ocaml will fail to build.

[vaivaswatha]

llvm/bindings/ocaml/llvm/llvm_ocaml.c

342

Shall I go ahead and commit?

[jberdine]

llvm/bindings/ocaml/llvm/llvm_ocaml.c

342

Yes, go ahead. I did not mean to imply that there is a problem, only that having the explicit cast here is not the same convention as currently used in the rest of the file, where such casts are left implicit. Your call.

[vaivaswatha]

llvm/bindings/ocaml/llvm/llvm_ocaml.c

342

Thank you very much for the review @jberdine .

llvm/bindings/ocaml/llvm/llvm.ml

 external set_data_layout: string -> llmodule -> unit
                         = "llvm_set_data_layout"
 external dump_module : llmodule -> unit = "llvm_dump_module"
 external print_module : string -> llmodule -> unit = "llvm_print_module"
 external string_of_llmodule : llmodule -> string = "llvm_string_of_llmodule"
 external set_module_inline_asm : llmodule -> string -> unit
                                = "llvm_set_module_inline_asm"
 external module_context : llmodule -> llcontext = "LLVMGetModuleContext"
+
+external get_module_identifier : llmodule -> string
+                               = "llvm_get_module_identifier"
+
+external set_module_identifer : llmodule -> string -> unit
+                              = "llvm_set_module_identifier"
+
 external get_module_flag : llmodule -> string -> llmetadata option
                          = "llvm_get_module_flag"
 external add_module_flag : llmodule -> ModuleFlagBehavior.t ->
             string -> llmetadata -> unit = "llvm_add_module_flag"
 
 (*===-- Types -------------------------------------------------------------===*)
 external classify_type : lltype -> TypeKind.t = "llvm_classify_type"
 external type_context : lltype -> llcontext = "llvm_type_context"

llvm/bindings/ocaml/llvm/llvm.mli

 (** [set_module_inline_asm m asm] sets the inline assembler for the module. See
     the method [llvm::Module::setModuleInlineAsm]. *)
 val set_module_inline_asm : llmodule -> string -> unit
 
 (** [module_context m] returns the context of the specified module.
     See the method [llvm::Module::getContext] *)
 val module_context : llmodule -> llcontext
 
+(** [get_module_identifier m] returns the module identifier of the
+    specified module. See the method [llvm::Module::getModuleIdentifier] *)
+val get_module_identifier : llmodule -> string
+
+(** [set_module_identifier m id] sets the module identifier of [m]
+    to [id]. See the method [llvm::Module::setModuleIdentifier] *)
+val set_module_identifer : llmodule -> string -> unit
+
 (** [get_module_flag m k] Return the corresponding value if key [k] appears in
     the module flags of [m], otherwise return None
     See the method [llvm::Module::getModuleFlag] *)
 val get_module_flag : llmodule -> string -> llmetadata option
 
 (** [add_module_flag m b k v] Add a module-level flag b, with key [k] and
     value [v] to the flags metadata of module [m]. It will create the 
     module-level flags named metadata if it doesn't already exist. *)

llvm/bindings/ocaml/llvm/llvm_ocaml.h

 |* Note that these functions intentionally take liberties with the CAMLparamX *|
 |* macros, since most of the parameters are not GC heap objects.              *|
 |*                                                                            *|
 \*===----------------------------------------------------------------------===*/
 
 #ifndef LLVM_LLVM_OCAML_H
 #define LLVM_LLVM_OCAML_H
 
 #include "caml/alloc.h"
 #include "caml/custom.h"
 
 /* Convert a C pointer to an OCaml option */
 CAMLprim value ptr_to_option(void *Ptr);
 
 /* Convert a C string into an OCaml string */
-CAMLprim value cstr_to_string(const unsigned char *Str, unsigned Len);
+CAMLprim value cstr_to_string(const unsigned char *Str, mlsize_t Len);
 
 #endif // LLVM_LLVM_OCAML_H

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"
 
 value llvm_string_of_message(char* Message) {
   value String = caml_copy_string(Message);
   LLVMDisposeMessage(Message);
 
   return String;
 }
 
 CAMLprim value ptr_to_option(void *Ptr) {
   CAMLparam0();
   CAMLlocal1(Option);
   if (!Ptr)
     CAMLreturn(Val_int(0));
   Option = caml_alloc_small(1, 0);
   Store_field(Option, 0, (value)Ptr);
   CAMLreturn(Option);
 }
 
-CAMLprim value cstr_to_string(const unsigned char *Str, unsigned Len) {
+CAMLprim value cstr_to_string(const unsigned char *Str, mlsize_t Len) {
   CAMLparam0();
   CAMLlocal1(String);
   if (Str) {
     String = caml_alloc_string(Len);
-    memcpy(String_val(Str), Str, Len);
+    memcpy(String_val(String), Str, Len);
   } else {
     String = caml_alloc_string(0);
   }
   CAMLreturn(String);
 }
 
 void llvm_raise(value Prototype, char *Message) {
   CAMLparam1(Prototype);
CAMLprim value llvm_string_of_llmodule(LLVMModuleRef M) {
 
   ModuleCStr = LLVMPrintModuleToString(M);
   ModuleStr = caml_copy_string(ModuleCStr);
   LLVMDisposeMessage(ModuleCStr);
 
   CAMLreturn(ModuleStr);
 }
 
+/* llmodule -> string */
+CAMLprim value llvm_get_module_identifier(LLVMModuleRef M) {
+  size_t Len;
+  const char *Name = LLVMGetModuleIdentifier(M, &Len);
+  return cstr_to_string(Name, (mlsize_t)Len);
+}
+
+/* llmodule -> string -> unit */
+CAMLprim value llvm_set_module_identifier(LLVMModuleRef M, value Id) {
+  LLVMSetModuleIdentifier(M, String_val(Id), caml_string_length(Id));
+  return Val_unit;
+}
+
 /* llmodule -> string -> unit */
 CAMLprim value llvm_set_module_inline_asm(LLVMModuleRef M, value Asm) {
   LLVMSetModuleInlineAsm(M, String_val(Asm));
   return Val_unit;
 }
 
 /* llmodule -> string -> llmetadata option */
 CAMLprim value llvm_get_module_flag(LLVMModuleRef M, value Key) {

llvm/test/Bindings/OCaml/core.ml

let test_global_variables () =
   let g = define_global "ConstGlobalVar" forty_two32 m in
   insist (not (is_global_constant g));
   set_global_constant true g;
   insist (is_global_constant g);
 
   begin group "iteration";
     let m = create_module context "temp" in
 
+    insist (get_module_identifier m = "temp");
+    set_module_identifer m "temp2";
+    insist (get_module_identifier m = "temp2");
+
     insist (At_end m = global_begin m);
     insist (At_start m = global_end m);
 
     let g1 = declare_global i32_type "One" m in
     let g2 = declare_global i32_type "Two" m in
 
     insist (Before g1 = global_begin m);
     insist (Before g2 = global_succ g1);