@tellahq/rescript 10.1.4-republish-2 → 10.1.4-republish-3

package/lib/ocaml/buffer.mli

@@ -0,0 +1,149 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*   Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt     *)
+(*                                                                        *)
+(*   Copyright 1999 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Extensible buffers.
+
+   This module implements buffers that automatically expand
+   as necessary.  It provides accumulative concatenation of strings
+   in quasi-linear time (instead of quadratic time when strings are
+   concatenated pairwise).
+*)
+
+type t
+(** The abstract type of buffers. *)
+
+val create : int -> t
+(** [create n] returns a fresh buffer, initially empty.
+   The [n] parameter is the initial size of the internal byte sequence
+   that holds the buffer contents. That byte sequence is automatically
+   reallocated when more than [n] characters are stored in the buffer,
+   but shrinks back to [n] characters when [reset] is called.
+   For best performance, [n] should be of the same order of magnitude
+   as the number of characters that are expected to be stored in
+   the buffer (for instance, 80 for a buffer that holds one output
+   line).  Nothing bad will happen if the buffer grows beyond that
+   limit, however. In doubt, take [n = 16] for instance.
+   If [n] is not between 1 and {!Sys.max_string_length}, it will
+   be clipped to that interval. *)
+
+val contents : t -> string
+(** Return a copy of the current contents of the buffer.
+    The buffer itself is unchanged. *)
+
+val to_bytes : t -> bytes
+(** Return a copy of the current contents of the buffer.
+    The buffer itself is unchanged.
+    @since 4.02 *)
+
+val sub : t -> int -> int -> string
+(** [Buffer.sub b off len] returns a copy of [len] bytes from the
+    current contents of the buffer [b], starting at offset [off].
+
+    Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid
+    range of [b]. *)
+
+val blit : t -> int -> bytes -> int -> int -> unit
+(** [Buffer.blit src srcoff dst dstoff len] copies [len] characters from
+   the current contents of the buffer [src], starting at offset [srcoff]
+   to [dst], starting at character [dstoff].
+
+   Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid
+   range of [src], or if [dstoff] and [len] do not designate a valid
+   range of [dst].
+   @since 3.11.2
+*)
+
+val nth : t -> int -> char
+(** Get the n-th character of the buffer. Raise [Invalid_argument] if
+    index out of bounds *)
+
+val length : t -> int
+(** Return the number of characters currently contained in the buffer. *)
+
+val clear : t -> unit
+(** Empty the buffer. *)
+
+val reset : t -> unit
+(** Empty the buffer and deallocate the internal byte sequence holding the
+   buffer contents, replacing it with the initial internal byte sequence
+   of length [n] that was allocated by {!Buffer.create} [n].
+   For long-lived buffers that may have grown a lot, [reset] allows
+   faster reclamation of the space used by the buffer. *)
+
+val add_char : t -> char -> unit
+(** [add_char b c] appends the character [c] at the end of buffer [b]. *)
+
+val add_utf_8_uchar : t -> Uchar.t -> unit
+(** [add_utf_8_uchar b u] appends the {{:https://tools.ietf.org/html/rfc3629}
+    UTF-8} encoding of [u] at the end of buffer [b].
+
+    @since 4.06.0 *)
+
+val add_utf_16le_uchar : t -> Uchar.t -> unit
+(** [add_utf_16le_uchar b u] appends the
+    {{:https://tools.ietf.org/html/rfc2781}UTF-16LE} encoding of [u]
+    at the end of buffer [b].
+
+    @since 4.06.0 *)
+
+val add_utf_16be_uchar : t -> Uchar.t -> unit
+(** [add_utf_16be_uchar b u] appends the
+    {{:https://tools.ietf.org/html/rfc2781}UTF-16BE} encoding of [u]
+    at the end of buffer [b].
+
+    @since 4.06.0 *)
+
+val add_string : t -> string -> unit
+(** [add_string b s] appends the string [s] at the end of buffer [b]. *)
+
+val add_bytes : t -> bytes -> unit
+(** [add_bytes b s] appends the byte sequence [s] at the end of buffer [b].
+    @since 4.02 *)
+
+val add_substring : t -> string -> int -> int -> unit
+(** [add_substring b s ofs len] takes [len] characters from offset
+   [ofs] in string [s] and appends them at the end of buffer [b]. *)
+
+val add_subbytes : t -> bytes -> int -> int -> unit
+(** [add_subbytes b s ofs len] takes [len] characters from offset
+    [ofs] in byte sequence [s] and appends them at the end of buffer [b].
+    @since 4.02 *)
+
+val add_substitute : t -> (string -> string) -> string -> unit
+(** [add_substitute b f s] appends the string pattern [s] at the end
+   of buffer [b] with substitution.
+   The substitution process looks for variables into
+   the pattern and substitutes each variable name by its value, as
+   obtained by applying the mapping [f] to the variable name. Inside the
+   string pattern, a variable name immediately follows a non-escaped
+   [$] character and is one of the following:
+   - a non empty sequence of alphanumeric or [_] characters,
+   - an arbitrary sequence of characters enclosed by a pair of
+   matching parentheses or curly brackets.
+   An escaped [$] character is a [$] that immediately follows a backslash
+   character; it then stands for a plain [$].
+   Raise [Not_found] if the closing character of a parenthesized variable
+   cannot be found. *)
+
+val add_buffer : t -> t -> unit
+(** [add_buffer b1 b2] appends the current contents of buffer [b2]
+   at the end of buffer [b1].  [b2] is not modified. *)
+
+
+val truncate : t -> int -> unit
+(** [truncate b len] truncates the length of [b] to [len]
+  Note: the internal byte sequence is not shortened.
+  Raise [Invalid_argument] if [len < 0] or [len > length b].
+  @since 4.05.0 *)

package/lib/ocaml/bytes.ml

@@ -0,0 +1,431 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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 Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Byte sequence operations *)
+
+(* WARNING: Some functions in this file are duplicated in string.ml for
+   efficiency reasons. When you modify the one in this file you need to
+   modify its duplicate in string.ml.
+   These functions have a "duplicated" comment above their definition.
+*)
+
+
+  
+external of_small_int_array :  
+  (_ [@bs.as {json|null|json}] ) -> 
+  int array -> string = 
+  "String.fromCharCode.apply" 
+  [@@bs.val]
+
+external (.!()) : string -> int -> char = "%string_unsafe_get"
+external length : bytes -> int = "%bytes_length"
+external%private string_length : string -> int = "%string_length"
+external get : bytes -> int -> char = "%bytes_safe_get"
+external set : bytes -> int -> char -> unit = "%bytes_safe_set"
+external create : int -> bytes = "?create_bytes"
+
+external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get"
+external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set"
+external (.![]) : bytes -> int -> char = "%bytes_unsafe_get"
+external (.![]<-) : bytes -> int -> char -> unit = "%bytes_unsafe_set"
+external new_uninitialized : int -> bytes = "Array"  [@@bs.new]
+external to_int_array : bytes -> int array = "%identity"
+
+let unsafe_fill : bytes -> int -> int -> char -> unit
+  = fun (s : bytes) i l (c : char) ->
+    if l > 0 then
+      for k = i to l + i - 1 do 
+        s.![k] <- c 
+      done
+
+
+
+
+(** Same as {!Array.prototype.copyWithin} *)
+let copyWithin (s1 : bytes) i1 i2 len = 
+  if i1 < i2  then (* nop for i1 = i2 *)
+    let range_a =  length s1 - i2 - 1 in
+    let range_b = len - 1 in         
+    let range = if range_a > range_b then range_b else range_a in
+    for j = range downto 0 do
+      s1.![i2 + j] <- s1.![i1 + j]
+    done
+  else if i1 > i2 then
+    let range_a = length s1 - i1 - 1 in 
+    let range_b = len - 1 in 
+    let range = if range_a > range_b then range_b else range_a in 
+    for k = 0 to range  do 
+      s1.![i2 + k] <- s1.![i1 + k]
+    done
+
+(* TODO: when the compiler could optimize small function calls, 
+   use high order functions instead
+*)
+let unsafe_blit (s1:bytes) i1 (s2:bytes) i2 len = 
+  if len > 0 then
+    if s1 == s2 then
+      copyWithin s1 i1 i2 len 
+    else
+      let off1 = length s1 - i1 in
+      if len <= off1 then 
+        for i = 0 to len - 1 do 
+          s2.![i2 + i] <-  s1.![i1 + i]
+        done
+      else 
+        begin
+          for i = 0 to off1 - 1 do 
+            s2.![i2 + i] <- s1.![i1 + i]
+          done;
+          for i = off1 to len - 1 do 
+            s2.![i2 + i] <- '\000'
+          done
+        end      
+
+let unsafe_blit_string (s1 : string) i1 (s2 : bytes) i2 (len : int ) = 
+  if len > 0 then
+    let off1 = string_length s1 - i1 in
+    if len <= off1 then 
+      for i = 0 to len - 1 do 
+        s2.![i2 + i] <-  s1.!(i1 + i)
+      done
+    else 
+      begin
+        for i = 0 to off1 - 1 do 
+          s2.![i2 + i] <- s1.!(i1 + i)
+        done;
+        for i = off1 to len - 1 do 
+          s2.![i2 + i] <- '\000'
+        done
+      end
+let string_of_large_bytes (bytes : bytes) i len = 
+  let s = ref "" in
+  let s_len = ref len in
+  let seg = 1024 in
+  if i = 0 && len <= 4 * seg && len = length bytes then 
+    of_small_int_array  (to_int_array bytes)
+  else 
+    begin
+      let offset = ref 0 in
+      while s_len.contents > 0 do 
+        let next = if s_len.contents < 1024 then s_len.contents else seg in
+        let tmp_bytes = new_uninitialized next in
+        for k = 0 to next - 1 do 
+          tmp_bytes.![k] <- bytes.![k + offset.contents]  
+        done;   
+        s.contents <- s.contents ^ of_small_int_array (to_int_array tmp_bytes);
+        s_len.contents <- s_len.contents - next ; 
+        offset.contents <- offset.contents + next;
+      done;
+      s.contents
+    end
+
+
+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 (a : bytes) : string  = 
+  string_of_large_bytes a 0 (length a)   
+
+let unsafe_to_string = to_string
+
+(** checkout [Bytes.empty] -- to be inlined? *)
+let of_string  (s : string) = 
+  let len = string_length s in
+  let res = new_uninitialized len  in
+  for i = 0 to len - 1 do 
+    res.![i] <- s.!(i)
+    (* Note that when get a char and convert it to int immedately, should be optimized
+       should be [s.charCodeAt[i]]
+    *)
+  done;
+  res
+
+let unsafe_of_string = of_string
+
+let sub s ofs len =
+  if ofs < 0 || len < 0 || ofs > length s - len
+  then invalid_arg "String.sub / 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)
+
+(* addition with an overflow check *)
+let (++) a b =
+  let c = a + b in
+  match a < 0, b < 0, c < 0 with
+  | true , true , false
+  | false, false, true  -> invalid_arg "Bytes.extend" (* overflow *)
+  | _ -> c
+
+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 "String.fill / 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 "String.blit / Bytes.blit_string"
+  else unsafe_blit_string s1 ofs1 s2 ofs2 len
+
+(* duplicated in string.ml *)
+let iter f a =
+  for i = 0 to length a - 1 do f(unsafe_get a i) done
+
+(* duplicated in string.ml *)
+let iteri f a =
+  for i = 0 to length a - 1 do f i (unsafe_get a i) done
+
+let ensure_ge (x:int) y = if x >= y then x else invalid_arg "Bytes.concat"
+
+let rec sum_lengths acc seplen = function
+  | [] -> acc
+  | hd :: [] -> length hd + acc
+  | hd :: tl -> sum_lengths (ensure_ge (length hd + seplen + acc) acc) seplen tl
+
+let rec unsafe_blits dst pos sep seplen = function
+    [] -> dst
+  | hd :: [] ->
+    unsafe_blit hd 0 dst pos (length hd); dst
+  | hd :: tl ->
+    unsafe_blit hd 0 dst pos (length hd);
+    unsafe_blit sep 0 dst (pos + length hd) seplen;
+    unsafe_blits dst (pos + length hd + seplen) sep seplen tl
+
+let concat sep = function
+    [] -> empty
+  | l -> let seplen = length sep in
+    unsafe_blits
+      (create (sum_lengths 0 seplen l))
+      0 sep seplen l
+
+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 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
+          | ' ' .. '~' -> 1
+          | _ -> 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'
+        | (' ' .. '~') as c -> unsafe_set s' !n c
+        | c ->
+          let a =  (c :> int) 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;
+      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_ascii s = map Char.uppercase_ascii s
+let lowercase_ascii s = map Char.lowercase_ascii 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_ascii s = apply1 Char.uppercase_ascii s
+let uncapitalize_ascii s = apply1 Char.lowercase_ascii s
+
+(* duplicated in string.ml *)
+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
+
+(* duplicated in string.ml *)
+let index s c = index_rec s (length s) 0 c
+
+(* duplicated in string.ml *)
+let rec index_rec_opt s lim i c =
+  if i >= lim then None else
+  if unsafe_get s i = c then Some i else index_rec_opt s lim (i + 1) c
+
+(* duplicated in string.ml *)
+let index_opt s c = index_rec_opt s (length s) 0 c
+
+(* duplicated in string.ml *)
+let index_from s i c =
+  let l = length s in
+  if i < 0 || i > l then invalid_arg "String.index_from / Bytes.index_from" else
+    index_rec s l i c
+
+(* duplicated in string.ml *)
+let index_from_opt s i c =
+  let l = length s in
+  if i < 0 || i > l then invalid_arg "String.index_from_opt / Bytes.index_from_opt" else
+    index_rec_opt s l i c
+
+(* duplicated in string.ml *)
+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
+
+(* duplicated in string.ml *)
+let rindex s c = rindex_rec s (length s - 1) c
+
+(* duplicated in string.ml *)
+let rindex_from s i c =
+  if i < -1 || i >= length s then
+    invalid_arg "String.rindex_from / Bytes.rindex_from"
+  else
+    rindex_rec s i c
+
+(* duplicated in string.ml *)
+let rec rindex_rec_opt s i c =
+  if i < 0 then None else
+  if unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c
+
+(* duplicated in string.ml *)
+let rindex_opt s c = rindex_rec_opt s (length s - 1) c
+
+(* duplicated in string.ml *)
+let rindex_from_opt s i c =
+  if i < -1 || i >= length s then
+    invalid_arg "String.rindex_from_opt / Bytes.rindex_from_opt"
+  else
+    rindex_rec_opt s i c
+
+
+(* duplicated in string.ml *)
+let contains_from s i c =
+  let l = length s in
+  if i < 0 || i > l then
+    invalid_arg "String.contains_from / Bytes.contains_from"
+  else
+    try ignore (index_rec s l i c); true with Not_found -> false
+
+
+(* duplicated in string.ml *)
+let contains s c = contains_from s 0 c
+
+(* duplicated in string.ml *)
+let rcontains_from s i c =
+  if i < 0 || i >= length s then
+    invalid_arg "String.rcontains_from / 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
+let equal (x : t) (y : t) = x = y
+