From 9ebf44d84754adc5b64fcf612c6816c02c80462d Mon Sep 17 00:00:00 2001
From: Benjamin Barenblat <bbaren@debian.org>
Date: Sat, 2 Feb 2019 19:29:23 -0500
Subject: Imported Upstream version 8.9.0

---
 clib/cArray.ml | 300 +++++++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 218 insertions(+), 82 deletions(-)

(limited to 'clib/cArray.ml')

diff --git a/clib/cArray.ml b/clib/cArray.ml
index e2b1a7be..d509c55b 100644
--- a/clib/cArray.ml
+++ b/clib/cArray.ml
@@ -41,6 +41,8 @@ sig
     ('a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a
   val fold_left3 :
     ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'a
+  val fold_left4 :
+    ('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'e array -> 'a
   val fold_left2_i :
     (int -> 'a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a
   val fold_left_from : int -> ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a
@@ -48,13 +50,16 @@ sig
   val map_of_list : ('a -> 'b) -> 'a list -> 'b array
   val chop : int -> 'a array -> 'a array * 'a array
   val smartmap : ('a -> 'a) -> 'a array -> 'a array
+  [@@ocaml.deprecated "Same as [Smart.map]"]
   val smartfoldmap : ('r -> 'a -> 'r * 'a) -> 'r -> 'a array -> 'r * 'a array
+  [@@ocaml.deprecated "Same as [Smart.fold_left_map]"]
   val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
   val map2_i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
   val map3 :
     ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array
   val map_left : ('a -> 'b) -> 'a array -> 'b array
   val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit
+  val iter2_i : (int -> 'a -> 'b -> unit) -> 'a array -> 'b array -> unit
   val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
   val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
   val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array
@@ -70,6 +75,25 @@ sig
   val rev_of_list : 'a list -> 'a array
   val rev_to_list : 'a array -> 'a list
   val filter_with : bool list -> 'a array -> 'a array
+  module Smart :
+  sig
+    val map : ('a -> 'a) -> 'a array -> 'a array
+    val map2 : ('a -> 'b -> 'b) -> 'a array -> 'b array -> 'b array
+    val fold_left_map : ('a -> 'b -> 'a * 'b) -> 'a -> 'b array -> 'a * 'b array
+    val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'c) -> 'a -> 'b array -> 'c array -> 'a * 'c array
+  end
+  module Fun1 :
+  sig
+    val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array
+    val smartmap : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array
+    [@@ocaml.deprecated "Same as [Fun1.Smart.map]"]
+    val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit
+    val iter2 : ('r -> 'a -> 'b -> unit) -> 'r -> 'a array -> 'b array -> unit
+    module Smart :
+    sig
+      val map : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array
+    end
+  end
 end
 
 include Array
@@ -257,7 +281,7 @@ let fold_left2_i f a v1 v2 =
   let rec fold a n =
     if n >= lv1 then a else fold (f n a (uget v1 n) (uget v2 n)) (succ n)
   in
-  if Array.length v2 <> lv1 then invalid_arg "Array.fold_left2";
+  if Array.length v2 <> lv1 then invalid_arg "Array.fold_left2_i";
   fold a 0
 
 let fold_left3 f a v1 v2 v3 =
@@ -267,7 +291,17 @@ let fold_left3 f a v1 v2 v3 =
     else fold (f a (uget v1 n) (uget v2 n) (uget v3 n)) (succ n)
   in
   if Array.length v2 <> lv1 || Array.length v3 <> lv1 then
-    invalid_arg "Array.fold_left2";
+    invalid_arg "Array.fold_left3";
+  fold a 0
+
+let fold_left4 f a v1 v2 v3 v4 =
+  let lv1 = Array.length v1 in
+  let rec fold a n =
+    if n >= lv1 then a
+    else fold (f a (uget v1 n) (uget v2 n) (uget v3 n) (uget v4 n)) (succ n)
+  in
+  if Array.length v2 <> lv1 || Array.length v3 <> lv1 || Array.length v4 <> lv1 then
+    invalid_arg "Array.fold_left4";
   fold a 0
 
 let fold_left_from n f a v =
@@ -314,72 +348,6 @@ let chop n v =
   if n > vlen then failwith "Array.chop";
   (Array.sub v 0 n, Array.sub v n (vlen-n))
 
-(* If none of the elements is changed by f we return ar itself.
-   The while loop looks for the first such an element.
-   If found, we break here and the new array is produced,
-   but f is not re-applied to elements that are already checked *)
-let smartmap f (ar : 'a array) =
-  let len = Array.length ar in
-  let i = ref 0 in
-  let break = ref true in
-  let temp = ref None in
-  while !break && (!i < len) do
-    let v = Array.unsafe_get ar !i in
-    let v' = f v in
-    if v == v' then incr i
-    else begin
-      break := false;
-      temp := Some v';
-    end
-  done;
-  if !i < len then begin
-    (** The array is not the same as the original one *)
-    let ans : 'a array = Array.copy ar in
-    let v = match !temp with None -> assert false | Some x -> x in
-    Array.unsafe_set ans !i v;
-    incr i;
-    while !i < len do
-      let v = Array.unsafe_get ans !i in
-      let v' = f v in
-      if v != v' then Array.unsafe_set ans !i v';
-      incr i
-    done;
-    ans
-  end else ar
-
-(** Same as [smartmap] but threads a state meanwhile *)
-let smartfoldmap f accu (ar : 'a array) =
-  let len = Array.length ar in
-  let i = ref 0 in
-  let break = ref true in
-  let r = ref accu in
-  (** This variable is never accessed unset *)
-  let temp = ref None in
-  while !break && (!i < len) do
-    let v = Array.unsafe_get ar !i in
-    let (accu, v') = f !r v in
-    r := accu;
-    if v == v' then incr i
-    else begin
-      break := false;
-      temp := Some v';
-    end
-  done;
-  if !i < len then begin
-    let ans : 'a array = Array.copy ar in
-    let v = match !temp with None -> assert false | Some x -> x in
-    Array.unsafe_set ans !i v;
-    incr i;
-    while !i < len do
-      let v = Array.unsafe_get ar !i in
-      let (accu, v') = f !r v in
-      r := accu;
-      if v != v' then Array.unsafe_set ans !i v';
-      incr i
-    done;
-    !r, ans
-  end else !r, ar
-
 let map2 f v1 v2 =
   let len1 = Array.length v1 in
   let len2 = Array.length v2 in
@@ -440,6 +408,12 @@ let iter2 f v1 v2 =
   let () = if not (Int.equal len2 len1) then invalid_arg "Array.iter2" in
   for i = 0 to len1 - 1 do f (uget v1 i) (uget v2 i) done
 
+let iter2_i f v1 v2 =
+  let len1 = Array.length v1 in
+  let len2 = Array.length v2 in
+  let () = if not (Int.equal len2 len1) then invalid_arg "Array.iter2" in
+  for i = 0 to len1 - 1 do f i (uget v1 i) (uget v2 i) done
+
 let pure_functional = false
 
 let fold_right_map f v e =
@@ -496,29 +470,53 @@ let rev_to_list a =
 let filter_with filter v =
   Array.of_list (CList.filter_with filter (Array.to_list v))
 
-module Fun1 =
+module Smart =
 struct
 
-  let map f arg v = match v with
-  | [| |] -> [| |]
-  | _ ->
-    let len = Array.length v in
-    let x0 = Array.unsafe_get v 0 in
-    let ans = Array.make len (f arg x0) in
-    for i = 1 to pred len do
-      let x = Array.unsafe_get v i in
-      Array.unsafe_set ans i (f arg x)
+  (* If none of the elements is changed by f we return ar itself.
+     The while loop looks for the first such an element.
+     If found, we break here and the new array is produced,
+     but f is not re-applied to elements that are already checked *)
+  let map f (ar : 'a array) =
+    let len = Array.length ar in
+    let i = ref 0 in
+    let break = ref true in
+    let temp = ref None in
+    while !break && (!i < len) do
+      let v = Array.unsafe_get ar !i in
+      let v' = f v in
+      if v == v' then incr i
+      else begin
+        break := false;
+        temp := Some v';
+      end
     done;
-    ans
+    if !i < len then begin
+      (** The array is not the same as the original one *)
+      let ans : 'a array = Array.copy ar in
+      let v = match !temp with None -> assert false | Some x -> x in
+      Array.unsafe_set ans !i v;
+      incr i;
+      while !i < len do
+        let v = Array.unsafe_get ans !i in
+        let v' = f v in
+        if v != v' then Array.unsafe_set ans !i v';
+        incr i
+      done;
+      ans
+    end else ar
 
-  let smartmap f arg (ar : 'a array) =
+  let map2 f aux_ar ar =
     let len = Array.length ar in
+    let aux_len = Array.length aux_ar in
+    let () = if not (Int.equal len aux_len) then invalid_arg "Array.Smart.map2" in
     let i = ref 0 in
     let break = ref true in
     let temp = ref None in
     while !break && (!i < len) do
       let v = Array.unsafe_get ar !i in
-      let v' = f arg v in
+      let w = Array.unsafe_get aux_ar !i in
+      let v' = f w v in
       if v == v' then incr i
       else begin
         break := false;
@@ -533,13 +531,105 @@ struct
       incr i;
       while !i < len do
         let v = Array.unsafe_get ans !i in
-        let v' = f arg v in
+        let w = Array.unsafe_get aux_ar !i in
+        let v' = f w v in
         if v != v' then Array.unsafe_set ans !i v';
         incr i
       done;
       ans
     end else ar
 
+  (** Same as [Smart.map] but threads a state meanwhile *)
+  let fold_left_map f accu (ar : 'a array) =
+    let len = Array.length ar in
+    let i = ref 0 in
+    let break = ref true in
+    let r = ref accu in
+    (** This variable is never accessed unset *)
+    let temp = ref None in
+    while !break && (!i < len) do
+      let v = Array.unsafe_get ar !i in
+      let (accu, v') = f !r v in
+      r := accu;
+      if v == v' then incr i
+      else begin
+        break := false;
+        temp := Some v';
+      end
+    done;
+    if !i < len then begin
+      let ans : 'a array = Array.copy ar in
+      let v = match !temp with None -> assert false | Some x -> x in
+      Array.unsafe_set ans !i v;
+      incr i;
+      while !i < len do
+        let v = Array.unsafe_get ar !i in
+        let (accu, v') = f !r v in
+        r := accu;
+        if v != v' then Array.unsafe_set ans !i v';
+        incr i
+      done;
+      !r, ans
+    end else !r, ar
+
+  (** Same as [Smart.map2] but threads a state meanwhile *)
+  let fold_left2_map f accu aux_ar ar =
+    let len = Array.length ar in
+    let aux_len = Array.length aux_ar in
+    let () = if not (Int.equal len aux_len) then invalid_arg "Array.Smart.fold_left2_map" in
+    let i = ref 0 in
+    let break = ref true in
+    let r = ref accu in
+    (** This variable is never accessed unset *)
+    let temp = ref None in
+    while !break && (!i < len) do
+      let v = Array.unsafe_get ar !i in
+      let w = Array.unsafe_get aux_ar !i in
+      let (accu, v') = f !r w v in
+      r := accu;
+      if v == v' then incr i
+      else begin
+        break := false;
+        temp := Some v';
+      end
+    done;
+    if !i < len then begin
+      let ans : 'a array = Array.copy ar in
+      let v = match !temp with None -> assert false | Some x -> x in
+      Array.unsafe_set ans !i v;
+      incr i;
+      while !i < len do
+        let v = Array.unsafe_get ar !i in
+        let w = Array.unsafe_get aux_ar !i in
+        let (accu, v') = f !r w v in
+        r := accu;
+        if v != v' then Array.unsafe_set ans !i v';
+        incr i
+      done;
+      !r, ans
+    end else !r, ar
+
+end
+
+(* Deprecated aliases *)
+let smartmap = Smart.map
+let smartfoldmap = Smart.fold_left_map
+
+module Fun1 =
+struct
+
+  let map f arg v = match v with
+  | [| |] -> [| |]
+  | _ ->
+    let len = Array.length v in
+    let x0 = Array.unsafe_get v 0 in
+    let ans = Array.make len (f arg x0) in
+    for i = 1 to pred len do
+      let x = Array.unsafe_get v i in
+      Array.unsafe_set ans i (f arg x)
+    done;
+    ans
+
   let iter f arg v =
     let len = Array.length v in
     for i = 0 to pred len do
@@ -547,4 +637,50 @@ struct
       f arg x
     done
 
+  let iter2 f arg v1 v2 =
+    let len1 = Array.length v1 in
+    let len2 = Array.length v2 in
+    let () = if not (Int.equal len2 len1) then invalid_arg "Array.Fun1.iter2" in
+    for i = 0 to pred len1 do
+      let x1 = uget v1 i in
+      let x2 = uget v2 i in
+      f arg x1 x2
+    done
+
+  module Smart =
+  struct
+
+    let map f arg (ar : 'a array) =
+      let len = Array.length ar in
+      let i = ref 0 in
+      let break = ref true in
+      let temp = ref None in
+      while !break && (!i < len) do
+        let v = Array.unsafe_get ar !i in
+        let v' = f arg v in
+        if v == v' then incr i
+        else begin
+          break := false;
+          temp := Some v';
+        end
+      done;
+      if !i < len then begin
+        (** The array is not the same as the original one *)
+        let ans : 'a array = Array.copy ar in
+        let v = match !temp with None -> assert false | Some x -> x in
+        Array.unsafe_set ans !i v;
+        incr i;
+        while !i < len do
+          let v = Array.unsafe_get ans !i in
+          let v' = f arg v in
+          if v != v' then Array.unsafe_set ans !i v';
+          incr i
+        done;
+        ans
+      end else ar
+
+  end
+
+  let smartmap = Smart.map
+
 end
-- 
cgit v1.2.3