sig
type t = Type.t = Atom of string | List of Sexp_intf.S.t list
type bigstring =
(char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
val default_indent : int Pervasives.ref
val size : Sexp_intf.S.t -> int * int
val scan_sexp : ?buf:Buffer.t -> Lexing.lexbuf -> Sexp_intf.S.t
val scan_sexps : ?buf:Buffer.t -> Lexing.lexbuf -> Sexp_intf.S.t list
val scan_rev_sexps : ?buf:Buffer.t -> Lexing.lexbuf -> Sexp_intf.S.t list
val scan_sexp_opt : ?buf:Buffer.t -> Lexing.lexbuf -> Sexp_intf.S.t option
val scan_iter_sexps :
?buf:Buffer.t -> f:(Sexp_intf.S.t -> unit) -> Lexing.lexbuf -> unit
val scan_fold_sexps :
?buf:Buffer.t ->
f:('a -> Sexp_intf.S.t -> 'a) -> init:'a -> Lexing.lexbuf -> 'a
val scan_sexps_conv :
?buf:Buffer.t -> f:(Sexp_intf.S.t -> 'a) -> Lexing.lexbuf -> 'a list
module Parse_pos :
sig
type t =
Pre_sexp.Parse_pos.t = private {
mutable text_line : int;
mutable text_char : int;
mutable global_offset : int;
mutable buf_pos : int;
}
val create :
?text_line:int ->
?text_char:int ->
?buf_pos:int -> ?global_offset:int -> unit -> Sexp_intf.S.Parse_pos.t
val with_buf_pos :
Sexp_intf.S.Parse_pos.t -> int -> Sexp_intf.S.Parse_pos.t
end
module Cont_state :
sig
type t =
Pre_sexp.Cont_state.t =
Parsing_whitespace
| Parsing_atom
| Parsing_list
| Parsing_sexp_comment
| Parsing_block_comment
val to_string : Sexp_intf.S.Cont_state.t -> string
end
type ('a, 't) parse_result =
('a, 't) Pre_sexp.parse_result =
Done of 't * Sexp_intf.S.Parse_pos.t
| Cont of Sexp_intf.S.Cont_state.t * ('a, 't) Sexp_intf.S.parse_fun
and ('a, 't) parse_fun =
pos:int -> len:int -> 'a -> ('a, 't) Sexp_intf.S.parse_result
module Annotated :
sig
type pos =
Pre_sexp.Annotated.pos = {
line : int;
col : int;
offset : int;
}
type range =
Pre_sexp.Annotated.range = {
start_pos : Sexp_intf.S.Annotated.pos;
end_pos : Sexp_intf.S.Annotated.pos;
}
type t =
Pre_sexp.Annotated.t =
Atom of Sexp_intf.S.Annotated.range * Type.t
| List of Sexp_intf.S.Annotated.range *
Sexp_intf.S.Annotated.t list * Type.t
type 'a conv =
[ `Error of exn * Sexp_intf.S.Annotated.t | `Result of 'a ]
exception Conv_exn of string * exn
type stack =
Pre_sexp.Annotated.stack = {
mutable positions : Sexp_intf.S.Annotated.pos list;
mutable stack : Sexp_intf.S.Annotated.t list list;
}
val get_sexp : Sexp_intf.S.Annotated.t -> Type.t
val get_range : Sexp_intf.S.Annotated.t -> Sexp_intf.S.Annotated.range
val find_sexp :
Sexp_intf.S.Annotated.t -> Type.t -> Sexp_intf.S.Annotated.t option
val parse :
?parse_pos:Sexp_intf.S.Parse_pos.t ->
?len:int ->
string -> (string, Sexp_intf.S.Annotated.t) Sexp_intf.S.parse_result
val parse_bigstring :
?parse_pos:Sexp_intf.S.Parse_pos.t ->
?len:int ->
Sexp_intf.S.bigstring ->
(Sexp_intf.S.bigstring, Sexp_intf.S.Annotated.t)
Sexp_intf.S.parse_result
val input_sexp :
?parse_pos:Sexp_intf.S.Parse_pos.t ->
Pervasives.in_channel -> Sexp_intf.S.Annotated.t
val input_sexps :
?parse_pos:Sexp_intf.S.Parse_pos.t ->
?buf:string -> Pervasives.in_channel -> Sexp_intf.S.Annotated.t list
val input_rev_sexps :
?parse_pos:Sexp_intf.S.Parse_pos.t ->
?buf:string -> Pervasives.in_channel -> Sexp_intf.S.Annotated.t list
val load_sexp :
?strict:bool -> ?buf:string -> string -> Sexp_intf.S.Annotated.t
val load_sexps : ?buf:string -> string -> Sexp_intf.S.Annotated.t list
val load_rev_sexps :
?buf:string -> string -> Sexp_intf.S.Annotated.t list
val of_string : string -> Sexp_intf.S.Annotated.t
val of_bigstring : Sexp_intf.S.bigstring -> Sexp_intf.S.Annotated.t
val conv :
(Type.t -> 'a) ->
Sexp_intf.S.Annotated.t -> 'a Sexp_intf.S.Annotated.conv
val get_conv_exn :
file:string -> exc:exn -> Sexp_intf.S.Annotated.t -> exn
end
type 't parse_state =
't Pre_sexp.parse_state = private {
parse_pos : Sexp_intf.S.Parse_pos.t;
mutable pstack : 't;
pbuf : Buffer.t;
}
type parse_error =
Pre_sexp.parse_error = {
location : string;
err_msg : string;
parse_state :
[ `Annot of Sexp_intf.S.Annotated.stack Sexp_intf.S.parse_state
| `Sexp of Sexp_intf.S.t list list Sexp_intf.S.parse_state ];
}
exception Parse_error of Sexp_intf.S.parse_error
val parse :
?parse_pos:Sexp_intf.S.Parse_pos.t ->
?len:int -> string -> (string, Sexp_intf.S.t) Sexp_intf.S.parse_result
val parse_bigstring :
?parse_pos:Sexp_intf.S.Parse_pos.t ->
?len:int ->
Sexp_intf.S.bigstring ->
(Sexp_intf.S.bigstring, Sexp_intf.S.t) Sexp_intf.S.parse_result
val input_sexp :
?parse_pos:Sexp_intf.S.Parse_pos.t ->
Pervasives.in_channel -> Sexp_intf.S.t
val input_sexps :
?parse_pos:Sexp_intf.S.Parse_pos.t ->
?buf:string -> Pervasives.in_channel -> Sexp_intf.S.t list
val input_rev_sexps :
?parse_pos:Sexp_intf.S.Parse_pos.t ->
?buf:string -> Pervasives.in_channel -> Sexp_intf.S.t list
val load_sexp : ?strict:bool -> ?buf:string -> string -> Sexp_intf.S.t
val load_sexps : ?buf:string -> string -> Sexp_intf.S.t list
val load_rev_sexps : ?buf:string -> string -> Sexp_intf.S.t list
val load_sexp_conv :
?strict:bool ->
?buf:string ->
string -> (Sexp_intf.S.t -> 'a) -> 'a Sexp_intf.S.Annotated.conv
val load_sexp_conv_exn :
?strict:bool -> ?buf:string -> string -> (Sexp_intf.S.t -> 'a) -> 'a
val load_sexps_conv :
?buf:string ->
string -> (Sexp_intf.S.t -> 'a) -> 'a Sexp_intf.S.Annotated.conv list
val load_sexps_conv_exn :
?buf:string -> string -> (Sexp_intf.S.t -> 'a) -> 'a list
val output_hum : Pervasives.out_channel -> Sexp_intf.S.t -> unit
val output_hum_indent :
int -> Pervasives.out_channel -> Sexp_intf.S.t -> unit
val output_mach : Pervasives.out_channel -> Sexp_intf.S.t -> unit
val output : Pervasives.out_channel -> Sexp_intf.S.t -> unit
val save_hum : ?perm:int -> string -> Sexp_intf.S.t -> unit
val save_mach : ?perm:int -> string -> Sexp_intf.S.t -> unit
val save : ?perm:int -> string -> Sexp_intf.S.t -> unit
val save_sexps_hum : ?perm:int -> string -> Sexp_intf.S.t list -> unit
val save_sexps_mach : ?perm:int -> string -> Sexp_intf.S.t list -> unit
val save_sexps : ?perm:int -> string -> Sexp_intf.S.t list -> unit
val pp_hum : Format.formatter -> Sexp_intf.S.t -> unit
val pp_hum_indent : int -> Format.formatter -> Sexp_intf.S.t -> unit
val pp_mach : Format.formatter -> Sexp_intf.S.t -> unit
val pp : Format.formatter -> Sexp_intf.S.t -> unit
module Of_string_conv_exn :
sig
type t = { exc : exn; sexp : Type.t; sub_sexp : Type.t; }
exception E of Sexp_intf.S.Of_string_conv_exn.t
end
val of_string : string -> Sexp_intf.S.t
val of_string_conv :
string -> (Sexp_intf.S.t -> 'a) -> 'a Sexp_intf.S.Annotated.conv
val of_string_conv_exn : string -> (Sexp_intf.S.t -> 'a) -> 'a
val of_bigstring : Sexp_intf.S.bigstring -> Sexp_intf.S.t
val of_bigstring_conv :
Sexp_intf.S.bigstring ->
(Sexp_intf.S.t -> 'a) -> 'a Sexp_intf.S.Annotated.conv
val of_bigstring_conv_exn :
Sexp_intf.S.bigstring -> (Sexp_intf.S.t -> 'a) -> 'a
val to_string_hum : ?indent:int -> Sexp_intf.S.t -> string
val to_string_mach : Sexp_intf.S.t -> string
val to_string : Sexp_intf.S.t -> string
val to_buffer_hum : buf:Buffer.t -> ?indent:int -> Sexp_intf.S.t -> unit
val to_buffer_mach : buf:Buffer.t -> Sexp_intf.S.t -> unit
val to_buffer : buf:Buffer.t -> Sexp_intf.S.t -> unit
val to_buffer_gen :
buf:'buffer ->
add_char:('buffer -> char -> unit) ->
add_string:('buffer -> string -> unit) -> Sexp_intf.S.t -> unit
val unit : Sexp_intf.S.t
external sexp_of_t : Sexp_intf.S.t -> Sexp_intf.S.t = "%identity"
external t_of_sexp : Sexp_intf.S.t -> Sexp_intf.S.t = "%identity"
type found = [ `Found | `Pos of int * Sexp_intf.S.found ]
type search_result =
[ `Found | `Not_found | `Pos of int * Sexp_intf.S.found ]
val search_physical :
Sexp_intf.S.t -> contained:Sexp_intf.S.t -> Sexp_intf.S.search_result
val subst_found :
Sexp_intf.S.t ->
subst:Sexp_intf.S.t -> Sexp_intf.S.found -> Sexp_intf.S.t
module With_layout :
sig
type pos = Src_pos.Relative.t = { row : int; col : int; }
val sexp_of_pos : Sexp_intf.S.With_layout.pos -> Type.t
type t =
Atom of Sexp_intf.S.With_layout.pos * string * string option
| List of Sexp_intf.S.With_layout.pos *
Sexp_intf.S.With_layout.t_or_comment list *
Sexp_intf.S.With_layout.pos
and t_or_comment =
Sexp of Sexp_intf.S.With_layout.t
| Comment of Sexp_intf.S.With_layout.comment
and comment =
Plain_comment of Sexp_intf.S.With_layout.pos * string
| Sexp_comment of Sexp_intf.S.With_layout.pos *
Sexp_intf.S.With_layout.comment list * Sexp_intf.S.With_layout.t
val sexp_of_t : Sexp_intf.S.With_layout.t -> Type.t
val sexp_of_comment : Sexp_intf.S.With_layout.comment -> Type.t
val sexp_of_t_or_comment :
Sexp_intf.S.With_layout.t_or_comment -> Type.t
module Forget :
sig
val t : Sexp_intf.S.With_layout.t -> Type.t
val t_or_comment :
Sexp_intf.S.With_layout.t_or_comment -> Type.t option
val t_or_comments :
Sexp_intf.S.With_layout.t_or_comment list -> Type.t list
end
module Render :
sig
type 'a t
val return : 'a -> 'a Sexp_intf.S.With_layout.Render.t
val bind :
'a Sexp_intf.S.With_layout.Render.t ->
('a -> 'b Sexp_intf.S.With_layout.Render.t) ->
'b Sexp_intf.S.With_layout.Render.t
val sexp :
Sexp_intf.S.With_layout.t_or_comment ->
unit Sexp_intf.S.With_layout.Render.t
val run :
(char -> unit) -> unit Sexp_intf.S.With_layout.Render.t -> unit
end
module Parser :
sig
type token
val sexp :
(Lexing.lexbuf -> Sexp_intf.S.With_layout.Parser.token) ->
Lexing.lexbuf -> Sexp_intf.S.With_layout.t_or_comment
val sexp_opt :
(Lexing.lexbuf -> Sexp_intf.S.With_layout.Parser.token) ->
Lexing.lexbuf -> Sexp_intf.S.With_layout.t_or_comment option
val sexps :
(Lexing.lexbuf -> Sexp_intf.S.With_layout.Parser.token) ->
Lexing.lexbuf -> Sexp_intf.S.With_layout.t_or_comment list
val rev_sexps :
(Lexing.lexbuf -> Sexp_intf.S.With_layout.Parser.token) ->
Lexing.lexbuf -> Sexp_intf.S.With_layout.t_or_comment list
val sexps_abs :
(Lexing.lexbuf -> Sexp_intf.S.With_layout.Parser.token) ->
Lexing.lexbuf -> Type_with_layout.Parsed.t_or_comment list
end
module Lexer :
sig
val main :
?buf:Buffer.t ->
Lexing.lexbuf -> Sexp_intf.S.With_layout.Parser.token
end
end
end