PR#4223, PR#1508: added unsafe variants of Bigarray.Array{1,2,3}.{get,set}

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@8911 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

11 files changed, 160 insertions, 61 deletions

diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml
index 75182e5a32..85d76a35b8 100644
--- a/asmcomp/closure.ml
+++ b/asmcomp/closure.ml
@@ -108,8 +108,8 @@ let prim_size prim args =
   | Parrayrefs kind -> if kind = Pgenarray then 18 else 8
   | Parraysets kind -> if kind = Pgenarray then 22 else 10
   | Pbittest -> 3
-  | Pbigarrayref(ndims, _, _) -> 4 + ndims * 6
-  | Pbigarrayset(ndims, _, _) -> 4 + ndims * 6
+  | Pbigarrayref(_, ndims, _, _) -> 4 + ndims * 6
+  | Pbigarrayset(_, ndims, _, _) -> 4 + ndims * 6
   | _ -> 2 (* arithmetic and comparisons *)
 
 (* Very raw approximation of switch cost *)
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 29c0e69109..b9276ab17c 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -507,23 +507,22 @@ let bigarray_elt_size = function
   | Pbigarray_complex32 -> 8
   | Pbigarray_complex64 -> 16
 
-let bigarray_indexing elt_kind layout b args dbg =
+let bigarray_indexing unsafe elt_kind layout b args dbg =
+  let check_bound a1 a2 k =
+    if unsafe then k else Csequence(Cop(Ccheckbound dbg, [a1;a2]), k) in
   let rec ba_indexing dim_ofs delta_ofs = function
     [] -> assert false
   | [arg] ->
       bind "idx" (untag_int arg)
         (fun idx ->
-          Csequence(
-            Cop(Ccheckbound dbg, [Cop(Cload Word,[field_address b dim_ofs]); idx]),
-            idx))
+           check_bound (Cop(Cload Word,[field_address b dim_ofs])) idx idx)
   | arg1 :: argl ->
       let rem = ba_indexing (dim_ofs + delta_ofs) delta_ofs argl in
       bind "idx" (untag_int arg1)
         (fun idx ->
           bind "bound" (Cop(Cload Word, [field_address b dim_ofs]))
           (fun bound ->
-            Csequence(Cop(Ccheckbound dbg, [bound; idx]),
-                      add_int (mul_int rem bound) idx))) in
+            check_bound bound idx (add_int (mul_int rem bound) idx))) in
   let offset =
     match layout with
       Pbigarray_unknown_layout ->
@@ -555,33 +554,33 @@ let bigarray_word_kind = function
   | Pbigarray_complex32 -> Single
   | Pbigarray_complex64 -> Double
 
-let bigarray_get elt_kind layout b args dbg =
+let bigarray_get unsafe elt_kind layout b args dbg =
   match elt_kind with
     Pbigarray_complex32 | Pbigarray_complex64 ->
       let kind = bigarray_word_kind elt_kind in
       let sz = bigarray_elt_size elt_kind / 2 in
-      bind "addr" (bigarray_indexing elt_kind layout b args dbg) (fun addr ->
+      bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr ->
         box_complex
           (Cop(Cload kind, [addr]))
           (Cop(Cload kind, [Cop(Cadda, [addr; Cconst_int sz])])))
   | _ ->
       Cop(Cload (bigarray_word_kind elt_kind),
-          [bigarray_indexing elt_kind layout b args dbg])
+          [bigarray_indexing unsafe elt_kind layout b args dbg])
 
-let bigarray_set elt_kind layout b args newval dbg =
+let bigarray_set unsafe elt_kind layout b args newval dbg =
   match elt_kind with
     Pbigarray_complex32 | Pbigarray_complex64 ->
       let kind = bigarray_word_kind elt_kind in
       let sz = bigarray_elt_size elt_kind / 2 in
       bind "newval" newval (fun newv ->
-      bind "addr" (bigarray_indexing elt_kind layout b args dbg) (fun addr ->
+      bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg) (fun addr ->
         Csequence(
           Cop(Cstore kind, [addr; complex_re newv]),
           Cop(Cstore kind,
               [Cop(Cadda, [addr; Cconst_int sz]); complex_im newv]))))
   | _ ->
       Cop(Cstore (bigarray_word_kind elt_kind),
-          [bigarray_indexing elt_kind layout b args dbg; newval])
+          [bigarray_indexing unsafe elt_kind layout b args dbg; newval])
 
 (* Simplification of some primitives into C calls *)
 
@@ -616,9 +615,9 @@ let simplif_primitive_32bits = function
   | Pbintcomp(Pint64, Lambda.Cgt) -> Pccall (default_prim "caml_greaterthan")
   | Pbintcomp(Pint64, Lambda.Cle) -> Pccall (default_prim "caml_lessequal")
   | Pbintcomp(Pint64, Lambda.Cge) -> Pccall (default_prim "caml_greaterequal")
-  | Pbigarrayref(n, Pbigarray_int64, layout) ->
+  | Pbigarrayref(unsafe, n, Pbigarray_int64, layout) ->
       Pccall (default_prim ("caml_ba_get_" ^ string_of_int n))
-  | Pbigarrayset(n, Pbigarray_int64, layout) ->
+  | Pbigarrayset(unsafe, n, Pbigarray_int64, layout) ->
       Pccall (default_prim ("caml_ba_set_" ^ string_of_int n))
   | p -> p
 
@@ -626,13 +625,13 @@ let simplif_primitive p =
   match p with
   | Pduprecord _ ->
       Pccall (default_prim "caml_obj_dup")
-  | Pbigarrayref(n, Pbigarray_unknown, layout) ->
+  | Pbigarrayref(unsafe, n, Pbigarray_unknown, layout) ->
       Pccall (default_prim ("caml_ba_get_" ^ string_of_int n))
-  | Pbigarrayset(n, Pbigarray_unknown, layout) ->
+  | Pbigarrayset(unsafe, n, Pbigarray_unknown, layout) ->
       Pccall (default_prim ("caml_ba_set_" ^ string_of_int n))
-  | Pbigarrayref(n, kind, Pbigarray_unknown_layout) ->
+  | Pbigarrayref(unsafe, n, kind, Pbigarray_unknown_layout) ->
       Pccall (default_prim ("caml_ba_get_" ^ string_of_int n))
-  | Pbigarrayset(n, kind, Pbigarray_unknown_layout) ->
+  | Pbigarrayset(unsafe, n, kind, Pbigarray_unknown_layout) ->
       Pccall (default_prim ("caml_ba_set_" ^ string_of_int n))
   | p ->
       if size_int = 8 then p else simplif_primitive_32bits p
@@ -729,11 +728,11 @@ let is_unboxed_number = function
         | Plslbint bi -> Boxed_integer bi
         | Plsrbint bi -> Boxed_integer bi
         | Pasrbint bi -> Boxed_integer bi
-        | Pbigarrayref(_, (Pbigarray_float32 | Pbigarray_float64), _) ->
+        | Pbigarrayref(_, _, (Pbigarray_float32 | Pbigarray_float64), _) ->
             Boxed_float
-        | Pbigarrayref(_, Pbigarray_int32, _) -> Boxed_integer Pint32
-        | Pbigarrayref(_, Pbigarray_int64, _) -> Boxed_integer Pint64
-        | Pbigarrayref(_, Pbigarray_native_int, _) -> Boxed_integer Pnativeint
+        | Pbigarrayref(_, _, Pbigarray_int32, _) -> Boxed_integer Pint32
+        | Pbigarrayref(_, _, Pbigarray_int64, _) -> Boxed_integer Pint64
+        | Pbigarrayref(_, _, Pbigarray_native_int, _) -> Boxed_integer Pnativeint
         | _ -> No_unboxing
       end
   | _ -> No_unboxing
@@ -890,9 +889,9 @@ let rec transl = function
               make_float_alloc Obj.double_array_tag
                               (List.map transl_unbox_float args)
           end
-      | (Pbigarrayref(num_dims, elt_kind, layout), arg1 :: argl) ->
+      | (Pbigarrayref(unsafe, num_dims, elt_kind, layout), arg1 :: argl) ->
           let elt =
-            bigarray_get elt_kind layout
+            bigarray_get unsafe elt_kind layout
               (transl arg1) (List.map transl argl) dbg in
           begin match elt_kind with
             Pbigarray_float32 | Pbigarray_float64 -> box_float elt
@@ -903,9 +902,9 @@ let rec transl = function
           | Pbigarray_caml_int -> force_tag_int elt
           | _ -> tag_int elt
           end
-      | (Pbigarrayset(num_dims, elt_kind, layout), arg1 :: argl) ->
+      | (Pbigarrayset(unsafe, num_dims, elt_kind, layout), arg1 :: argl) ->
           let (argidx, argnewval) = split_last argl in
-          return_unit(bigarray_set elt_kind layout
+          return_unit(bigarray_set unsafe elt_kind layout
             (transl arg1)
             (List.map transl argidx)
             (match elt_kind with
diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml
index 45df057e1f..8f4b0eb3a6 100644
--- a/bytecomp/bytegen.ml
+++ b/bytecomp/bytegen.ml
@@ -373,8 +373,8 @@ let comp_primitive p args =
   | Pbintcomp(bi, Cgt) -> Kccall("caml_greaterthan", 2)
   | Pbintcomp(bi, Cle) -> Kccall("caml_lessequal", 2)
   | Pbintcomp(bi, Cge) -> Kccall("caml_greaterequal", 2)
-  | Pbigarrayref(n, _, _) -> Kccall("caml_ba_get_" ^ string_of_int n, n + 1)
-  | Pbigarrayset(n, _, _) -> Kccall("caml_ba_set_" ^ string_of_int n, n + 2)
+  | Pbigarrayref(_, n, _, _) -> Kccall("caml_ba_get_" ^ string_of_int n, n + 1)
+  | Pbigarrayset(_, n, _, _) -> Kccall("caml_ba_set_" ^ string_of_int n, n + 2)
   | _ -> fatal_error "Bytegen.comp_primitive"
 
 let is_immed n = immed_min <= n && n <= immed_max
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml
index c6017d918c..77ac32e4a5 100644
--- a/bytecomp/lambda.ml
+++ b/bytecomp/lambda.ml
@@ -79,9 +79,9 @@ type primitive =
   | Plsrbint of boxed_integer
   | Pasrbint of boxed_integer
   | Pbintcomp of boxed_integer * comparison
-  (* Operations on big arrays *)
-  | Pbigarrayref of int * bigarray_kind * bigarray_layout
-  | Pbigarrayset of int * bigarray_kind * bigarray_layout
+  (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
+  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
+  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
 
 and comparison =
     Ceq | Cneq | Clt | Cgt | Cle | Cge
diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli
index cf8152a9a0..2f68966780 100644
--- a/bytecomp/lambda.mli
+++ b/bytecomp/lambda.mli
@@ -79,9 +79,9 @@ type primitive =
   | Plsrbint of boxed_integer
   | Pasrbint of boxed_integer
   | Pbintcomp of boxed_integer * comparison
-  (* Operations on big arrays *)
-  | Pbigarrayref of int * bigarray_kind * bigarray_layout
-  | Pbigarrayset of int * bigarray_kind * bigarray_layout
+  (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
+  | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
+  | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
 
 and comparison =
     Ceq | Cneq | Clt | Cgt | Cle | Cge
diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml
index a67642b2e7..80cc7d3f69 100644
--- a/bytecomp/printlambda.ml
+++ b/bytecomp/printlambda.ml
@@ -61,9 +61,9 @@ let boxed_integer_mark name = function
 let print_boxed_integer name ppf bi =
   fprintf ppf "%s" (boxed_integer_mark name bi);;
 
-let print_bigarray name kind ppf layout =
+let print_bigarray name unsafe kind ppf layout =
   fprintf ppf "Bigarray.%s[%s,%s]"
-    name
+    (if unsafe then "unsafe_"^ name else name)
     (match kind with
      | Pbigarray_unknown -> "generic"
      | Pbigarray_float32 -> "float32"
@@ -177,8 +177,10 @@ let primitive ppf = function
   | Pbintcomp(bi, Cgt) -> print_boxed_integer ">" ppf bi
   | Pbintcomp(bi, Cle) -> print_boxed_integer "<=" ppf bi
   | Pbintcomp(bi, Cge) -> print_boxed_integer ">=" ppf bi
-  | Pbigarrayref(n, kind, layout) -> print_bigarray "get" kind ppf layout
-  | Pbigarrayset(n, kind, layout) -> print_bigarray "set" kind ppf layout
+  | Pbigarrayref(unsafe, n, kind, layout) ->
+      print_bigarray "get" unsafe kind ppf layout
+  | Pbigarrayset(unsafe, n, kind, layout) ->
+      print_bigarray "set" unsafe kind ppf layout
 
 let rec lam ppf = function
   | Lvar id ->
diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index 8641eb9d15..2fa3af40f3 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -250,12 +250,30 @@ let primitives_table = create_hashtable 57 [
   "%int64_to_int32", Pcvtbint(Pint64, Pint32);
   "%int64_of_nativeint", Pcvtbint(Pnativeint, Pint64);
   "%int64_to_nativeint", Pcvtbint(Pint64, Pnativeint);
-  "%caml_ba_ref_1", Pbigarrayref(1, Pbigarray_unknown, Pbigarray_c_layout);
-  "%caml_ba_ref_2", Pbigarrayref(2, Pbigarray_unknown, Pbigarray_c_layout);
-  "%caml_ba_ref_3", Pbigarrayref(3, Pbigarray_unknown, Pbigarray_c_layout);
-  "%caml_ba_set_1", Pbigarrayset(1, Pbigarray_unknown, Pbigarray_c_layout);
-  "%caml_ba_set_2", Pbigarrayset(2, Pbigarray_unknown, Pbigarray_c_layout);
-  "%caml_ba_set_3", Pbigarrayset(3, Pbigarray_unknown, Pbigarray_c_layout)
+  "%caml_ba_ref_1",
+    Pbigarrayref(false, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_ref_2",
+    Pbigarrayref(false, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_ref_3",
+    Pbigarrayref(false, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_set_1",
+    Pbigarrayset(false, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_set_2",
+    Pbigarrayset(false, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_set_3",
+    Pbigarrayset(false, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_ref_1",
+    Pbigarrayref(true, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_ref_2",
+    Pbigarrayref(true, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_ref_3",
+    Pbigarrayref(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_set_1",
+    Pbigarrayset(true, 1, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_set_2",
+    Pbigarrayset(true, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_unsafe_set_3",
+    Pbigarrayset(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout)
 ]
 
 let prim_makearray =
@@ -306,12 +324,14 @@ let transl_prim prim args =
       | (Parraysetu Pgenarray, arg1 :: _) -> Parraysetu(array_kind arg1)
       | (Parrayrefs Pgenarray, arg1 :: _) -> Parrayrefs(array_kind arg1)
       | (Parraysets Pgenarray, arg1 :: _) -> Parraysets(array_kind arg1)
-      | (Pbigarrayref(n, Pbigarray_unknown, _), arg1 :: _) ->
+      | (Pbigarrayref(unsafe, n, Pbigarray_unknown, Pbigarray_unknown_layout),
+                      arg1 :: _) ->
             let (k, l) = bigarray_kind_and_layout arg1 in
-            Pbigarrayref(n, k, l)
-      | (Pbigarrayset(n, Pbigarray_unknown, _), arg1 :: _) ->
+            Pbigarrayref(unsafe, n, k, l)
+      | (Pbigarrayset(unsafe, n, Pbigarray_unknown, Pbigarray_unknown_layout),
+                      arg1 :: _) ->
             let (k, l) = bigarray_kind_and_layout arg1 in
-            Pbigarrayset(n, k, l)
+            Pbigarrayset(unsafe, n, k, l)
       | _ -> p
     end
   with Not_found ->
diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml
index c4da3d5c95..09ae8bd13a 100644
--- a/otherlibs/bigarray/bigarray.ml
+++ b/otherlibs/bigarray/bigarray.ml
@@ -107,6 +107,8 @@ module Array1 = struct
     Genarray.create kind layout [|dim|]
   external get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_ref_1"
   external set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_set_1"
+  external unsafe_get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_unsafe_ref_1"
+  external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_unsafe_set_1"
   let dim a = Genarray.nth_dim a 0
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
   external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
@@ -116,7 +118,7 @@ module Array1 = struct
   let of_array kind layout data =
     let ba = create kind layout (Array.length data) in
     let ofs = if layout = c_layout then 0 else 1 in
-    for i = 0 to Array.length data - 1 do set ba (i + ofs) data.(i) done;
+    for i = 0 to Array.length data - 1 do unsafe_set ba (i + ofs) data.(i) done;
     ba
   let map_file fd ?pos kind layout shared dim =
     Genarray.map_file fd ?pos kind layout shared [|dim|]
@@ -128,6 +130,8 @@ module Array2 = struct
     Genarray.create kind layout [|dim1; dim2|]
   external get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_ref_2"
   external set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_set_2"
+  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_unsafe_ref_2"
+  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_unsafe_set_2"
   let dim1 a = Genarray.nth_dim a 0
   let dim2 a = Genarray.nth_dim a 1
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
@@ -151,7 +155,7 @@ module Array2 = struct
       if Array.length row <> dim2 then
         invalid_arg("Bigarray.Array2.of_array: non-rectangular data");
       for j = 0 to dim2 - 1 do
-        set ba (i + ofs) (j + ofs) row.(j)
+        unsafe_set ba (i + ofs) (j + ofs) row.(j)
       done
     done;
     ba
@@ -166,6 +170,8 @@ module Array3 = struct
   external get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_ref_3"
   external set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
     = "%caml_ba_set_3"
+  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_unsafe_ref_3"
+  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit = "%caml_ba_unsafe_set_3"
   let dim1 a = Genarray.nth_dim a 0
   let dim2 a = Genarray.nth_dim a 1
   let dim3 a = Genarray.nth_dim a 2
@@ -197,7 +203,7 @@ module Array3 = struct
         if Array.length col <> dim3 then
           invalid_arg("Bigarray.Array3.of_array: non-cubic data");
         for k = 0 to dim3 - 1 do
-          set ba (i + ofs) (j + ofs) (k + ofs) col.(k)
+          unsafe_set ba (i + ofs) (j + ofs) (k + ofs) col.(k)
         done
       done
     done;
diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli
index 617dba0113..8c681351e6 100644
--- a/otherlibs/bigarray/bigarray.mli
+++ b/otherlibs/bigarray/bigarray.mli
@@ -489,6 +489,18 @@ module Array1 : sig
     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. *)
+
+  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.
+      Use with caution and only when the program logic guarantees that
+      the access is within bounds. *)
+
+  external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit
+                     = "%caml_ba_unsafe_set_1"
+  (** Like {!Bigarray.Array1.set}, but bounds checking is not always performed.
+      Use with caution and only when the program logic guarantees that
+      the access is within bounds. *)
+
 end
 
 
@@ -583,7 +595,17 @@ module Array2 :
   (** Memory mapping of a file as a two-dimensional big array.
      See {!Bigarray.Genarray.map_file} for more details. *)
 
-  end
+  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a
+                     = "%caml_ba_unsafe_ref_2"
+  (** Like {!Bigarray.Array2.get}, but bounds checking is not always
+      performed. *)
+
+  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit
+                     = "%caml_ba_unsafe_set_2"
+  (** Like {!Bigarray.Array2.set}, but bounds checking is not always
+      performed. *)
+
+end
 
 (** {6 Three-dimensional arrays} *)
 
@@ -700,7 +722,18 @@ module Array3 :
              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. *)
-  end
+
+  external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a
+                     = "%caml_ba_unsafe_ref_3"
+  (** Like {!Bigarray.Array3.get}, but bounds checking is not always
+      performed. *)
+
+  external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit
+                     = "%caml_ba_unsafe_set_3"
+  (** Like {!Bigarray.Array3.set}, but bounds checking is not always
+      performed. *)
+
+end
 
 (** {6 Coercions between generic big arrays and fixed-dimension big arrays} *)
 
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 83e88ee3d2..d50a88c0e1 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -153,30 +153,32 @@ let bigarray_untuplify = function
   | exp -> [exp]
 
 let bigarray_get arr arg =
+  let get = if !Clflags.fast then "unsafe_get" else "get" in
   match bigarray_untuplify arg with
     [c1] ->
-      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" "get")),
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" get)),
                        ["", arr; "", c1]))
   | [c1;c2] ->
-      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" "get")),
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" get)),
                        ["", arr; "", c1; "", c2]))
   | [c1;c2;c3] ->
-      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" "get")),
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" get)),
                        ["", arr; "", c1; "", c2; "", c3]))
   | coords ->
       mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "get")),
                        ["", arr; "", ghexp(Pexp_array coords)]))
 
 let bigarray_set arr arg newval =
+  let set = if !Clflags.fast then "unsafe_set" else "set" in 
   match bigarray_untuplify arg with
     [c1] ->
-      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" "set")),
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" set)),
                        ["", arr; "", c1; "", newval]))
   | [c1;c2] ->
-      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" "set")),
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" set)),
                        ["", arr; "", c1; "", c2; "", newval]))
   | [c1;c2;c3] ->
-      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" "set")),
+      mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" set)),
                        ["", arr; "", c1; "", c2; "", c3; "", newval]))
   | coords ->
       mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "set")),
diff --git a/test/Moretest/bigarrays.ml b/test/Moretest/bigarrays.ml
index e9f2229ad9..85901400eb 100644
--- a/test/Moretest/bigarrays.ml
+++ b/test/Moretest/bigarrays.ml
@@ -176,6 +176,15 @@ let _ =
   test 18 true (try ignore d.{4}; false with Invalid_argument _ -> true);
   test 19 true (try ignore d.{0}; false with Invalid_argument _ -> true);
 
+  testing_function "set/get (unsafe, specialized)";
+  let a = Array1.create int c_layout 3 in
+  for i = 0 to 2 do Array1.unsafe_set a i i done;
+  for i = 0 to 2 do test (i+1) (Array1.unsafe_get a i) i done;
+    
+  let b = Array1.create float64 fortran_layout 3 in
+  for i = 1 to 3 do Array1.unsafe_set b i (float i) done;
+  for i = 1 to 3 do test (5 + i) (Array1.unsafe_get b i) (float i) done;
+
   testing_function "comparisons";
   let normalize_comparison n =
     if n = 0 then 0 else if n < 0 then -1 else 1 in
@@ -463,6 +472,23 @@ let _ =
   test 9 true (try ignore b.{1,4}; false with Invalid_argument _ -> true);
   test 10 true (try ignore b.{1,0}; false with Invalid_argument _ -> true);
 
+  testing_function "set/get (unsafe, specialized)";
+  let a = Array2.create int16_signed c_layout 3 3 in
+  for i = 0 to 2 do for j = 0 to 2 do Array2.unsafe_set a i j (i-j) done done;
+  let ok = ref true in
+  for i = 0 to 2 do
+    for j = 0 to 2 do if Array2.unsafe_get a i j <> i-j then ok := false done
+  done;
+  test 1 true !ok;
+    
+  let b = Array2.create float32 fortran_layout 3 3 in
+  for i = 1 to 3 do for j = 1 to 3 do Array2.unsafe_set b i j (float(i-j)) done done;
+  let ok = ref true in
+  for i = 1 to 3 do
+    for j = 1 to 3 do if Array2.unsafe_get b i j <> float(i-j) then ok := false done
+  done;
+  test 2 true !ok;
+
   testing_function "dim";
   let a = (make_array2 int c_layout 0 4 6 id) in
   test 1 (Array2.dim1 a) 4;
@@ -596,6 +622,17 @@ let _ =
   done done done;
   test 2 true !ok;
 
+  testing_function "set/get (unsafe, specialized)";
+  let a = Array3.create int32 c_layout 2 3 4 in
+  for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
+     Array3.unsafe_set a i j k (Int32.of_int((i lsl 4) + (j lsl 2) + k))
+  done done done;
+  let ok = ref true in
+  for i = 0 to 1 do for j = 0 to 2 do for k = 0 to 3 do
+     if Int32.to_int (Array3.unsafe_get a i j k) <> (i lsl 4) + (j lsl 2) + k then ok := false
+  done done done;
+  test 1 true !ok;
+
   testing_function "dim";
   let a = (make_array3 int c_layout 0 4 5 6 id) in
   test 1 (Array3.dim1 a) 4;