Deprecate Bigarray.*.map_file and add Unix.map_file (#997)

To break the circular dependency between Bigarray and Unix, a CamlinternalBigarray module was added to the stdlib. This module defines all the types used by the compiler to produce optimized code for bigarrays.

Thanks to David Allsopp for fixing Windows tests.

4 files changed, 54 insertions, 134 deletions

diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml
index 8d697150b5..fd0034915d 100644
--- a/otherlibs/bigarray/bigarray.ml
+++ b/otherlibs/bigarray/bigarray.ml
@@ -19,33 +19,7 @@ external init : unit -> unit = "caml_ba_init"
 
 let _ = init()
 
-type float32_elt = Float32_elt
-type float64_elt = Float64_elt
-type int8_signed_elt = Int8_signed_elt
-type int8_unsigned_elt = Int8_unsigned_elt
-type int16_signed_elt = Int16_signed_elt
-type int16_unsigned_elt = Int16_unsigned_elt
-type int32_elt = Int32_elt
-type int64_elt = Int64_elt
-type int_elt = Int_elt
-type nativeint_elt = Nativeint_elt
-type complex32_elt = Complex32_elt
-type complex64_elt = Complex64_elt
-
-type ('a, 'b) kind =
-    Float32 : (float, float32_elt) kind
-  | Float64 : (float, float64_elt) kind
-  | Int8_signed : (int, int8_signed_elt) kind
-  | Int8_unsigned : (int, int8_unsigned_elt) kind
-  | Int16_signed : (int, int16_signed_elt) kind
-  | Int16_unsigned : (int, int16_unsigned_elt) kind
-  | Int32 : (int32, int32_elt) kind
-  | Int64 : (int64, int64_elt) kind
-  | Int : (int, int_elt) kind
-  | Nativeint : (nativeint, nativeint_elt) kind
-  | Complex32 : (Complex.t, complex32_elt) kind
-  | Complex64 : (Complex.t, complex64_elt) kind
-  | Char : (char, int8_unsigned_elt) kind
+include CamlinternalBigarray
 
 (* Keep those constants in sync with the caml_ba_kind enumeration
    in bigarray.h *)
@@ -79,13 +53,6 @@ let kind_size_in_bytes : type a b. (a, b) kind -> int = function
   | Complex64 -> 16
   | Char -> 1
 
-type c_layout = C_layout_typ
-type fortran_layout = Fortran_layout_typ
-
-type 'a layout =
-    C_layout: c_layout layout
-  | Fortran_layout: fortran_layout layout
-
 (* Keep those constants in sync with the caml_ba_layout enumeration
    in bigarray.h *)
 
@@ -93,7 +60,7 @@ let c_layout = C_layout
 let fortran_layout = Fortran_layout
 
 module Genarray = struct
-  type ('a, 'b, 'c) t
+  type ('a, 'b, 'c) t = ('a, 'b, 'c) genarray
   external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t
      = "caml_ba_create"
   external get: ('a, 'b, 'c) t -> int array -> 'a
@@ -133,8 +100,12 @@ module Genarray = struct
   external map_internal: Unix.file_descr -> ('a, 'b) kind -> 'c layout ->
                      bool -> int array -> int64 -> ('a, 'b, 'c) t
      = "caml_ba_map_file_bytecode" "caml_ba_map_file"
-  let map_file fd ?(pos = 0L) kind layout shared dims =
-    map_internal fd kind layout shared dims pos
+  let () = Unix.map_file_impl := { Unix.map_file_impl = map_internal }
+  let map_file fd ?pos kind layout shared dims =
+    try
+      Unix.map_file fd ?pos kind layout shared dims
+    with Unix.Unix_error (error, _, _) ->
+      raise (Sys_error (Unix.error_message error))
 end
 
 module Array0 = struct
diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli
index 2c43088571..24ea8ae0d7 100644
--- a/otherlibs/bigarray/bigarray.mli
+++ b/otherlibs/bigarray/bigarray.mli
@@ -59,20 +59,23 @@
    of abstract types for technical injectivity reasons).
 *)
 
-type float32_elt = Float32_elt
-type float64_elt = Float64_elt
-type int8_signed_elt = Int8_signed_elt
-type int8_unsigned_elt = Int8_unsigned_elt
-type int16_signed_elt = Int16_signed_elt
-type int16_unsigned_elt = Int16_unsigned_elt
-type int32_elt = Int32_elt
-type int64_elt = Int64_elt
-type int_elt = Int_elt
-type nativeint_elt = Nativeint_elt
-type complex32_elt = Complex32_elt
-type complex64_elt = Complex64_elt
-
-type ('a, 'b) kind =
+type float32_elt = CamlinternalBigarray.float32_elt = Float32_elt
+type float64_elt = CamlinternalBigarray.float64_elt = Float64_elt
+type int8_signed_elt = CamlinternalBigarray.int8_signed_elt = Int8_signed_elt
+type int8_unsigned_elt = CamlinternalBigarray.int8_unsigned_elt =
+    Int8_unsigned_elt
+type int16_signed_elt = CamlinternalBigarray.int16_signed_elt =
+    Int16_signed_elt
+type int16_unsigned_elt = CamlinternalBigarray.int16_unsigned_elt =
+    Int16_unsigned_elt
+type int32_elt = CamlinternalBigarray.int32_elt = Int32_elt
+type int64_elt = CamlinternalBigarray.int64_elt = Int64_elt
+type int_elt = CamlinternalBigarray.int_elt = Int_elt
+type nativeint_elt = CamlinternalBigarray.nativeint_elt = Nativeint_elt
+type complex32_elt = CamlinternalBigarray.complex32_elt = Complex32_elt
+type complex64_elt = CamlinternalBigarray.complex64_elt = Complex64_elt
+
+type ('a, 'b) kind = ('a, 'b) CamlinternalBigarray.kind =
     Float32 : (float, float32_elt) kind
   | Float64 : (float, float64_elt) kind
   | Int8_signed : (int, int8_signed_elt) kind
@@ -178,10 +181,11 @@ val kind_size_in_bytes : ('a, 'b) kind -> int
 
 (** {6 Array layouts} *)
 
-type c_layout = C_layout_typ (**)
+type c_layout = CamlinternalBigarray.c_layout = C_layout_typ (**)
 (** See {!Bigarray.fortran_layout}.*)
 
-type fortran_layout = Fortran_layout_typ (**)
+type fortran_layout = CamlinternalBigarray.fortran_layout =
+    Fortran_layout_typ (**)
 (** To facilitate interoperability with existing C and Fortran code,
    this library supports two different memory layouts for big arrays,
    one compatible with the C conventions,
@@ -212,7 +216,7 @@ type fortran_layout = Fortran_layout_typ (**)
    re-exported as values below for backward-compatibility reasons.
 *)
 
-type 'a layout =
+type 'a layout = 'a CamlinternalBigarray.layout =
     C_layout: c_layout layout
   | Fortran_layout: fortran_layout layout
 
@@ -224,7 +228,7 @@ val fortran_layout : fortran_layout layout
 
 module Genarray :
   sig
-  type ('a, 'b, 'c) t
+  type ('a, 'b, 'c) t = ('a, 'b, 'c) CamlinternalBigarray.genarray
   (** The type [Genarray.t] is the type of big arrays with variable
      numbers of dimensions.  Any number of dimensions between 0 and 16
      is supported.
@@ -437,53 +441,10 @@ module Genarray :
   val map_file:
     Unix.file_descr -> ?pos:int64 -> ('a, 'b) kind -> 'c layout ->
     bool -> int array -> ('a, 'b, 'c) t
-  (** Memory mapping of a file as a big array.
-     [Genarray.map_file fd kind layout shared dims]
-     returns a big array of kind [kind], layout [layout],
-     and dimensions as specified in [dims].  The data contained in
-     this big array are the contents of the file referred to by
-     the file descriptor [fd] (as opened previously with
-     [Unix.openfile], for example).  The optional [pos] parameter
-     is the byte offset in the file of the data being mapped;
-     it defaults to 0 (map from the beginning of the file).
-
-     If [shared] is [true], all modifications performed on the array
-     are reflected in the file.  This requires that [fd] be opened
-     with write permissions.  If [shared] is [false], modifications
-     performed on the array are done in memory only, using
-     copy-on-write of the modified pages; the underlying file is not
-     affected.
-
-     [Genarray.map_file] is much more efficient than reading
-     the whole file in a big array, modifying that big array,
-     and writing it afterwards.
-
-     To adjust automatically the dimensions of the big array to
-     the actual size of the file, the major dimension (that is,
-     the first dimension for an array with C layout, and the last
-     dimension for an array with Fortran layout) can be given as
-     [-1].  [Genarray.map_file] then determines the major dimension
-     from the size of the file.  The file must contain an integral
-     number of sub-arrays as determined by the non-major dimensions,
-     otherwise [Failure] is raised.
-
-     If all dimensions of the big array are given, the file size is
-     matched against the size of the big array.  If the file is larger
-     than the big array, only the initial portion of the file is
-     mapped to the big array.  If the file is smaller than the big
-     array, the file is automatically grown to the size of the big array.
-     This requires write permissions on [fd].
-
-     Array accesses are bounds-checked, but the bounds are determined by
-     the initial call to [map_file]. Therefore, you should make sure no
-     other process modifies the mapped file while you're accessing it,
-     or a SIGBUS signal may be raised. This happens, for instance, if the
-     file is shrunk.
-
-     This function raises [Sys_error] in the case of any errors from the
-     underlying system calls.  [Invalid_argument] or [Failure] may be
-     raised in cases where argument validation fails. *)
-
+  [@@ocaml.deprecated "\
+Use Unix.map_file instead.\n\
+Note that Bigarray.Genarray.map_file raises Sys_error while\n\
+Unix.map_file raises Unix_error."]
   end
 
 (** {6 Zero-dimensional arrays} *)
@@ -610,8 +571,10 @@ module Array1 : sig
 
   val map_file: Unix.file_descr -> ?pos:int64 -> ('a, 'b) kind -> 'c layout ->
     bool -> int -> ('a, 'b, 'c) t
-  (** Memory mapping of a file as a one-dimensional big array.
-     See {!Bigarray.Genarray.map_file} for more details. *)
+  [@@ocaml.deprecated "\
+Use [array1_of_genarray (Unix.map_file ...)] instead.\n\
+Note that Bigarray.Array1.map_file raises Sys_error while\n\
+Unix.map_file raises Unix_error."]
 
   external unsafe_get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_unsafe_ref_1"
   (** Like {!Bigarray.Array1.get}, but bounds checking is not always performed.
@@ -721,8 +684,10 @@ module Array2 :
 
   val map_file: Unix.file_descr -> ?pos:int64 -> ('a, 'b) kind -> 'c layout ->
                 bool -> int -> int -> ('a, 'b, 'c) t
-  (** Memory mapping of a file as a two-dimensional big array.
-     See {!Bigarray.Genarray.map_file} for more details. *)
+  [@@ocaml.deprecated "\
+Use [array2_of_genarray (Unix.map_file ...)] instead.\n\
+Note that Bigarray.Array2.map_file raises Sys_error while\n\
+Unix.map_file raises Unix_error."]
 
   external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a
                      = "%caml_ba_unsafe_ref_2"
@@ -855,8 +820,10 @@ module Array3 :
 
   val map_file: Unix.file_descr -> ?pos:int64 -> ('a, 'b) kind -> 'c layout ->
              bool -> int -> int -> int -> ('a, 'b, 'c) t
-  (** Memory mapping of a file as a three-dimensional big array.
-     See {!Bigarray.Genarray.map_file} for more details. *)
+  [@@ocaml.deprecated "\
+Use [array3_of_genarray (Unix.map_file ...)] instead.\n\
+Note that Bigarray.Array3.map_file raises Sys_error while\n\
+Unix.map_file raises Unix_error."]
 
   external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a
                      = "%caml_ba_unsafe_ref_3"
diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c
index f276514cef..304c359063 100644
--- a/otherlibs/bigarray/mmap_unix.c
+++ b/otherlibs/bigarray/mmap_unix.c
@@ -28,6 +28,7 @@
 #include "caml/mlvalues.h"
 #include "caml/sys.h"
 #include "caml/signals.h"
+#include "unixsupport.h"
 
 extern int caml_ba_element_size[];  /* from bigarray_stubs.c */
 
@@ -125,7 +126,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
   caml_enter_blocking_section();
   if (fstat(fd, &st) == -1) {
     caml_leave_blocking_section();
-    caml_sys_error(NO_ARG);
+    uerror("fstat", Nothing);
   }
   file_size = st.st_size;
   /* Determine array size in bytes (or size of array without the major
@@ -152,7 +153,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
     if (file_size < startpos + array_size) {
       if (caml_grow_file(fd, startpos + array_size) == -1) { /* PR#5543 */
         caml_leave_blocking_section();
-        caml_sys_error(NO_ARG);
+        uerror("caml_grow_file", Nothing);
       }
     }
   }
@@ -167,7 +168,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
   else
     addr = NULL;                /* PR#5463 - mmap fails on empty region */
   caml_leave_blocking_section();
-  if (addr == (void *) MAP_FAILED) caml_sys_error(NO_ARG);
+  if (addr == (void *) MAP_FAILED) uerror("mmap", Nothing);
   addr = (void *) ((uintnat) addr + delta);
   /* Build and return the OCaml bigarray */
   return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim);
diff --git a/otherlibs/bigarray/mmap_win32.c b/otherlibs/bigarray/mmap_win32.c
index 89ac6a4516..75930e2e5a 100644
--- a/otherlibs/bigarray/mmap_win32.c
+++ b/otherlibs/bigarray/mmap_win32.c
@@ -26,8 +26,6 @@
 
 extern int caml_ba_element_size[];  /* from bigarray_stubs.c */
 
-static void caml_ba_sys_error(void);
-
 #ifndef INVALID_SET_FILE_POINTER
 #define INVALID_SET_FILE_POINTER (-1)
 #endif
@@ -74,9 +72,9 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
   }
   /* Determine file size */
   currpos = caml_ba_set_file_pointer(fd, 0, FILE_CURRENT);
-  if (currpos == -1) caml_ba_sys_error();
+  if (currpos == -1) uerror("SetFilePointer", Nothing);
   file_size = caml_ba_set_file_pointer(fd, 0, FILE_END);
-  if (file_size == -1) caml_ba_sys_error();
+  if (file_size == -1) uerror("SetFilePointer", Nothing);
   /* Determine array size in bytes (or size of array without the major
      dimension if that dimension wasn't specified) */
   array_size = caml_ba_element_size[flags & CAML_BA_KIND_MASK];
@@ -105,7 +103,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
   }
   li.QuadPart = startpos + array_size;
   fmap = CreateFileMapping(fd, NULL, perm, li.HighPart, li.LowPart, NULL);
-  if (fmap == NULL) caml_ba_sys_error();
+  if (fmap == NULL) uerror("CreateFileMapping", Nothing);
   /* Determine offset so that the mapping starts at the given file pos */
   GetSystemInfo(&sysinfo);
   delta = (uintnat) (startpos % sysinfo.dwAllocationGranularity);
@@ -113,7 +111,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
   li.QuadPart = startpos - delta;
   addr =
     MapViewOfFile(fmap, mode, li.HighPart, li.LowPart, array_size + delta);
-  if (addr == NULL) caml_ba_sys_error();
+  if (addr == NULL) uerror("MapViewOfFile", Nothing);;
   addr = (void *) ((uintnat) addr + delta);
   /* Close the file mapping */
   CloseHandle(fmap);
@@ -136,20 +134,3 @@ void caml_ba_unmap_file(void * addr, uintnat len)
   delta = (uintnat) addr % sysinfo.dwAllocationGranularity;
   UnmapViewOfFile((void *)((uintnat)addr - delta));
 }
-
-static void caml_ba_sys_error(void)
-{
-  char buffer[512];
-  DWORD errnum;
-
-  errnum = GetLastError();
-  if (!FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
-                     NULL,
-                     errnum,
-                     0,
-                     buffer,
-                     sizeof(buffer),
-                     NULL))
-    sprintf(buffer, "Unknown error %ld\n", errnum);
-  caml_raise_sys_error(caml_copy_string(buffer));
-}