@tellahq/rescript 10.1.0-alpha.1

package/lib/ocaml/stream.ml

@@ -0,0 +1,213 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt       *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type 'a t = 'a cell option
+and 'a cell = { mutable count : int; mutable data : 'a data }
+and 'a data =
+    Sempty
+  | Scons of 'a * 'a data
+  | Sapp of 'a data * 'a data
+  | Slazy of 'a data Lazy.t
+  | Sgen of 'a gen
+and 'a gen = { mutable curr : 'a option option; func : int -> 'a option }
+
+exception Failure
+exception Error of string
+
+let count = function
+  | None -> 0
+  | Some { count } -> count
+let data = function
+  | None -> Sempty
+  | Some { data } -> data
+
+
+
+let rec get_data : type v. int -> v data -> v data = fun count d -> match d with
+ (* Returns either Sempty or Scons(a, _) even when d is a generator
+    or a buffer. In those cases, the item a is seen as extracted from
+ the generator/buffer.
+ The count parameter is used for calling `Sgen-functions'.  *)
+   Sempty | Scons (_, _) -> d
+ | Sapp (d1, d2) ->
+     begin match get_data count d1 with
+       Scons (a, d11) -> Scons (a, Sapp (d11, d2))
+     | Sempty -> get_data count d2
+     | _ -> assert false
+     end
+ | Sgen {curr = Some None} -> Sempty
+ | Sgen ({curr = Some(Some a)} as g) ->
+     g.curr <- None; Scons(a, d)
+ | Sgen g ->
+     begin match g.func count with
+       None -> g.curr <- Some(None); Sempty
+     | Some a -> Scons(a, d)
+         (* Warning: anyone using g thinks that an item has been read *)
+     end
+ | Slazy f -> get_data count (Lazy.force f)
+
+
+let rec peek_data : type v. v cell -> v option = fun s ->
+ (* consult the first item of s *)
+ match s.data with
+   Sempty -> None
+ | Scons (a, _) -> Some a
+ | Sapp (_, _) ->
+     begin match get_data s.count s.data with
+       Scons(a, _) as d -> s.data <- d; Some a
+     | Sempty -> None
+     | _ -> assert false
+     end
+ | Slazy f -> s.data <- (Lazy.force f); peek_data s
+ | Sgen {curr = Some a} -> a
+ | Sgen g -> let x = g.func s.count in g.curr <- Some x; x
+
+
+let peek = function
+  | None -> None
+  | Some s -> peek_data s
+
+
+let rec junk_data : type v. v cell -> unit = fun s ->
+  match s.data with
+    Scons (_, d) -> s.count <- (succ s.count); s.data <- d
+  | Sgen ({curr = Some _} as g) -> s.count <- (succ s.count); g.curr <- None
+  | _ ->
+      match peek_data s with
+        None -> ()
+      | Some _ -> junk_data s
+
+
+let junk = function
+  | None -> ()
+  | Some data -> junk_data data
+
+let rec nget_data n s =
+  if n <= 0 then [], s.data, 0
+  else
+    match peek_data s with
+      Some a ->
+        junk_data s;
+        let (al, d, k) = nget_data (pred n) s in a :: al, Scons (a, d), succ k
+    | None -> [], s.data, 0
+
+
+let npeek_data n s =
+  let (al, d, len) = nget_data n s in
+  s.count <- (s.count - len);
+  s.data <- d;
+  al
+
+
+let npeek n = function
+  | None -> []
+  | Some d -> npeek_data n d
+
+let next s =
+  match peek s with
+    Some a -> junk s; a
+  | None -> raise Failure
+
+
+let empty s =
+  match peek s with
+    Some _ -> raise Failure
+  | None -> ()
+
+
+let iter f strm =
+  let rec do_rec () =
+    match peek strm with
+      Some a -> junk strm; ignore(f a); do_rec ()
+    | None -> ()
+  in
+  do_rec ()
+
+
+(* Stream building functions *)
+
+let from f = Some {count = 0; data = Sgen {curr = None; func = f}}
+
+let of_list l =
+  Some {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty}
+
+
+let of_string s =
+  let count = ref 0 in
+  from (fun _ ->
+    (* We cannot use the index passed by the [from] function directly
+       because it returns the current stream count, with absolutely no
+       guarantee that it will start from 0. For example, in the case
+       of [Stream.icons 'c' (Stream.from_string "ab")], the first
+       access to the string will be made with count [1] already.
+    *)
+    let c = !count in
+    if c < String.length s
+    then (incr count; Some s.[c])
+    else None)
+
+
+let of_bytes s =
+  let count = ref 0 in
+  from (fun _ ->
+    let c = !count in
+    if c < Bytes.length s
+    then (incr count; Some (Bytes.get s c))
+    else None)
+
+
+
+
+(* Stream expressions builders *)
+
+let iapp i s = Some {count = 0; data = Sapp (data i, data s)}
+let icons i s = Some {count = 0; data = Scons (i, data s)}
+let ising i = Some {count = 0; data = Scons (i, Sempty)}
+
+let lapp f s =
+  Some {count = 0; data = Slazy (lazy(Sapp (data (f ()), data s)))}
+
+let lcons f s = Some {count = 0; data = Slazy (lazy(Scons (f (), data s)))}
+let lsing f = Some {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))}
+
+let sempty = None
+let slazy f = Some {count = 0; data = Slazy (lazy(data (f ())))}
+
+(* For debugging use *)
+
+let rec dump : type v. (v -> unit) -> v t -> unit = fun f s ->
+  print_string "{count = ";
+  print_int (count s);
+  print_string "; data = ";
+  dump_data f (data s);
+  print_string "}";
+  print_newline ()
+and dump_data : type v. (v -> unit) -> v data -> unit = fun f ->
+  function
+    Sempty -> print_string "Sempty"
+  | Scons (a, d) ->
+      print_string "Scons (";
+      f a;
+      print_string ", ";
+      dump_data f d;
+      print_string ")"
+  | Sapp (d1, d2) ->
+      print_string "Sapp (";
+      dump_data f d1;
+      print_string ", ";
+      dump_data f d2;
+      print_string ")"
+  | Slazy _ -> print_string "Slazy"
+  | Sgen _ -> print_string "Sgen"

package/lib/ocaml/stream.mli

@@ -0,0 +1,108 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt       *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Streams and parsers. *)
+
+type 'a t
+(** The type of streams holding values of type ['a]. *)
+
+exception Failure
+(** Raised by parsers when none of the first components of the stream
+   patterns is accepted. *)
+
+exception Error of string
+(** Raised by parsers when the first component of a stream pattern is
+   accepted, but one of the following components is rejected. *)
+
+
+(** {1 Stream builders} *)
+
+val from : (int -> 'a option) -> 'a t
+(** [Stream.from f] returns a stream built from the function [f].
+   To create a new stream element, the function [f] is called with
+   the current stream count. The user function [f] must return either
+   [Some <value>] for a value or [None] to specify the end of the
+   stream.
+
+   Do note that the indices passed to [f] may not start at [0] in the
+   general case. For example, [[< '0; '1; Stream.from f >]] would call
+   [f] the first time with count [2].
+*)
+
+val of_list : 'a list -> 'a t
+(** Return the stream holding the elements of the list in the same
+   order. *)
+
+val of_string : string -> char t
+(** Return the stream of the characters of the string parameter. *)
+
+val of_bytes : bytes -> char t
+(** Return the stream of the characters of the bytes parameter.
+    @since 4.02.0 *)
+
+
+
+(** {1 Stream iterator} *)
+
+val iter : ('a -> unit) -> 'a t -> unit
+(** [Stream.iter f s] scans the whole stream s, applying function [f]
+   in turn to each stream element encountered. *)
+
+
+(** {1 Predefined parsers} *)
+
+val next : 'a t -> 'a
+(** Return the first element of the stream and remove it from the
+   stream. Raise {!Stream.Failure} if the stream is empty. *)
+
+val empty : 'a t -> unit
+(** Return [()] if the stream is empty, else raise {!Stream.Failure}. *)
+
+
+(** {1 Useful functions} *)
+
+val peek : 'a t -> 'a option
+(** Return [Some] of "the first element" of the stream, or [None] if
+   the stream is empty. *)
+
+val junk : 'a t -> unit
+(** Remove the first element of the stream, possibly unfreezing
+   it before. *)
+
+val count : 'a t -> int
+(** Return the current count of the stream elements, i.e. the number
+   of the stream elements discarded. *)
+
+val npeek : int -> 'a t -> 'a list
+(** [npeek n] returns the list of the [n] first elements of
+   the stream, or all its remaining elements if less than [n]
+   elements are available. *)
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+val iapp : 'a t -> 'a t -> 'a t
+val icons : 'a -> 'a t -> 'a t
+val ising : 'a -> 'a t
+
+val lapp : (unit -> 'a t) -> 'a t -> 'a t
+val lcons : (unit -> 'a) -> 'a t -> 'a t
+val lsing : (unit -> 'a) -> 'a t
+
+val sempty : 'a t
+val slazy : (unit -> 'a t) -> 'a t
+
+val dump : ('a -> unit) -> 'a t -> unit

package/lib/ocaml/string.ml

@@ -0,0 +1,190 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*           Damien Doligez, projet Gallium, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   Copyright 2014 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* String operations, based on byte sequence operations *)
+
+(* WARNING: Some functions in this file are duplicated in bytes.ml for
+   efficiency reasons. When you modify the one in this file you need to
+   modify its duplicate in bytes.ml.
+   These functions have a "duplicated" comment above their definition.
+*)
+
+external length : string -> int = "%string_length"
+external get : string -> int -> char = "%string_safe_get"
+external unsafe_get : string -> int -> char = "%string_unsafe_get"
+
+module B = Bytes
+
+let bts = B.unsafe_to_string
+let bos = B.unsafe_of_string
+
+external make : int -> char -> string = "?string_repeat"  
+
+let init n f =
+  B.init n f |> bts
+let sub s ofs len =
+  B.sub (bos s) ofs len |> bts
+let blit =
+  B.blit_string
+
+
+
+external%private join : string array -> string -> string = "join" [@@send]
+
+let concat (sep : string) (xs : string list) =
+  xs |. Belt_List.toArray |. join sep
+
+(* duplicated in bytes.ml *)
+let iter f s =
+  for i = 0 to length s - 1 do f (unsafe_get s i) done
+
+(* duplicated in bytes.ml *)
+let iteri f s =
+  for i = 0 to length s - 1 do f i (unsafe_get s i) done
+
+let map f s =
+  B.map f (bos s) |> bts
+let mapi f s =
+  B.mapi f (bos s) |> bts
+
+(* 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
+   to make a copy. *)
+
+let is_space = function
+  | ' ' | '\012' | '\n' | '\r' | '\t' -> true
+  | _ -> false
+
+let trim s =
+  if s = "" then s
+  else if is_space (unsafe_get s 0) || is_space (unsafe_get s (length s - 1))
+  then bts (B.trim (bos s))
+  else s
+
+let escaped s =
+  let rec needs_escape i =
+    if i >= length s then false else
+      match unsafe_get s i with
+      | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> true
+      | ' ' .. '~' -> needs_escape (i+1)
+      | _ -> true
+  in
+  if needs_escape 0 then
+    bts (B.escaped (bos s))
+  else
+    s
+
+(* duplicated in bytes.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 bytes.ml *)
+let index s c = index_rec s (length s) 0 c
+
+(* duplicated in bytes.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 bytes.ml *)
+let index_opt s c = index_rec_opt s (length s) 0 c
+
+(* duplicated in bytes.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 bytes.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 bytes.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 bytes.ml *)
+let rindex s c = rindex_rec s (length s - 1) c
+
+(* duplicated in bytes.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 bytes.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 bytes.ml *)
+let rindex_opt s c = rindex_rec_opt s (length s - 1) c
+
+(* duplicated in bytes.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 bytes.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 bytes.ml *)
+let contains s c = contains_from s 0 c
+
+(* duplicated in bytes.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
+
+let uppercase_ascii s =
+  B.uppercase_ascii (bos s) |> bts
+let lowercase_ascii s =
+  B.lowercase_ascii (bos s) |> bts
+let capitalize_ascii s =
+  B.capitalize_ascii (bos s) |> bts
+let uncapitalize_ascii s =
+  B.uncapitalize_ascii (bos s) |> bts
+
+type t = string
+
+let compare (x: t) (y: t) = Pervasives.compare x y
+let equal : string -> string -> bool = fun a b -> a = b
+
+let split_on_char sep s =
+  let r = ref [] in
+  let j = ref (length s) in
+  for i = length s - 1 downto 0 do
+    if unsafe_get s i = sep then begin
+      r := sub s (i + 1) (!j - i - 1) :: !r;
+      j := i
+    end
+  done;
+  sub s 0 !j :: !r
+
+