From 8bb6440344d937d00202c543db6af97f28243f35 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Wed, 17 Sep 2014 15:00:26 +0200
Subject: [PATCH] richer API for sexp (print/parse files)

---
 misc/sexp.ml  | 72 ++++++++++++++++++++++++++++++++++++++++++---------
 misc/sexp.mli | 15 +++++++++--
 2 files changed, 73 insertions(+), 14 deletions(-)

diff --git a/misc/sexp.ml b/misc/sexp.ml
index 943776f0..a42b3178 100644
--- a/misc/sexp.ml
+++ b/misc/sexp.ml
@@ -84,6 +84,35 @@ let rec print fmt t = match t with
       Format.pp_print_char fmt ')';
       Format.close_box ()
 
+let rec print_noindent fmt t = match t with
+  | Atom s when _must_escape s -> Format.fprintf fmt "\"%s\"" (String.escaped s)
+  | Atom s -> Format.pp_print_string fmt s
+  | List [] -> Format.pp_print_string fmt "()"
+  | List [x] -> Format.fprintf fmt "(%a)" print_noindent x
+  | List l ->
+      Format.pp_print_char fmt '(';
+      List.iteri
+        (fun i t' -> (if i > 0 then Format.pp_print_char fmt ' '; print_noindent fmt t'))
+        l;
+      Format.pp_print_char fmt ')'
+
+let to_chan oc t =
+  let fmt = Format.formatter_of_out_channel oc in
+  print fmt t;
+  Format.pp_print_flush fmt ()
+
+let seq_to_file filename seq =
+  let oc = open_out filename in
+  try
+    seq
+      (fun t -> to_chan oc t; output_char oc '\n');
+    close_out oc
+  with e ->
+    close_out oc;
+    raise e
+
+let to_file filename t = seq_to_file filename (fun k -> k t)
+
 (** {2 Deserialization (decoding)} *)
 
 type 'a parse_result = ['a or_error | `End ]
@@ -358,13 +387,14 @@ and _push ps e = match ps.ps_stack with
       ps.ps_stack <- (e :: l) :: tl;
       _next ps
 
-let parse_gen g : t ParseGen.t =
+(* parse from a generator of string slices *)
+let _parse_gen g : t ParseGen.t =
   let ps = mk_ps() in
   let rec next () = match _next ps with
     | `Await ->
         begin match g() with
         | None -> Streaming.reached_end ps.ps_d
-        | Some s -> Streaming.feed ps.ps_d s 0 (String.length s)
+        | Some (s,i,len) -> Streaming.feed ps.ps_d s i len
         end;
         next()
     | `Ok x -> `Ok x
@@ -373,6 +403,14 @@ let parse_gen g : t ParseGen.t =
   in
   next
 
+let parse_gen g =
+  _parse_gen
+    (fun () ->
+      match g() with
+      | None -> None
+      | Some s -> Some (s,0,String.length s)
+    )
+
 (* singleton generator *)
 let _gen1 x =
   let first = ref true in
@@ -382,16 +420,16 @@ let _gen1 x =
 let parse_string s =
   parse_gen (_gen1 s)
 
-let parse_chan ic =
-  let buf = Buffer.create 512 in
+let parse_chan ?(bufsize=1024) ic =
+  let buf = String.make bufsize ' ' in
+  let stop = ref false in
   let gen () =
-    Buffer.clear buf;
-    Buffer.add_channel buf ic 512;
-    if Buffer.length buf = 0
-      then None
-      else Some (Buffer.contents buf)
+    if !stop then None
+    else
+      let n = input ic buf 0 bufsize in
+      if n=0 then (stop:=true; None) else Some (buf,0,n)
   in
-  parse_gen gen
+  _parse_gen gen
 
 (** {6 Blocking} *)
 
@@ -401,8 +439,18 @@ let parse1_chan ic =
 let parse1_string s =
   ParseGen.head (parse_string s)
 
-let parse_l_chan ic =
-  ParseGen.to_list (parse_chan ic)
+let parse_l_chan ?bufsize ic =
+  ParseGen.to_list (parse_chan ?bufsize ic)
+
+let parse_l_file ?bufsize filename =
+  let ic = open_in filename in
+  try
+    let l = parse_l_chan ?bufsize ic in
+    close_in ic;
+    l
+  with e ->
+    close_in ic;
+    `Error (Printexc.to_string e)
 
 let parse_l_string s =
   ParseGen.to_list (parse_string s)
diff --git a/misc/sexp.mli b/misc/sexp.mli
index 76f3d3fb..897cf654 100644
--- a/misc/sexp.mli
+++ b/misc/sexp.mli
@@ -43,8 +43,15 @@ val hash : t -> int
 
 val to_buf : Buffer.t -> t -> unit
 val to_string : t -> string
+val to_file : string -> t -> unit
+val to_chan : out_channel -> t -> unit
+
 val print : Format.formatter -> t -> unit
 
+val print_noindent : Format.formatter -> t -> unit
+
+val seq_to_file : string -> t sequence -> unit
+
 (** {2 Deserialization (decoding)} *)
 
 type 'a parse_result = ['a or_error | `End ]
@@ -94,7 +101,7 @@ end
 val parse_string : string -> t ParseGen.t
 (** Parse a string *)
 
-val parse_chan : in_channel -> t ParseGen.t
+val parse_chan : ?bufsize:int -> in_channel -> t ParseGen.t
 (** Parse a channel *)
 
 val parse_gen : string gen -> t ParseGen.t
@@ -106,7 +113,11 @@ val parse1_chan : in_channel -> t or_error
 
 val parse1_string : string -> t or_error
 
-val parse_l_chan : in_channel -> t list or_error
+val parse_l_chan : ?bufsize:int -> in_channel -> t list or_error
+(** Parse values from a channel. *)
+
+val parse_l_file : ?bufsize:int -> string -> t list or_error
+(** Parse a file *)
 
 val parse_l_string : string -> t list or_error