summaryrefslogtreecommitdiffstats
path: root/stdlib/bytes.ml
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/bytes.ml')
-rw-r--r--stdlib/bytes.ml253
1 files changed, 253 insertions, 0 deletions
diff --git a/stdlib/bytes.ml b/stdlib/bytes.ml
new file mode 100644
index 000000000..ece7c1ea5
--- /dev/null
+++ b/stdlib/bytes.ml
@@ -0,0 +1,253 @@
+(***********************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the GNU Library General Public License, with *)
+(* the special exception on linking described in file ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(* Byte sequence operations *)
+
+external length : bytes -> int = "%string_length"
+external string_length : string -> int = "%string_length"
+external get : bytes -> int -> char = "%string_safe_get"
+external set : bytes -> int -> char -> unit = "%string_safe_set"
+external create : int -> bytes = "caml_create_string"
+external unsafe_get : bytes -> int -> char = "%string_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%string_unsafe_set"
+external unsafe_fill : bytes -> int -> int -> char -> unit
+ = "caml_fill_string" "noalloc"
+external unsafe_to_string : bytes -> string = "%identity"
+external unsafe_of_string : string -> bytes = "%identity"
+
+external unsafe_blit : bytes -> int -> bytes -> int -> int -> unit
+ = "caml_blit_string" "noalloc"
+external unsafe_blit_string : string -> int -> bytes -> int -> int -> unit
+ = "caml_blit_string" "noalloc"
+
+let make n c =
+ let s = create n in
+ unsafe_fill s 0 n c;
+ s
+
+let init n f =
+ let s = create n in
+ for i = 0 to n - 1 do
+ unsafe_set s i (f i)
+ done;
+ s
+
+let empty = create 0;;
+
+let copy s =
+ let len = length s in
+ let r = create len in
+ unsafe_blit s 0 r 0 len;
+ r
+
+let to_string b = unsafe_to_string (copy b)
+let of_string s = copy (unsafe_of_string s)
+
+let sub s ofs len =
+ if ofs < 0 || len < 0 || ofs > length s - len
+ then invalid_arg "Bytes.sub"
+ else begin
+ let r = create len in
+ unsafe_blit s ofs r 0 len;
+ r
+ end
+
+let sub_string b ofs len = unsafe_to_string (sub b ofs len)
+
+let extend s left right =
+ let len = length s + left + right in
+ let r = create len in
+ let (srcoff, dstoff) = if left < 0 then -left, 0 else 0, left in
+ let cpylen = min (length s - srcoff) (len - dstoff) in
+ if cpylen > 0 then unsafe_blit s srcoff r dstoff cpylen;
+ r
+
+let fill s ofs len c =
+ if ofs < 0 || len < 0 || ofs > length s - len
+ then invalid_arg "Bytes.fill"
+ else unsafe_fill s ofs len c
+
+let blit s1 ofs1 s2 ofs2 len =
+ if len < 0 || ofs1 < 0 || ofs1 > length s1 - len
+ || ofs2 < 0 || ofs2 > length s2 - len
+ then invalid_arg "Bytes.blit"
+ else unsafe_blit s1 ofs1 s2 ofs2 len
+
+let blit_string s1 ofs1 s2 ofs2 len =
+ if len < 0 || ofs1 < 0 || ofs1 > string_length s1 - len
+ || ofs2 < 0 || ofs2 > length s2 - len
+ then invalid_arg "Bytes.blit_string"
+ else unsafe_blit_string s1 ofs1 s2 ofs2 len
+
+let iter f a =
+ for i = 0 to length a - 1 do f(unsafe_get a i) done
+
+let iteri f a =
+ for i = 0 to length a - 1 do f i (unsafe_get a i) done
+
+let concat sep l =
+ match l with
+ [] -> empty
+ | hd :: tl ->
+ let num = ref 0 and len = ref 0 in
+ List.iter (fun s -> incr num; len := !len + length s) l;
+ let r = create (!len + length sep * (!num - 1)) in
+ unsafe_blit hd 0 r 0 (length hd);
+ let pos = ref(length hd) in
+ List.iter
+ (fun s ->
+ unsafe_blit sep 0 r !pos (length sep);
+ pos := !pos + length sep;
+ unsafe_blit s 0 r !pos (length s);
+ pos := !pos + length s)
+ tl;
+ r
+
+let cat s1 s2 =
+ let l1 = length s1 in
+ let l2 = length s2 in
+ let r = create (l1 + l2) in
+ unsafe_blit s1 0 r 0 l1;
+ unsafe_blit s2 0 r l1 l2;
+ r
+;;
+
+external is_printable: char -> bool = "caml_is_printable"
+external char_code: char -> int = "%identity"
+external char_chr: int -> char = "%identity"
+
+let is_space = function
+ | ' ' | '\012' | '\n' | '\r' | '\t' -> true
+ | _ -> false
+
+let trim s =
+ let len = length s in
+ let i = ref 0 in
+ while !i < len && is_space (unsafe_get s !i) do
+ incr i
+ done;
+ let j = ref (len - 1) in
+ while !j >= !i && is_space (unsafe_get s !j) do
+ decr j
+ done;
+ if !j >= !i then
+ sub s !i (!j - !i + 1)
+ else
+ empty
+
+let escaped s =
+ let n = ref 0 in
+ for i = 0 to length s - 1 do
+ n := !n +
+ (match unsafe_get s i with
+ | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
+ | c -> if is_printable c then 1 else 4)
+ done;
+ if !n = length s then copy s else begin
+ let s' = create !n in
+ n := 0;
+ for i = 0 to length s - 1 do
+ begin match unsafe_get s i with
+ | ('"' | '\\') as c ->
+ unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c
+ | '\n' ->
+ unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n'
+ | '\t' ->
+ unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't'
+ | '\r' ->
+ unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r'
+ | '\b' ->
+ unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b'
+ | c ->
+ if is_printable c then
+ unsafe_set s' !n c
+ else begin
+ let a = char_code c in
+ unsafe_set s' !n '\\';
+ incr n;
+ unsafe_set s' !n (char_chr (48 + a / 100));
+ incr n;
+ unsafe_set s' !n (char_chr (48 + (a / 10) mod 10));
+ incr n;
+ unsafe_set s' !n (char_chr (48 + a mod 10))
+ end
+ end;
+ incr n
+ done;
+ s'
+ end
+
+let map f s =
+ let l = length s in
+ if l = 0 then s else begin
+ let r = create l in
+ for i = 0 to l - 1 do unsafe_set r i (f (unsafe_get s i)) done;
+ r
+ end
+
+let mapi f s =
+ let l = length s in
+ if l = 0 then s else begin
+ let r = create l in
+ for i = 0 to l - 1 do unsafe_set r i (f i (unsafe_get s i)) done;
+ r
+ end
+
+let uppercase s = map Char.uppercase s
+let lowercase s = map Char.lowercase s
+
+let apply1 f s =
+ if length s = 0 then s else begin
+ let r = copy s in
+ unsafe_set r 0 (f(unsafe_get s 0));
+ r
+ end
+
+let capitalize s = apply1 Char.uppercase s
+let uncapitalize s = apply1 Char.lowercase s
+
+let rec index_rec s lim i c =
+ if i >= lim then raise Not_found else
+ if unsafe_get s i = c then i else index_rec s lim (i + 1) c;;
+
+let index s c = index_rec s (length s) 0 c;;
+
+let index_from s i c =
+ let l = length s in
+ if i < 0 || i > l then invalid_arg "Bytes.index_from" else
+ index_rec s l i c;;
+
+let rec rindex_rec s i c =
+ if i < 0 then raise Not_found else
+ if unsafe_get s i = c then i else rindex_rec s (i - 1) c;;
+
+let rindex s c = rindex_rec s (length s - 1) c;;
+
+let rindex_from s i c =
+ if i < -1 || i >= length s then invalid_arg "Bytes.rindex_from" else
+ rindex_rec s i c;;
+
+let contains_from s i c =
+ let l = length s in
+ if i < 0 || i > l then invalid_arg "Bytes.contains_from" else
+ try ignore (index_rec s l i c); true with Not_found -> false;;
+
+let contains s c = contains_from s 0 c;;
+
+let rcontains_from s i c =
+ if i < 0 || i >= length s then invalid_arg "Bytes.rcontains_from" else
+ try ignore (rindex_rec s i c); true with Not_found -> false;;
+
+type t = bytes
+
+let compare (x: t) (y: t) = Pervasives.compare x y
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-21 07:35:46 +0000