mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
328 lines
9.3 KiB
OCaml
328 lines
9.3 KiB
OCaml
(*
|
|
Copyright (c) 2013, Simon Cruanes
|
|
All rights reserved.
|
|
|
|
Redistribution and use in source and binary forms, with or without
|
|
modification, are permitted provided that the following conditions are met:
|
|
|
|
Redistributions of source code must retain the above copyright notice, this
|
|
list of conditions and the following disclaimer. Redistributions in binary
|
|
form must reproduce the above copyright notice, this list of conditions and the
|
|
following disclaimer in the documentation and/or other materials provided with
|
|
the distribution.
|
|
|
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
|
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
|
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
|
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
|
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
|
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
|
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
|
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
*)
|
|
|
|
(** {1 Simple and efficient S-expression parsing/printing}
|
|
|
|
@since 0.4 *)
|
|
|
|
type 'a or_error = [ `Ok of 'a | `Error of string ]
|
|
type 'a sequence = ('a -> unit) -> unit
|
|
type 'a gen = unit -> 'a option
|
|
|
|
(** {2 Basics} *)
|
|
|
|
type t = [
|
|
| `Atom of string
|
|
| `List of t list
|
|
]
|
|
|
|
val equal : t -> t -> bool
|
|
val compare : t -> t -> int
|
|
val hash : t -> int
|
|
|
|
val atom : string -> t (** Build an atom directly from a string *)
|
|
|
|
val of_int : int -> t
|
|
val of_bool : bool -> t
|
|
val of_list : t list -> t
|
|
val of_rev_list : t list -> t (** Reverse the list *)
|
|
val of_float : float -> t
|
|
val of_unit : t
|
|
val of_pair : t * t -> t
|
|
val of_triple : t * t * t -> t
|
|
val of_quad : t * t * t * t -> t
|
|
|
|
val of_variant : string -> t list -> t
|
|
(** [of_variant name args] is used to encode algebraic variants
|
|
into a S-expr. For instance [of_variant "some" [of_int 1]]
|
|
represents the value [Some 1] *)
|
|
|
|
val of_field : string -> t -> t
|
|
(** Used to represent one record field *)
|
|
|
|
val of_record : (string * t) list -> t
|
|
(** Represent a record by its named fields *)
|
|
|
|
(** {2 Serialization (encoding)} *)
|
|
|
|
val to_buf : Buffer.t -> t -> unit
|
|
|
|
val to_string : t -> string
|
|
|
|
val to_file : string -> t -> unit
|
|
|
|
val to_file_seq : string -> t sequence -> unit
|
|
(** Print the given sequence of expressions to a file *)
|
|
|
|
val to_chan : out_channel -> t -> unit
|
|
|
|
val print : Format.formatter -> t -> unit
|
|
(** Pretty-printer nice on human eyes (including indentation) *)
|
|
|
|
val print_noindent : Format.formatter -> t -> unit
|
|
(** Raw, direct printing as compact as possible *)
|
|
|
|
(** {2 Deserialization (decoding)} *)
|
|
|
|
type 'a parse_result = ['a or_error | `End ]
|
|
type 'a partial_result = [ 'a parse_result | `Await ]
|
|
|
|
(** {6 Source of characters} *)
|
|
module Source : sig
|
|
type individual_char =
|
|
| NC_yield of char
|
|
| NC_end
|
|
| NC_await
|
|
(** An individual character returned by a source *)
|
|
|
|
type t = unit -> individual_char
|
|
(** A source of characters can yield them one by one, or signal the end,
|
|
or signal that some external intervention is needed *)
|
|
|
|
type source = t
|
|
|
|
(** A manual source of individual characters. When it has exhausted its
|
|
own input, it asks its caller to provide more or signal that none remains
|
|
This is especially useful when the source of data is monadic IO *)
|
|
module Manual : sig
|
|
type t
|
|
|
|
val make : unit -> t
|
|
(** Make a new manual source. It needs to be fed input manually,
|
|
using {!feed} *)
|
|
|
|
val to_src : t -> source
|
|
(** The manual source contains a source! *)
|
|
|
|
val feed : t -> string -> int -> int -> unit
|
|
(** Feed a chunk of input to the manual source *)
|
|
|
|
val reached_end : t -> unit
|
|
(** Tell the decoder that end of input has been reached. From now
|
|
the source will only yield [NC_end] *)
|
|
end
|
|
|
|
val of_string : string -> t
|
|
(** Use a single string as the source *)
|
|
|
|
val of_chan : ?bufsize:int -> in_channel -> t
|
|
(** Use a channel as the source *)
|
|
|
|
val of_gen : string gen -> t
|
|
end
|
|
|
|
(** {6 Streaming Lexer}
|
|
splits the input into opening parenthesis, closing ones, and atoms *)
|
|
module Lexer : sig
|
|
type t
|
|
(** A streaming lexer, that parses atomic chunks of S-expressions (atoms
|
|
and delimiters) *)
|
|
|
|
val make : Source.t -> t
|
|
(** Create a lexer that uses the given source of characters as an input *)
|
|
|
|
val of_string : string -> t
|
|
|
|
val of_chan : in_channel -> t
|
|
|
|
val line : t -> int
|
|
val col : t -> int
|
|
|
|
(** Obtain next token *)
|
|
|
|
type token =
|
|
| Open
|
|
| Close
|
|
| Atom of string
|
|
(** An individual S-exp token *)
|
|
|
|
val next : t -> token partial_result
|
|
(** Obtain the next token, an error, or block/end stream *)
|
|
end
|
|
|
|
(** {6 Generator with errors} *)
|
|
module ParseGen : sig
|
|
type 'a t = unit -> 'a parse_result
|
|
(** A generator-like structure, but with the possibility of errors.
|
|
When called, it can yield a new element, signal the end of stream,
|
|
or signal an error. *)
|
|
|
|
val to_list : 'a t -> 'a list or_error
|
|
|
|
val head : 'a t -> 'a or_error
|
|
|
|
val head_exn : 'a t -> 'a
|
|
|
|
val take : int -> 'a t -> 'a t
|
|
end
|
|
|
|
(** {6 Stream Parser}
|
|
Returns a lazy stream of S-expressions. *)
|
|
|
|
val parse_string : string -> t ParseGen.t
|
|
(** Parse a string *)
|
|
|
|
val parse_chan : ?bufsize:int -> in_channel -> t ParseGen.t
|
|
(** Parse a channel *)
|
|
|
|
val parse_gen : string gen -> t ParseGen.t
|
|
(** Parse chunks of string *)
|
|
|
|
(** {6 Blocking API}
|
|
Parse one S-expression from some source. *)
|
|
|
|
val of_chan : in_channel -> t or_error
|
|
(** Parse a S-expression from the given channel. Can read more data than
|
|
necessary, so don't use this if you need finer-grained control (e.g.
|
|
to read something else {b after} the S-exp) *)
|
|
|
|
val of_string : string -> t or_error
|
|
|
|
val of_file : string -> t or_error
|
|
(** Open the file and read a S-exp from it *)
|
|
|
|
(** {6 Lists of S-exps} *)
|
|
|
|
module L : sig
|
|
val to_buf : Buffer.t -> t list -> unit
|
|
|
|
val to_string : t list -> string
|
|
|
|
val to_file : string -> t list -> unit
|
|
|
|
val to_chan : out_channel -> t list -> unit
|
|
|
|
val of_chan : ?bufsize:int -> in_channel -> t list or_error
|
|
|
|
val of_file : ?bufsize:int -> string -> t list or_error
|
|
|
|
val of_string : string -> t list or_error
|
|
|
|
val of_gen : string gen -> t list or_error
|
|
|
|
val of_seq : string sequence -> t list or_error
|
|
end
|
|
|
|
(** {6 Traversal of S-exp}
|
|
|
|
Example: serializing 2D points
|
|
{[
|
|
type pt = {x:int; y:int };;
|
|
|
|
let pt_of_sexp e =
|
|
Sexp.Traverse.(
|
|
field "x" to_int e >>= fun x ->
|
|
field "y" to_int e >>= fun y ->
|
|
return {x;y}
|
|
);;
|
|
|
|
let sexp_of_pt pt = Sexp.(of_record ["x", of_int pt.x; "y", of_int pt.y]);;
|
|
|
|
let l = [{x=1;y=1}; {x=2;y=10}];;
|
|
|
|
let sexp = Sexp.(of_list (List.map sexp_of_pt l));;
|
|
|
|
Sexp.Traverse.list_all pt_of_sexp sexp;;
|
|
]}
|
|
|
|
*)
|
|
|
|
module Traverse : sig
|
|
type 'a conv = t -> 'a option
|
|
(** A converter from S-expressions to 'a is a function [sexp -> 'a option].
|
|
@since 0.4.1 *)
|
|
|
|
val map_opt : ('a -> 'b option) -> 'a list -> 'b list option
|
|
(** Map over a list, failing as soon as the function fails on any element
|
|
@since 0.4.1 *)
|
|
|
|
val list_any : 'a conv -> t -> 'a option
|
|
(** [list_any f (List l)] tries [f x] for every element [x] in [List l],
|
|
and returns the first non-None result (if any). *)
|
|
|
|
val list_all : 'a conv -> t -> 'a list
|
|
(** [list_all f (List l)] returns the list of all [y] such that [x] in [l]
|
|
and [f x = Some y] *)
|
|
|
|
val to_int : int conv
|
|
(** Expect an integer *)
|
|
|
|
val to_string : string conv
|
|
(** Expect a string (an atom) *)
|
|
|
|
val to_bool : bool conv
|
|
(** Expect a boolean *)
|
|
|
|
val to_float : float conv
|
|
(** Expect a float *)
|
|
|
|
val to_list : t list conv
|
|
(** Expect a list *)
|
|
|
|
val to_list_with : (t -> 'a option) -> 'a list conv
|
|
(** Expect a list, applies [f] to all the elements of the list, and succeeds
|
|
only if [f] succeeded on every element
|
|
@since 0.4.1 *)
|
|
|
|
val to_pair : (t * t) conv
|
|
(** Expect a list of two elements *)
|
|
|
|
val to_pair_with : 'a conv -> 'b conv -> ('a * 'b) conv
|
|
(** Same as {!to_pair} but applies conversion functions
|
|
@since 0.4.1 *)
|
|
|
|
val to_triple : (t * t * t) conv
|
|
|
|
val to_triple_with : 'a conv -> 'b conv -> 'c conv -> ('a * 'b * 'c) conv
|
|
(* @since 0.4.1 *)
|
|
|
|
val get_field : string -> t conv
|
|
(** [get_field name e], when [e = List [(n1,x1); (n2,x2) ... ]], extracts
|
|
the [xi] such that [name = ni], if it can find it. *)
|
|
|
|
val field : string -> 'a conv -> 'a conv
|
|
(** Enriched version of {!get_field}, with a converter as argument *)
|
|
|
|
val get_variant : (string * (t list -> 'a option)) list -> 'a conv
|
|
(** [get_variant l e] checks whether [e = List (Atom s :: args)], and
|
|
if some pair of [l] is [s, f]. In this case, it calls [f args]
|
|
and returns its result, otherwise it returns None. *)
|
|
|
|
val field_list : string -> (t list -> 'a option) -> 'a conv
|
|
(** [field_list name f "(... (name a b c d) ...record)"]
|
|
will look for a field based on the given [name], and expect it to have a
|
|
list of arguments dealt with by [f] (here, "a b c d").
|
|
@since 0.4.1 *)
|
|
|
|
val (>>=) : 'a option -> ('a -> 'b option) -> 'b option
|
|
|
|
val (>|=) : 'a option -> ('a -> 'b) -> 'b option
|
|
|
|
val return : 'a -> 'a option
|
|
|
|
val get_exn : 'a option -> 'a
|
|
(** Unwrap an option, possibly failing.
|
|
@raise Invalid_argument if the argument is [None] *)
|
|
end
|