Added fold_{left, right}, exists and for_all to String/Bytes

Changes

@@ -11,6 +11,9 @@ Working version
 
 ### Standard library:
 
+- GPR#882: Add fold_left, fold_right, exists and for_all to String/Bytes
+  (Yotam Barnoy, review by Alain Frisch and Jeremy Yallop)
+
 - #9059: Added List.filteri function, same as List.filter but
   with the index of the element.
   (Léo Andrès, review by Alain Frisch)

stdlib/bytes.ml

@@ -223,6 +223,36 @@ let mapi f s =
     r
   end
 
+let fold_left f x a =
+  let r = ref x in
+  for i = 0 to length a - 1 do
+    r := f !r (unsafe_get a i)
+  done;
+  !r
+
+let fold_right f a x =
+  let r = ref x in
+  for i = length a - 1 downto 0 do
+    r := f (unsafe_get a i) !r
+  done;
+  !r
+
+let exists p s =
+  let n = length s in
+  let rec loop i =
+    if i = n then false
+    else if p (unsafe_get s i) then true
+    else loop (succ i) in
+  loop 0
+
+let for_all p s =
+  let n = length s in
+  let rec loop i =
+    if i = n then true
+    else if p (unsafe_get s i) then loop (succ i)
+    else false in
+  loop 0
+
 let uppercase_ascii s = map Char.uppercase_ascii s
 let lowercase_ascii s = map Char.lowercase_ascii s
 

stdlib/bytes.mli

@@ -173,6 +173,28 @@ val mapi : (int -> char -> char) -> bytes -> bytes
     index (in increasing index order) and stores the resulting bytes
     in a new sequence that is returned as the result. *)
 
+val fold_left : ('a -> char -> 'a) -> 'a -> bytes -> 'a
+(** [Bytes.fold_left f x s] computes
+    [Bytes.(f (... (f (f x (get s 0)) (get s 1)) ...) (get s (n-1)))],
+    where [n] is the length of [s].
+    @since 4.11.0 *)
+
+val fold_right : (char -> 'a -> 'a) -> bytes -> 'a -> 'a
+(** [Bytes.fold_right f s x] computes
+    [Bytes.(f (get s 0) (f (get s 1) ( ... (f (get s (n-1)) x) ...)))],
+    where [n] is the length of [s].
+    @since 4.11.0 *)
+
+val for_all: (char -> bool) -> bytes -> bool
+(** [Bytes.for_all p s] checks if all characters in [s] satisfy the
+    predicate [p].
+    @since 4.11.0 *)
+
+val exists: (char -> bool) -> bytes -> bool
+(** [Bytes.exists p s] checks if at least one character of
+    [s] satisfies the predicate [p].
+    @since 4.11.0 *)
+
 val trim : bytes -> bytes
 (** Return a copy of the argument, without leading and trailing
     whitespace. The bytes regarded as whitespace are the ASCII

stdlib/bytesLabels.mli

@@ -161,6 +161,28 @@ val mapi : f:(int -> char -> char) -> bytes -> bytes
     index (in increasing index order) and stores the resulting bytes
     in a new sequence that is returned as the result. *)
 
+val fold_left : f:('a -> char -> 'a) -> init:'a -> bytes -> 'a
+(** [BytesLabels.fold_left f x s] computes
+    [Bytes.(f (... (f (f x (get s 0)) (get s 1)) ...) (get s (n-1)))],
+    where [n] is the length of [s].
+    @since 4.11.0 *)
+
+val fold_right : f:(char -> 'a -> 'a) -> bytes -> init:'a -> 'a
+(** [BytesLabels.fold_right f s x] computes
+    [Bytes.(f (get s 0) (f (get s 1) ( ... (f (get s (n-1)) x) ...)))],
+    where [n] is the length of [s].
+    @since 4.11.0 *)
+
+val for_all: f:(char -> bool) -> bytes -> bool
+(** [BytesLabels.for_all p s] checks if all characters in [s] satisfy the
+    predicate [p].
+    @since 4.11.0 *)
+
+val exists: f:(char -> bool) -> bytes -> bool
+(** [BytesLabels.exists p s] checks if at least one character of
+    [s] satisfies the predicate [p].
+    @since 4.11.0 *)
+
 val trim : bytes -> bytes
 (** Return a copy of the argument, without leading and trailing
     whitespace. The bytes regarded as whitespace are the ASCII

stdlib/string.ml

@@ -85,6 +85,14 @@ let map f s =
   B.map f (bos s) |> bts
 let mapi f s =
   B.mapi f (bos s) |> bts
+let fold_right f x a =
+  B.fold_right f (bos x) a
+let fold_left f a x =
+  B.fold_left f a (bos x)
+let exists f s =
+  B.exists f (bos s)
+let for_all f s =
+  B.for_all f (bos s)
 
 (* Beware: we cannot use B.trim or B.escape because they always make a
    copy, but String.mli spells out some cases where we are not allowed

stdlib/string.mli

@@ -148,6 +148,28 @@ val mapi : (int -> char -> char) -> string -> string
     string that is returned.
     @since 4.02.0 *)
 
+val fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a
+(** [String.fold_left f x s] computes
+   [f (... (f (f x s.[0]) s.[1]) ...) s.[n-1]],
+   where [n] is the length of the string [s].
+   @since 4.11.0 *)
+
+val fold_right : (char -> 'a -> 'a) -> string -> 'a -> 'a
+(** [String.fold_right f s x] computes
+   [f s.[0] (f s.[1] ( ... (f s.[n-1] x) ...))],
+   where [n] is the length of the string [s].
+   @since 4.11.0 *)
+
+val for_all: (char -> bool) -> string -> bool
+(** [String.for_all p s] checks if all characters in [s] satisfy the
+    predicate [p].
+    @since 4.11.0 *)
+
+val exists: (char -> bool) -> string -> bool
+(** [String.exists p s] checks if at least one character of [s]
+    satisfies the predicate [p].
+    @since 4.11.0 *)
+
 val trim : string -> string
 (** Return a copy of the argument, without leading and trailing
    whitespace.  The characters regarded as whitespace are: [' '],

stdlib/stringLabels.mli

@@ -124,6 +124,28 @@ val mapi : f:(int -> char -> char) -> string -> string
     string that is returned.
     @since 4.02.0 *)
 
+val fold_left : f:('a -> char -> 'a) -> init:'a -> string -> 'a
+(** [StringLabels.fold_left f x s] computes
+   [f (... (f (f x s.[0]) s.[1]) ...) s.[n-1]],
+   where [n] is the length of the string [s].
+   @since 4.11.0 *)
+
+val fold_right : f:(char -> 'a -> 'a) -> string -> init:'a -> 'a
+(** [StringLabels.fold_right f s x] computes
+   [f s.[0] (f s.[1] ( ... (f s.[n-1] x) ...))],
+   where [n] is the length of the string [s].
+   @since 4.11.0 *)
+
+val for_all: f:(char -> bool) -> string -> bool
+(** [StringLabels.for_all p s] checks if all characters in [s] satisfy the
+    predicate [p].
+    @since 4.11.0 *)
+
+val exists: f:(char -> bool) -> string -> bool
+(** [StringLabels.exists p s] checks if at least one character of [s]
+    satisfies the predicate [p].
+    @since 4.11.0 *)
+
 val trim : string -> string
 (** Return a copy of the argument, without leading and trailing
    whitespace.  The characters regarded as whitespace are: [' '],

testsuite/tests/lib-bytes/test_bytes.ml

@@ -108,6 +108,37 @@ let () =
        length r = 7
        && check r 1 "abcde");
 
+    (*
+       abcde
+       edcba
+    *)
+    Testing.test
+      (let r = copy abcde in
+       let l = fold_left (fun acc x -> (make 1 x)::acc) [] r in
+       let result = concat (Bytes.of_string "") l in
+       length result = 5
+       && check result 0 "edcba");
+
+    (*
+       abcde
+       abcde
+    *)
+    Testing.test
+      (let r = copy abcde in
+       let l = fold_right (fun x acc -> (make 1 x)::acc) r [] in
+       let result = concat (Bytes.of_string "") l in
+       length result = 5
+       && check result 0 "abcde");
+
+    (*
+       test exists and for_all
+    *)
+    Testing.test
+      (exists (fun c -> c = 'b') abcde
+      && not (exists (fun c -> c = 'f') abcde)
+      && for_all (fun c -> c <> 'f') abcde
+      && not (for_all (fun c -> c = 'b') abcde));
+
     (* length + left + right < 0 *)
     test_raises_invalid_argument
       (fun () -> extend abcde (-3) (-3)) ();

testsuite/tests/lib-bytes/test_bytes.reference

@@ -1,2 +1,2 @@
- 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
 All tests succeeded.