simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 03:05:28 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

bugfix in Sexp; better pretty-printing

Browse source
This commit is contained in:
Simon Cruanes 2014-09-17 14:09:33 +02:00
parent 0aaae830bc
commit d5eb60d0ae
1 changed files with 24 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
misc/sexp.ml
View file

@ -73,13 +73,15 @@ let rec print fmt t = match t with
| Atom s when _must_escape s -> Format.fprintf fmt "\"%s\"" (String.escaped s) | Atom s when _must_escape s -> Format.fprintf fmt "\"%s\"" (String.escaped s)
| Atom s -> Format.pp_print_string fmt s | Atom s -> Format.pp_print_string fmt s
| List [] -> Format.pp_print_string fmt "()" | List [] -> Format.pp_print_string fmt "()"
| List [x] -> Format.fprintf fmt "(%a)" print x | List [x] -> Format.fprintf fmt "@[<hov2>(%a)@]" print x
| List l -> | List l ->
Format.open_hovbox 2;
Format.pp_print_char fmt '('; Format.pp_print_char fmt '(';
List.iteri List.iteri
(fun i t' -> (if i > 0 then Format.fprintf fmt "@ "; print fmt t')) (fun i t' -> (if i > 0 then Format.fprintf fmt "@ "; print fmt t'))
l; l;
Format.pp_print_char fmt ')' Format.pp_print_char fmt ')';
Format.close_box ()
(** {2 Deserialization (decoding)} *) (** {2 Deserialization (decoding)} *)
@ -114,8 +116,8 @@ module Streaming = struct
let mk_decoder () = { let mk_decoder () = {
i = 0; i = 0;
st = St_start; st = St_start;
line = 0; line = 1;
col = 0; col = 1;
stop = false; stop = false;
buf=Buffer.create 32; buf=Buffer.create 32;
atom = Buffer.create 32; atom = Buffer.create 32;
@ -157,16 +159,23 @@ module Streaming = struct
(* raise an error *) (* raise an error *)
let _error d msg = let _error d msg =
let msg' = Printf.sprintf "at %d,%d: %s" d.line d.col msg in let b = Buffer.create 32 in
d.st <- St_error msg'; Printf.bprintf b "at %d, %d: " d.line d.col;
raise (Error msg') Printf.kbprintf
(fun b ->
let msg' = Buffer.contents b in
d.st <- St_error msg';
raise (Error msg'))
b msg
let _end d = let _end d =
d.st <- St_end; d.st <- St_end;
raise EOI raise EOI
(* next token *) (* next token *)
let rec _next d st = match st with let rec _next d st =
d.st <- st;
match st with
| St_error msg -> raise (Error msg) | St_error msg -> raise (Error msg)
| St_end -> _end d | St_end -> _end d
| St_yield x -> | St_yield x ->
@ -193,7 +202,11 @@ module Streaming = struct
(* reading an unquoted atom *) (* reading an unquoted atom *)
let c = _next_char d in let c = _next_char d in
begin match c with begin match c with
| ' ' | '\t' | '\n' -> | '\n' ->
_newline d;
let a = _take_buffer d.atom in
_yield d St_start (Atom a)
| ' ' | '\t' ->
let a = _take_buffer d.atom in let a = _take_buffer d.atom in
_yield d St_start (Atom a) _yield d St_start (Atom a)
| ')' -> | ')' ->
@ -202,7 +215,7 @@ module Streaming = struct
| '(' -> | '(' ->
let a = _take_buffer d.atom in let a = _take_buffer d.atom in
_yield d (St_yield Open) (Atom a) _yield d (St_yield Open) (Atom a)
| '"' -> _error d "unexpected \"" | '"' -> _error d "unexpected \" (parsing atom %s)" (Buffer.contents d.atom)
| '\\' -> _error d "unexpected \\" | '\\' -> _error d "unexpected \\"
| _ -> | _ ->
Buffer.add_char d.atom c; Buffer.add_char d.atom c;
@ -234,7 +247,7 @@ module Streaming = struct
| 'r' -> '\r' | 'r' -> '\r'
| '"' -> '"' | '"' -> '"'
| '\\' -> '\\' | '\\' -> '\\'
| _ -> _error d "unexpected escaped character" | c -> _error d "unexpected escaped character %c" c
); );
_next d St_quoted _next d St_quoted