jyapayne/flitter
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add poc files

Browse source
This commit is contained in:
Joey Yakimowich-Payne 2018-05-26 10:55:38 +09:00
commit fa600b98f7
220 changed files with 45679 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

17
external/jsonwheel/.depend vendored Normal file
View file

@ -0,0 +1,17 @@
json_in.cmo : json_type.cmi json_parser.cmi json_lexer.cmo
json_in.cmx : json_type.cmx json_parser.cmx json_lexer.cmx
json_io.cmo : json_type.cmi json_parser.cmi json_lexer.cmo json_io.cmi
json_io.cmx : json_type.cmx json_parser.cmx json_lexer.cmx json_io.cmi
json_io.cmi : json_type.cmi
json_lexer.cmo : netconversion2.cmo json_type.cmi json_parser.cmi
json_lexer.cmx : netconversion2.cmx json_type.cmx json_parser.cmx
json_out.cmo : json_type.cmi
json_out.cmx : json_type.cmx
json_parser.cmo : json_type.cmi json_parser.cmi
json_parser.cmx : json_type.cmx json_parser.cmi
json_parser.cmi : json_type.cmi
json_type.cmo : json_type.cmi
json_type.cmx : json_type.cmi
json_type.cmi :
netconversion2.cmo :
netconversion2.cmx :

4
external/jsonwheel/META vendored Normal file
View file

@ -0,0 +1,4 @@
description = "jsonwheel"
requires = "unix num str bigarray"
archive(byte) = "jsonwheel.cma"
archive(native) = "jsonwheel.cmxa"

118
external/jsonwheel/Makefile vendored Normal file
View file

@ -0,0 +1,118 @@
##############################################################################
# Variables
##############################################################################
SRC= json_type.ml \
json_out.ml \
netconversion2.ml \
json_parser.ml \
json_lexer.ml \
json_in.ml \
json_io.ml
TARGET=jsonwheel
INCLUDES=
#-I +camlp4
SYSLIBS= str.cma unix.cma bigarray.cma num.cma
##############################################################################
# Generic variables
##############################################################################
#dont use -custom, it makes the bytecode unportable.
OCAMLCFLAGS= -g -dtypes $(OCAMLCFLAGS_EXTRA)
#-for-pack Sexplib
# This flag is also used in subdirectories so don't change its name here.
OPTFLAGS=
OCAMLC=ocamlc$(OPTBIN) $(OCAMLCFLAGS) $(INCLUDES) $(SYSINCLUDES) -thread
OCAMLOPT=ocamlopt$(OPTBIN) $(OPTFLAGS) $(INCLUDES) $(SYSINCLUDES) -thread
OCAMLLEX=ocamllex #-ml # -ml for debugging lexer, but slightly slower
OCAMLYACC=ocamlyacc -v
OCAMLDEP=ocamldep $(INCLUDES)
OCAMLMKTOP=ocamlmktop -g -custom $(INCLUDES) -thread
#-ccopt -static
STATIC=
##############################################################################
# Top rules
##############################################################################
OBJS = $(SRC:.ml=.cmo)
OPTOBJS = $(SRC:.ml=.cmx)
all: $(TARGET).cma
all.opt: $(TARGET).cmxa
$(TARGET).cma: $(OBJS)
$(OCAMLC) -a -o $(TARGET).cma $(OBJS)
$(TARGET).cmxa: $(OPTOBJS) $(LIBS:.cma=.cmxa)
$(OCAMLOPT) -a -o $(TARGET).cmxa $(OPTOBJS)
$(TARGET).top: $(OBJS) $(LIBS)
$(OCAMLMKTOP) -o $(TARGET).top $(SYSLIBS) $(LIBS) $(OBJS)
clean::
rm -f $(TARGET).top
#pad: we include in the git repo already the generated file
#json_lexer.ml: json_lexer.mll
# $(OCAMLLEX) $<
#dist_clean::
# rm -f json_lexer.ml
#beforedepend:: json_lexer.ml
#json_parser.ml json_parser.mli: json_parser.mly
# $(OCAMLYACC) $<
#dist_clean::
# rm -f json_parser.ml json_parser.mli json_parser.output
#beforedepend:: json_parser.ml json_parser.mli
##############################################################################
# install
##############################################################################
LIBNAME=jsonwheel
EXPORTSRC=json_io.mli json_parser.mli json_type.mli
install-findlib: $(LIBNAME).cma $(LIBNAME).cmxa
ocamlfind install $(LIBNAME) META \
$(LIBNAME).cma $(LIBNAME).cmxa $(LIBNAME).a *.cmi $(EXPORTSRC)
uninstall-findlib::
ocamlfind remove $(LIBNAME)
##############################################################################
# Generic rules
##############################################################################
.SUFFIXES: .ml .mli .cmo .cmi .cmx
.ml.cmo:
$(OCAMLC) -c $<
.mli.cmi:
$(OCAMLC) -c $<
.ml.cmx:
$(OCAMLOPT) -c $<
.ml.mldepend:
$(OCAMLC) -i $<
clean::
rm -f *.cm[ioxa] *.o *.a *.cmxa *.annot *.cmt *.cmti
clean::
rm -f *~ .*~ gmon.out #*#
beforedepend::
depend:: beforedepend
$(OCAMLDEP) *.mli *.ml > .depend
distclean::
rm -f .depend
-include .depend

26
external/jsonwheel/copyright.txt vendored Normal file
View file

@ -0,0 +1,26 @@
Copyright (c) 2006 Wink Technologies, Inc.
Copyright (c) 2006, 2009 Martin Jambon
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. 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.
3. The name of the author may not be used to endorse or promote products
derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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.

51
external/jsonwheel/json_in.ml vendored Normal file
View file

@ -0,0 +1,51 @@
type t = Json_type.t
open Json_type
let filter_result x =
Browse.assert_object_or_array x;
x
let check_channel_is_utf8 ic =
let start = pos_in ic in
let encoding =
try
let c1 = input_char ic in
let c2 = input_char ic in
let c3 = input_char ic in
let c4 = input_char ic in
Json_lexer.detect_encoding c1 c2 c3 c4
with End_of_file -> `UTF8 in
if encoding <> `UTF8 then
json_error "Only UTF-8 encoding is supported";
(try seek_in ic start
with _ -> json_error "Not a regular file")
(* from_channel and from_channel4 work
only on seekable devices (regular files) *)
let from_channel p recursive file ic =
check_channel_is_utf8 ic;
let lexbuf = Lexing.from_channel ic in
Json_lexer.set_file_name lexbuf file;
let j =
Json_parser.main
(Json_lexer.token p)
lexbuf
in
if recursive then j
else filter_result j
let load_json
?allow_comments ?allow_nan ?big_int_mode ?(recursive = false)
file =
let ic = open_in file in
let x =
let p =
Json_lexer.make_param ?allow_comments ?allow_nan ?big_int_mode () in
try `Result (from_channel p recursive file ic)
with e -> `Exn e in
close_in ic;
match x with
`Result x -> x
| `Exn e -> raise e

421
external/jsonwheel/json_io.ml vendored Normal file
View file

@ -0,0 +1,421 @@
type t = Json_type.t
open Json_type
(*** Parsing ***)
let check_string_is_utf8 s =
let encoding =
if String.length s < 4 then `UTF8
else Json_lexer.detect_encoding s.[0] s.[1] s.[2] s.[3] in
if encoding <> `UTF8 then
json_error "Only UTF-8 encoding is supported"
let filter_result x =
Browse.assert_object_or_array x;
x
let json_of_string
?allow_comments
?allow_nan
?big_int_mode
?(recursive = false)
s =
check_string_is_utf8 s;
let p = Json_lexer.make_param ?allow_comments ?allow_nan ?big_int_mode () in
let j =
Json_parser.main
(Json_lexer.token p)
(Lexing.from_string s)
in
if not recursive then filter_result j
else j
let check_channel_is_utf8 ic =
let start = pos_in ic in
let encoding =
try
let c1 = input_char ic in
let c2 = input_char ic in
let c3 = input_char ic in
let c4 = input_char ic in
Json_lexer.detect_encoding c1 c2 c3 c4
with End_of_file -> `UTF8 in
if encoding <> `UTF8 then
json_error "Only UTF-8 encoding is supported";
(try seek_in ic start
with _ -> json_error "Not a regular file")
(* from_channel and from_channel4 work
only on seekable devices (regular files) *)
let from_channel p recursive file ic =
check_channel_is_utf8 ic;
let lexbuf = Lexing.from_channel ic in
Json_lexer.set_file_name lexbuf file;
let j =
Json_parser.main
(Json_lexer.token p)
lexbuf
in
if recursive then j
else filter_result j
let load_json
?allow_comments ?allow_nan ?big_int_mode ?(recursive = false)
file =
let ic = open_in file in
let x =
let p =
Json_lexer.make_param ?allow_comments ?allow_nan ?big_int_mode () in
try `Result (from_channel p recursive file ic)
with e -> `Exn e in
close_in ic;
match x with
`Result x -> x
| `Exn e -> raise e
(*** Printing ***)
(* JSON does not allow rendering floats with a trailing dot: that is,
1234. is not allowed, but 1234.0 is ok. here, we add a '0' if
string_of_int result in a trailing dot *)
let fprint_float allow_nan fmt f =
match classify_float f with
FP_nan ->
if allow_nan then Format.fprintf fmt "NaN"
else json_error "Not allowed to serialize NaN value"
| FP_infinite ->
if allow_nan then
if f < 0. then Format.fprintf fmt "-Infinity"
else Format.fprintf fmt "Infinity"
else json_error "Not allowed to serialize infinite value"
| FP_zero
| FP_normal
| FP_subnormal ->
let s = string_of_float f in
Format.fprintf fmt "%s" s;
let s_len = String.length s in
if s.[ s_len - 1 ] = '.' then
Format.fprintf fmt "0"
let escape_json_string buf s =
for i = 0 to String.length s - 1 do
let c = String.unsafe_get s i in
match c with
| '"' -> Buffer.add_string buf "\\\""
| '\t' -> Buffer.add_string buf "\\t"
| '\r' -> Buffer.add_string buf "\\r"
| '\b' -> Buffer.add_string buf "\\b"
| '\n' -> Buffer.add_string buf "\\n"
| '\012' -> Buffer.add_string buf "\\f"
| '\\' -> Buffer.add_string buf "\\\\"
(* | '/' -> "\\/" *) (* Forward slash can be escaped
but doesn't have to *)
| '\x00'..'\x1F' (* Control characters that must be escaped *)
| '\x7F' (* DEL *) ->
Printf.bprintf buf "\\u%04X" (int_of_char c)
| _ ->
(* Don't bother detecting or escaping multibyte chars *)
Buffer.add_char buf c
done
let fquote_json_string fmt s =
let buf = Buffer.create (String.length s) in
escape_json_string buf s;
Format.fprintf fmt "\"%s\"" (Buffer.contents buf)
let bquote_json_string buf s =
Printf.bprintf buf "\"%a\"" escape_json_string s
module Compact =
struct
open Format
let rec fprint_json allow_nan fmt = function
Object o ->
pp_print_string fmt "{";
fprint_object allow_nan fmt o;
pp_print_string fmt "}"
| Array a ->
pp_print_string fmt "[";
fprint_list allow_nan fmt a;
pp_print_string fmt "]"
| Bool b ->
pp_print_string fmt (if b then "true" else "false")
| Null ->
pp_print_string fmt "null"
| Int i -> pp_print_string fmt (string_of_int i)
| Float f -> pp_print_string fmt (string_of_json_float allow_nan f)
| String s -> fquote_json_string fmt s
and fprint_list allow_nan fmt = function
[] -> ()
| [x] -> fprint_json allow_nan fmt x
| x :: tl ->
fprint_json allow_nan fmt x;
pp_print_string fmt ",";
fprint_list allow_nan fmt tl
and fprint_object allow_nan fmt = function
[] -> ()
| [x] -> fprint_pair allow_nan fmt x
| x :: tl ->
fprint_pair allow_nan fmt x;
pp_print_string fmt ",";
fprint_object allow_nan fmt tl
and fprint_pair allow_nan fmt (key, x) =
fquote_json_string fmt key;
fprintf fmt ":";
fprint_json allow_nan fmt x
(* json does not allow rendering floats with a trailing dot: that is,
1234. is not allowed, but 1234.0 is ok. here, we add a '0' if
string_of_int result in a trailing dot *)
and string_of_json_float allow_nan f =
let s = string_of_float f in
let s_len = String.length s in
if s.[ s_len - 1 ] = '.' then
s ^ "0"
else
s
let print ?(allow_nan = false) ?(recursive = false) fmt x =
if not recursive then
Browse.assert_object_or_array x;
fprint_json allow_nan fmt x
end
module Fast =
struct
open Printf
open Buffer
(* Contiguous sequence of non-escaped characters are copied to the buffer
using one call to Buffer.add_substring *)
let rec buf_add_json_escstr1 buf s k1 l =
if k1 < l then (
let k2 = buf_add_json_escstr2 buf s k1 k1 l in
if k2 > k1 then
Buffer.add_substring buf s k1 (k2 - k1);
if k2 < l then (
let c = String.unsafe_get s k2 in
( match c with
| '"' -> Buffer.add_string buf "\\\""
| '\t' -> Buffer.add_string buf "\\t"
| '\r' -> Buffer.add_string buf "\\r"
| '\b' -> Buffer.add_string buf "\\b"
| '\n' -> Buffer.add_string buf "\\n"
| '\012' -> Buffer.add_string buf "\\f"
| '\\' -> Buffer.add_string buf "\\\\"
(* | '/' -> "\\/" *) (* Forward slash can be escaped
but doesn't have to *)
| '\x00'..'\x1F' (* Control characters that must be escaped *)
| '\x7F' (* DEL *) ->
Printf.bprintf buf "\\u%04X" (int_of_char c)
| _ -> assert false
);
buf_add_json_escstr1 buf s (k2+1) l
)
)
and buf_add_json_escstr2 buf s k1 k2 l =
if k2 < l then (
let c = String.unsafe_get s k2 in
match c with
| '"' | '\t' | '\r' | '\b' | '\n' | '\012' | '\\' (*| '/'*)
| '\x00'..'\x1F' | '\x7F' -> k2
| _ -> buf_add_json_escstr2 buf s k1 (k2+1) l
)
else
l
and bquote_json_string buf s =
Buffer.add_char buf '"';
buf_add_json_escstr1 buf s 0 (String.length s);
Buffer.add_char buf '"'
let rec bprint_json allow_nan buf = function
Object o ->
add_string buf "{";
bprint_object allow_nan buf o;
add_string buf "}"
| Array a ->
add_string buf "[";
bprint_list allow_nan buf a;
add_string buf "]"
| Bool b ->
add_string buf (if b then "true" else "false")
| Null ->
add_string buf "null"
| Int i -> add_string buf (string_of_int i)
| Float f -> add_string buf (string_of_json_float allow_nan f)
| String s -> bquote_json_string buf s
and bprint_list allow_nan buf = function
[] -> ()
| [x] -> bprint_json allow_nan buf x
| x :: tl ->
bprint_json allow_nan buf x;
add_string buf ",";
bprint_list allow_nan buf tl
and bprint_object allow_nan buf = function
[] -> ()
| [x] -> bprint_pair allow_nan buf x
| x :: tl ->
bprint_pair allow_nan buf x;
add_string buf ",";
bprint_object allow_nan buf tl
and bprint_pair allow_nan buf (key, x) =
bquote_json_string buf key;
bprintf buf ":";
bprint_json allow_nan buf x
(* json does not allow rendering floats with a trailing dot: that is,
1234. is not allowed, but 1234.0 is ok. here, we add a '0' if
string_of_int result in a trailing dot *)
and string_of_json_float allow_nan f =
match classify_float f with
FP_nan ->
if allow_nan then "NaN"
else json_error "Not allowed to serialize NaN value"
| FP_infinite ->
if allow_nan then
if f < 0. then "-Infinity"
else "Infinity"
else json_error "Not allowed to serialize infinite value"
| FP_zero
| FP_normal
| FP_subnormal ->
let s = string_of_float f in
let s_len = String.length s in
if s.[ s_len - 1 ] = '.' then
s ^ "0"
else
s
let print ?(allow_nan = false) ?(recursive = false) buf x =
if not recursive then
Browse.assert_object_or_array x;
bprint_json allow_nan buf x
end
(*** Pretty printing ***)
module Pretty =
struct
open Format
(* Printing anything but a value in a key:value pair.
Opening and closing brackets in such arrays and objects
are aligned vertically if they are not on the same line.
*)
let rec fprint_json allow_nan fmt = function
Object l -> fprint_object allow_nan fmt l
| Array l -> fprint_array allow_nan fmt l
| Bool b -> fprintf fmt "%s" (if b then "true" else "false")
| Null -> fprintf fmt "null"
| Int i -> fprintf fmt "%i" i
| Float f -> fprint_float allow_nan fmt f
| String s -> fquote_json_string fmt s
(* Printing an array which is not the value in a key:value pair *)
and fprint_array allow_nan fmt = function
[] -> fprintf fmt "[]"
| x :: tl ->
fprintf fmt "@[<hv 2>[@ ";
fprint_json allow_nan fmt x;
List.iter (fun x ->
fprintf fmt ",@ ";
fprint_json allow_nan fmt x) tl;
fprintf fmt "@;<1 -2>]@]"
(* Printing an object which is not the value in a key:value pair *)
and fprint_object allow_nan fmt = function
[] -> fprintf fmt "{}"
| x :: tl ->
fprintf fmt "@[<hv 2>{@ ";
fprint_pair allow_nan fmt x;
List.iter (fun x ->
fprintf fmt ",@ ";
fprint_pair allow_nan fmt x) tl;
fprintf fmt "@;<1 -2>}@]"
(* Printing a key:value pair.
The opening bracket stays on the same line as the key, no matter what,
and the closing bracket is either on the same line
or vertically aligned with the beginning of the key.
*)
and fprint_pair allow_nan fmt (key, x) =
match x with
Object l ->
(match l with
[] -> fprintf fmt "%a: {}" fquote_json_string key
| x :: tl ->
fprintf fmt "@[<hv 2>%a: {@ " fquote_json_string key;
fprint_pair allow_nan fmt x;
List.iter (fun x ->
fprintf fmt ",@ ";
fprint_pair allow_nan fmt x) tl;
fprintf fmt "@;<1 -2>}@]")
| Array l ->
(match l with
[] -> fprintf fmt "%a: []" fquote_json_string key
| x :: tl ->
fprintf fmt "@[<hv 2>%a: [@ " fquote_json_string key;
fprint_json allow_nan fmt x;
List.iter (fun x ->
fprintf fmt ",@ ";
fprint_json allow_nan fmt x) tl;
fprintf fmt "@;<1 -2>]@]")
| _ ->
(* An atom, perhaps a long string that would go to the next line *)
fprintf fmt "@[%a:@;<1 2>%a@]"
fquote_json_string key (fprint_json allow_nan) x
let print ?(allow_nan = false) ?(recursive = false) fmt x =
if not recursive then
Browse.assert_object_or_array x;
fprint_json allow_nan fmt x
end
let string_of_json ?allow_nan ?(compact = false) ?recursive x =
let buf = Buffer.create 2000 in
if compact then
Fast.print ?allow_nan ?recursive buf x
else
(let fmt = Format.formatter_of_buffer buf in
(match recursive with
None
| Some false -> Browse.assert_object_or_array x
| Some true -> ()
);
let allow_nan = match allow_nan with None -> false | Some b -> b in
Pretty.fprint_json allow_nan fmt x;
Format.pp_print_flush fmt ());
Buffer.contents buf
let save_json ?allow_nan ?(compact = false) ?recursive file x =
let oc = open_out file in
let print =
if compact then Compact.print
else Pretty.print in
let fmt = Format.formatter_of_out_channel oc in
try
print ?allow_nan ?recursive fmt x;
Format.pp_print_flush fmt ();
close_out oc
with e ->
close_out_noerr oc;
raise e

111
external/jsonwheel/json_io.mli vendored Normal file
View file

@ -0,0 +1,111 @@
(** Input and output functions for the JSON format
as defined by {{:http://www.json.org/}http://www.json.org/} *)
(** [json_of_string s] reads the given JSON string.
If [allow_comments] is [true], then C++ style comments are allowed, i.e.
[/* blabla possibly on several lines */] or
[// blabla until the end of the line]. Comments are not part of the JSON
specification and are disabled by default.
If [allow_nan] is [true], then OCaml [nan], [infinity] and [neg_infinity]
float values are represented using their Javascript counterparts
[NaN], [Infinity] and [-Infinity].
If [big_int_mode] is [true], then JSON ints that cannot be represented
using OCaml's int type are represented by strings.
This would happen only for ints that are out of the range defined
by [min_int] and [max_int], i.e. \[-1G, +1G\[ on a 32-bit platform.
The default is [false] and a [Json_type.Json_error] exception
is raised if an int is too big.
If [recursive] is true, then all JSON values are accepted rather
than just arrays and objects as specified by the standard.
The default is [false].
*)
val json_of_string :
?allow_comments:bool ->
?allow_nan:bool ->
?big_int_mode:bool ->
?recursive:bool ->
string -> Json_type.t
(** Same as [Json_io.json_of_string] but the argument is a file
to read from. *)
val load_json :
?allow_comments:bool ->
?allow_nan:bool ->
?big_int_mode:bool ->
?recursive:bool ->
string -> Json_type.t
(** Conversion of JSON data to compact text. *)
module Compact :
sig
(** Generic printing function without superfluous space.
See the standard [Format] module
for how to create and use formatters.
In general, {!Json_io.string_of_json} and
{!Json_io.save_json} are more convenient.
*)
val print :
?allow_nan: bool ->
?recursive:bool ->
Format.formatter -> Json_type.t -> unit
end
(** Conversion of JSON data to compact text, optimized for speed. *)
module Fast :
sig
(** This function is faster than the one provided by the
{!Json_io.Compact} submodule but it is less generic and is subject to
the 16MB size limit of strings on 32-bit architectures. *)
val print :
?allow_nan: bool ->
?recursive:bool ->
Buffer.t -> Json_type.t -> unit
end
(** Conversion of JSON data to indented text. *)
module Pretty :
sig
(** Generic pretty-printing function.
See the standard [Format] module
for how to create and use formatters.
In general, {!Json_io.string_of_json} and
{!Json_io.save_json} are more convenient.
*)
val print :
?allow_nan: bool ->
?recursive:bool ->
Format.formatter -> Json_type.t -> unit
end
(** [string_of_json] converts JSON data to a string.
By default, the output is indented. If the [compact] flag is set to true,
the output will not contain superfluous whitespace and will
be produced faster.
If [allow_nan] is [true], then OCaml [nan], [infinity] and [neg_infinity]
float values are represented using their Javascript counterparts
[NaN], [Infinity] and [-Infinity].
*)
val string_of_json :
?allow_nan: bool ->
?compact:bool ->
?recursive:bool ->
Json_type.t -> string
(** [save_json] works like {!Json_io.string_of_json} but
saves the results directly into the file specified by the
argument of type string. *)
val save_json :
?allow_nan:bool ->
?compact:bool ->
?recursive:bool ->
string -> Json_type.t -> unit

542
external/jsonwheel/json_lexer.ml vendored Normal file
View file

@ -0,0 +1,542 @@
# 1 "json_lexer.mll"
open Printf
open Lexing
open Json_type
open Json_parser
let loc lexbuf = (lexbuf.lex_start_p, lexbuf.lex_curr_p)
(* Detection of the encoding from the 4 first characters of the data *)
let detect_encoding c1 c2 c3 c4 =
match c1, c2, c3, c4 with
'\000', '\000', '\000', _ -> `UTF32BE
| '\000', _, '\000', _ -> `UTF16BE
| _, '\000', '\000', '\000' -> `UTF32LE
| _, '\000', _, '\000' -> `UTF16LE
| _ -> `UTF8
let hexval c =
match c with
'0'..'9' -> int_of_char c - int_of_char '0'
| 'a'..'f' -> int_of_char c - int_of_char 'a' + 10
| 'A'..'F' -> int_of_char c - int_of_char 'A' + 10
| _ -> assert false
let make_int big_int_mode s =
try INT (int_of_string s)
with _ ->
if big_int_mode then STRING s
else json_error (s ^ " is too large for OCaml's type int, sorry")
let utf8_of_point i =
Netconversion2.ustring_of_uchar `Enc_utf8 i
let custom_error descr lexbuf =
json_error
(sprintf "%s:\n%s"
(string_of_loc (loc lexbuf))
descr)
let lexer_error descr lexbuf =
custom_error
(sprintf "%s '%s'" descr (Lexing.lexeme lexbuf))
lexbuf
let set_file_name lexbuf name =
lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = name }
let newline lexbuf =
let pos = lexbuf.lex_curr_p in
lexbuf.lex_curr_p <- { pos with
pos_lnum = pos.pos_lnum + 1;
pos_bol = pos.pos_cnum }
type param = {
allow_comments : bool;
big_int_mode : bool;
allow_nan : bool
}
# 63 "json_lexer.ml"
let __ocaml_lex_tables = {
Lexing.lex_base =
"\000\000\235\255\236\255\003\000\238\255\000\000\031\000\241\255\
\085\000\001\000\000\000\000\000\001\000\000\000\248\255\249\255\
\250\255\251\255\252\255\253\255\017\000\254\255\001\000\001\000\
\002\000\247\255\000\000\000\000\003\000\246\255\001\000\004\000\
\245\255\011\000\244\255\003\000\001\000\003\000\002\000\003\000\
\000\000\243\255\010\000\020\000\019\000\016\000\022\000\012\000\
\008\000\242\255\100\000\111\000\121\000\143\000\153\000\163\000\
\175\000\185\000\002\001\251\255\252\255\037\001\254\255\255\255\
\035\001\248\255\056\001\250\255\251\255\252\255\253\255\254\255\
\255\255\111\001\134\001\172\001\249\255\089\000\252\255\253\255\
\254\255\013\000\255\255";
Lexing.lex_backtrk =
"\255\255\255\255\255\255\018\000\255\255\015\000\015\000\255\255\
\020\000\020\000\020\000\020\000\020\000\020\000\255\255\255\255\
\255\255\255\255\255\255\255\255\020\000\255\255\000\000\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\016\000\255\255\016\000\255\255\
\016\000\255\255\255\255\255\255\255\255\002\000\255\255\255\255\
\255\255\255\255\007\000\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\003\000\255\255";
Lexing.lex_default =
"\001\000\000\000\000\000\255\255\000\000\255\255\255\255\000\000\
\255\255\255\255\255\255\255\255\255\255\255\255\000\000\000\000\
\000\000\000\000\000\000\000\000\255\255\000\000\022\000\255\255\
\255\255\000\000\255\255\255\255\255\255\000\000\255\255\255\255\
\000\000\255\255\000\000\255\255\255\255\255\255\255\255\255\255\
\255\255\000\000\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\000\000\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\061\000\000\000\000\000\061\000\000\000\000\000\
\065\000\000\000\255\255\000\000\000\000\000\000\000\000\000\000\
\000\000\255\255\255\255\255\255\000\000\078\000\000\000\000\000\
\000\000\255\255\000\000";
Lexing.lex_trans =
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\003\000\004\000\255\255\003\000\003\000\000\000\000\000\
\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\003\000\000\000\007\000\003\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\015\000\008\000\051\000\020\000\
\005\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\
\006\000\006\000\014\000\021\000\082\000\000\000\000\000\000\000\
\022\000\000\000\000\000\000\000\000\000\050\000\000\000\000\000\
\000\000\009\000\000\000\000\000\000\000\051\000\010\000\006\000\
\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\
\006\000\034\000\000\000\017\000\000\000\016\000\000\000\000\000\
\000\000\033\000\026\000\079\000\050\000\050\000\012\000\025\000\
\029\000\036\000\037\000\039\000\027\000\031\000\011\000\035\000\
\032\000\038\000\023\000\028\000\013\000\030\000\024\000\040\000\
\043\000\041\000\044\000\019\000\045\000\018\000\046\000\047\000\
\048\000\049\000\000\000\081\000\050\000\005\000\006\000\006\000\
\006\000\006\000\006\000\006\000\006\000\006\000\006\000\057\000\
\000\000\057\000\000\000\000\000\056\000\056\000\056\000\056\000\
\056\000\056\000\056\000\056\000\056\000\056\000\042\000\052\000\
\052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\
\052\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\
\052\000\052\000\052\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\055\000\000\000\055\000\000\000\053\000\054\000\
\054\000\054\000\054\000\054\000\054\000\054\000\054\000\054\000\
\054\000\054\000\054\000\054\000\054\000\054\000\054\000\054\000\
\054\000\054\000\054\000\054\000\054\000\054\000\054\000\054\000\
\054\000\054\000\054\000\054\000\054\000\000\000\053\000\056\000\
\056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\
\056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\
\056\000\056\000\056\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\002\000\255\255\060\000\060\000\060\000\060\000\060\000\060\000\
\060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\
\060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\
\060\000\060\000\060\000\060\000\060\000\060\000\060\000\060\000\
\060\000\060\000\000\000\000\000\063\000\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\072\000\000\000\255\255\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\072\000\000\000\000\000\000\000\000\000\000\000\
\000\000\080\000\000\000\000\000\000\000\000\000\062\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\073\000\073\000\073\000\073\000\073\000\073\000\073\000\073\000\
\073\000\073\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\073\000\073\000\073\000\073\000\073\000\073\000\072\000\
\000\000\255\255\000\000\000\000\000\000\071\000\000\000\000\000\
\000\000\070\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\069\000\000\000\000\000\000\000\068\000\000\000\067\000\
\066\000\073\000\073\000\073\000\073\000\073\000\073\000\074\000\
\074\000\074\000\074\000\074\000\074\000\074\000\074\000\074\000\
\074\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\074\000\074\000\074\000\074\000\074\000\074\000\075\000\075\000\
\075\000\075\000\075\000\075\000\075\000\075\000\075\000\075\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\075\000\
\075\000\075\000\075\000\075\000\075\000\000\000\000\000\000\000\
\074\000\074\000\074\000\074\000\074\000\074\000\000\000\000\000\
\000\000\000\000\000\000\000\000\076\000\076\000\076\000\076\000\
\076\000\076\000\076\000\076\000\076\000\076\000\000\000\075\000\
\075\000\075\000\075\000\075\000\075\000\076\000\076\000\076\000\
\076\000\076\000\076\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\059\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\076\000\076\000\076\000\
\076\000\076\000\076\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\255\255\000\000\255\255\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000";
Lexing.lex_check =
"\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\000\000\000\000\022\000\003\000\000\000\255\255\255\255\
\003\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\000\000\255\255\000\000\003\000\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\000\000\000\000\005\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\020\000\081\000\255\255\255\255\255\255\
\020\000\255\255\255\255\255\255\255\255\005\000\255\255\255\255\
\255\255\000\000\255\255\255\255\255\255\006\000\000\000\006\000\
\006\000\006\000\006\000\006\000\006\000\006\000\006\000\006\000\
\006\000\033\000\255\255\000\000\255\255\000\000\255\255\255\255\
\255\255\010\000\012\000\077\000\006\000\005\000\000\000\024\000\
\028\000\035\000\036\000\038\000\026\000\030\000\000\000\009\000\
\031\000\037\000\013\000\027\000\000\000\011\000\023\000\039\000\
\042\000\040\000\043\000\000\000\044\000\000\000\045\000\046\000\
\047\000\048\000\255\255\077\000\006\000\008\000\008\000\008\000\
\008\000\008\000\008\000\008\000\008\000\008\000\008\000\050\000\
\255\255\050\000\255\255\255\255\050\000\050\000\050\000\050\000\
\050\000\050\000\050\000\050\000\050\000\050\000\008\000\051\000\
\051\000\051\000\051\000\051\000\051\000\051\000\051\000\051\000\
\051\000\052\000\052\000\052\000\052\000\052\000\052\000\052\000\
\052\000\052\000\052\000\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\053\000\255\255\053\000\255\255\052\000\053\000\
\053\000\053\000\053\000\053\000\053\000\053\000\053\000\053\000\
\053\000\054\000\054\000\054\000\054\000\054\000\054\000\054\000\
\054\000\054\000\054\000\055\000\055\000\055\000\055\000\055\000\
\055\000\055\000\055\000\055\000\055\000\255\255\052\000\056\000\
\056\000\056\000\056\000\056\000\056\000\056\000\056\000\056\000\
\056\000\057\000\057\000\057\000\057\000\057\000\057\000\057\000\
\057\000\057\000\057\000\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\000\000\022\000\058\000\058\000\058\000\058\000\058\000\058\000\
\058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\
\058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\
\058\000\058\000\058\000\058\000\058\000\058\000\058\000\058\000\
\058\000\058\000\255\255\255\255\058\000\061\000\061\000\061\000\
\061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\
\061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\
\061\000\061\000\061\000\061\000\061\000\061\000\061\000\061\000\
\061\000\061\000\061\000\061\000\061\000\064\000\255\255\061\000\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\064\000\255\255\255\255\255\255\255\255\255\255\
\255\255\077\000\255\255\255\255\255\255\255\255\058\000\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\066\000\066\000\066\000\066\000\066\000\066\000\066\000\066\000\
\066\000\066\000\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\066\000\066\000\066\000\066\000\066\000\066\000\064\000\
\255\255\061\000\255\255\255\255\255\255\064\000\255\255\255\255\
\255\255\064\000\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\064\000\255\255\255\255\255\255\064\000\255\255\064\000\
\064\000\066\000\066\000\066\000\066\000\066\000\066\000\073\000\
\073\000\073\000\073\000\073\000\073\000\073\000\073\000\073\000\
\073\000\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\073\000\073\000\073\000\073\000\073\000\073\000\074\000\074\000\
\074\000\074\000\074\000\074\000\074\000\074\000\074\000\074\000\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\074\000\
\074\000\074\000\074\000\074\000\074\000\255\255\255\255\255\255\
\073\000\073\000\073\000\073\000\073\000\073\000\255\255\255\255\
\255\255\255\255\255\255\255\255\075\000\075\000\075\000\075\000\
\075\000\075\000\075\000\075\000\075\000\075\000\255\255\074\000\
\074\000\074\000\074\000\074\000\074\000\075\000\075\000\075\000\
\075\000\075\000\075\000\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\058\000\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\075\000\075\000\075\000\
\075\000\075\000\075\000\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\064\000\255\255\061\000\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255";
Lexing.lex_base_code =
"";
Lexing.lex_backtrk_code =
"";
Lexing.lex_default_code =
"";
Lexing.lex_trans_code =
"";
Lexing.lex_check_code =
"";
Lexing.lex_code =
"";
}
let rec token p lexbuf =
__ocaml_lex_token_rec p lexbuf 0
and __ocaml_lex_token_rec p lexbuf __ocaml_lex_state =
match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
| 0 ->
# 79 "json_lexer.mll"
( if p.allow_comments then
token p lexbuf
else lexer_error "Comments are not allowed: " lexbuf )
# 298 "json_lexer.ml"
| 1 ->
# 82 "json_lexer.mll"
( if p.allow_comments then
(comment lexbuf;
token p lexbuf)
else lexer_error "Comments are not allowed: " lexbuf )
# 306 "json_lexer.ml"
| 2 ->
# 86 "json_lexer.mll"
( OBJSTART )
# 311 "json_lexer.ml"
| 3 ->
# 87 "json_lexer.mll"
( OBJEND )
# 316 "json_lexer.ml"
| 4 ->
# 88 "json_lexer.mll"
( ARSTART )
# 321 "json_lexer.ml"
| 5 ->
# 89 "json_lexer.mll"
( AREND )
# 326 "json_lexer.ml"
| 6 ->
# 90 "json_lexer.mll"
( COMMA )
# 331 "json_lexer.ml"
| 7 ->
# 91 "json_lexer.mll"
( COLON )
# 336 "json_lexer.ml"
| 8 ->
# 92 "json_lexer.mll"
( BOOL true )
# 341 "json_lexer.ml"
| 9 ->
# 93 "json_lexer.mll"
( BOOL false )
# 346 "json_lexer.ml"
| 10 ->
# 94 "json_lexer.mll"
( NULL )
# 351 "json_lexer.ml"
| 11 ->
# 95 "json_lexer.mll"
( if p.allow_nan then FLOAT nan
else lexer_error "NaN values are not allowed: " lexbuf )
# 357 "json_lexer.ml"
| 12 ->
# 97 "json_lexer.mll"
( if p.allow_nan then FLOAT infinity
else lexer_error "Infinite values are not allowed: " lexbuf )
# 363 "json_lexer.ml"
| 13 ->
# 99 "json_lexer.mll"
( if p.allow_nan then FLOAT neg_infinity
else lexer_error "Infinite values are not allowed: " lexbuf )
# 369 "json_lexer.ml"
| 14 ->
# 101 "json_lexer.mll"
( STRING (string [] lexbuf) )
# 374 "json_lexer.ml"
| 15 ->
# 102 "json_lexer.mll"
( make_int p.big_int_mode (lexeme lexbuf) )
# 379 "json_lexer.ml"
| 16 ->
# 103 "json_lexer.mll"
( FLOAT (float_of_string (lexeme lexbuf)) )
# 384 "json_lexer.ml"
| 17 ->
# 104 "json_lexer.mll"
( newline lexbuf; token p lexbuf )
# 389 "json_lexer.ml"
| 18 ->
# 105 "json_lexer.mll"
( token p lexbuf )
# 394 "json_lexer.ml"
| 19 ->
# 106 "json_lexer.mll"
( EOF )
# 399 "json_lexer.ml"
| 20 ->
# 107 "json_lexer.mll"
( lexer_error "Invalid token" lexbuf )
# 404 "json_lexer.ml"
| __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_token_rec p lexbuf __ocaml_lex_state
and string l lexbuf =
__ocaml_lex_string_rec l lexbuf 58
and __ocaml_lex_string_rec l lexbuf __ocaml_lex_state =
match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
| 0 ->
# 111 "json_lexer.mll"
( String.concat "" (List.rev l) )
# 415 "json_lexer.ml"
| 1 ->
# 112 "json_lexer.mll"
( let s = escaped_char lexbuf in
string (s :: l) lexbuf )
# 421 "json_lexer.ml"
| 2 ->
# 114 "json_lexer.mll"
( let s = lexeme lexbuf in
string (s :: l) lexbuf )
# 427 "json_lexer.ml"
| 3 ->
let
# 116 "json_lexer.mll"
c
# 433 "json_lexer.ml"
= Lexing.sub_lexeme_char lexbuf lexbuf.Lexing.lex_start_pos in
# 116 "json_lexer.mll"
( custom_error
(sprintf "Unescaped control character \\u%04X or \
unterminated string" (int_of_char c))
lexbuf )
# 440 "json_lexer.ml"
| 4 ->
# 120 "json_lexer.mll"
( custom_error "Unterminated string" lexbuf )
# 445 "json_lexer.ml"
| __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_string_rec l lexbuf __ocaml_lex_state
and escaped_char lexbuf =
__ocaml_lex_escaped_char_rec lexbuf 64
and __ocaml_lex_escaped_char_rec lexbuf __ocaml_lex_state =
match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
| 0 ->
# 126 "json_lexer.mll"
( lexeme lexbuf )
# 456 "json_lexer.ml"
| 1 ->
# 127 "json_lexer.mll"
( "\b" )
# 461 "json_lexer.ml"
| 2 ->
# 128 "json_lexer.mll"
( "\012" )
# 466 "json_lexer.ml"
| 3 ->
# 129 "json_lexer.mll"
( "\n" )
# 471 "json_lexer.ml"
| 4 ->
# 130 "json_lexer.mll"
( "\r" )
# 476 "json_lexer.ml"
| 5 ->
# 131 "json_lexer.mll"
( "\t" )
# 481 "json_lexer.ml"
| 6 ->
let
# 132 "json_lexer.mll"
x
# 487 "json_lexer.ml"
= Lexing.sub_lexeme lexbuf (lexbuf.Lexing.lex_start_pos + 1) (lexbuf.Lexing.lex_start_pos + 5) in
# 132 "json_lexer.mll"
( let i = 0x1000 * hexval x.[0] +
0x100 * hexval x.[1] +
0x10 * hexval x.[2] +
hexval x.[3] in
utf8_of_point i )
# 495 "json_lexer.ml"
| 7 ->
# 137 "json_lexer.mll"
( lexer_error "Invalid escape sequence" lexbuf )
# 500 "json_lexer.ml"
| __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_escaped_char_rec lexbuf __ocaml_lex_state
and comment lexbuf =
__ocaml_lex_comment_rec lexbuf 77
and __ocaml_lex_comment_rec lexbuf __ocaml_lex_state =
match Lexing.engine __ocaml_lex_tables __ocaml_lex_state lexbuf with
| 0 ->
# 140 "json_lexer.mll"
( () )
# 511 "json_lexer.ml"
| 1 ->
# 141 "json_lexer.mll"
( lexer_error "Unterminated comment" lexbuf )
# 516 "json_lexer.ml"
| 2 ->
# 142 "json_lexer.mll"
( newline lexbuf; comment lexbuf )
# 521 "json_lexer.ml"
| 3 ->
# 143 "json_lexer.mll"
( comment lexbuf )
# 526 "json_lexer.ml"
| __ocaml_lex_state -> lexbuf.Lexing.refill_buff lexbuf; __ocaml_lex_comment_rec lexbuf __ocaml_lex_state
;;
# 145 "json_lexer.mll"
let make_param
?(allow_comments = false)
?(allow_nan = false)
?(big_int_mode = false)
() =
{ allow_comments = allow_comments;
big_int_mode = big_int_mode;
allow_nan = allow_nan }
# 543 "json_lexer.ml"

163
external/jsonwheel/json_out.ml vendored Normal file
View file

@ -0,0 +1,163 @@
type t = Json_type.t
open Json_type
(* pad: copy paste of printing and pretty printing section of json_io.ml *)
(*** Printing ***)
(* JSON does not allow rendering floats with a trailing dot: that is,
1234. is not allowed, but 1234.0 is ok. here, we add a '0' if
string_of_int result in a trailing dot *)
let fprint_float allow_nan fmt f =
match classify_float f with
FP_nan ->
if allow_nan then Format.fprintf fmt "NaN"
else json_error "Not allowed to serialize NaN value"
| FP_infinite ->
if allow_nan then
if f < 0. then Format.fprintf fmt "-Infinity"
else Format.fprintf fmt "Infinity"
else json_error "Not allowed to serialize infinite value"
| FP_zero
| FP_normal
| FP_subnormal ->
let s = string_of_float f in
Format.fprintf fmt "%s" s;
let s_len = String.length s in
if s.[ s_len - 1 ] = '.' then
Format.fprintf fmt "0"
let escape_json_string buf s =
for i = 0 to String.length s - 1 do
let c = String.unsafe_get s i in
match c with
| '"' -> Buffer.add_string buf "\\\""
| '\t' -> Buffer.add_string buf "\\t"
| '\r' -> Buffer.add_string buf "\\r"
| '\b' -> Buffer.add_string buf "\\b"
| '\n' -> Buffer.add_string buf "\\n"
| '\012' -> Buffer.add_string buf "\\f"
| '\\' -> Buffer.add_string buf "\\\\"
(* | '/' -> "\\/" *) (* Forward slash can be escaped
but doesn't have to *)
| '\x00'..'\x1F' (* Control characters that must be escaped *)
| '\x7F' (* DEL *) ->
Printf.bprintf buf "\\u%04X" (int_of_char c)
| _ ->
(* Don't bother detecting or escaping multibyte chars *)
Buffer.add_char buf c
done
let fquote_json_string fmt s =
let buf = Buffer.create (String.length s) in
escape_json_string buf s;
Format.fprintf fmt "\"%s\"" (Buffer.contents buf)
let bquote_json_string buf s =
Printf.bprintf buf "\"%a\"" escape_json_string s
(*** Pretty printing ***)
module Pretty =
struct
open Format
(* Printing anything but a value in a key:value pair.
Opening and closing brackets in such arrays and objects
are aligned vertically if they are not on the same line.
*)
let rec fprint_json allow_nan fmt = function
Object l -> fprint_object allow_nan fmt l
| Array l -> fprint_array allow_nan fmt l
| Bool b -> fprintf fmt "%s" (if b then "true" else "false")
| Null -> fprintf fmt "null"
| Int i -> fprintf fmt "%i" i
| Float f -> fprint_float allow_nan fmt f
| String s -> fquote_json_string fmt s
(* Printing an array which is not the value in a key:value pair *)
and fprint_array allow_nan fmt = function
[] -> fprintf fmt "[]"
| x :: tl ->
fprintf fmt "@[<hv 2>[@ ";
fprint_json allow_nan fmt x;
List.iter (fun x ->
fprintf fmt ",@ ";
fprint_json allow_nan fmt x) tl;
fprintf fmt "@;<1 -2>]@]"
(* Printing an object which is not the value in a key:value pair *)
and fprint_object allow_nan fmt = function
[] -> fprintf fmt "{}"
| x :: tl ->
fprintf fmt "@[<hv 2>{@ ";
fprint_pair allow_nan fmt x;
List.iter (fun x ->
fprintf fmt ",@ ";
fprint_pair allow_nan fmt x) tl;
fprintf fmt "@;<1 -2>}@]"
(* Printing a key:value pair.
The opening bracket stays on the same line as the key, no matter what,
and the closing bracket is either on the same line
or vertically aligned with the beginning of the key.
*)
and fprint_pair allow_nan fmt (key, x) =
match x with
Object l ->
(match l with
[] -> fprintf fmt "%a: {}" fquote_json_string key
| x :: tl ->
fprintf fmt "@[<hv 2>%a: {@ " fquote_json_string key;
fprint_pair allow_nan fmt x;
List.iter (fun x ->
fprintf fmt ",@ ";
fprint_pair allow_nan fmt x) tl;
fprintf fmt "@;<1 -2>}@]")
| Array l ->
(match l with
[] -> fprintf fmt "%a: []" fquote_json_string key
| x :: tl ->
fprintf fmt "@[<hv 2>%a: [@ " fquote_json_string key;
fprint_json allow_nan fmt x;
List.iter (fun x ->
fprintf fmt ",@ ";
fprint_json allow_nan fmt x) tl;
fprintf fmt "@;<1 -2>]@]")
| _ ->
(* An atom, perhaps a long string that would go to the next line *)
fprintf fmt "@[%a:@;<1 2>%a@]"
fquote_json_string key (fprint_json allow_nan) x
let print ?(allow_nan = false) ?(recursive = false) fmt x =
if not recursive then
Browse.assert_object_or_array x;
fprint_json allow_nan fmt x
end
let string_of_json ?allow_nan (*?(compact = false) ?recursive *) x =
let buf = Buffer.create 2000 in
(*
if compact then
Fast.print ?allow_nan ?recursive buf x
else
(let fmt = Format.formatter_of_buffer buf in
(match recursive with
None
| Some false -> Browse.assert_object_or_array x
| Some true -> ()
);
let allow_nan = match allow_nan with None -> false | Some b -> b in
Pretty.fprint_json allow_nan fmt x;
Format.pp_print_flush fmt ());
*)
let fmt = Format.formatter_of_buffer buf in
let allow_nan = match allow_nan with None -> false | Some b -> b in
Pretty.fprint_json allow_nan fmt x;
Format.pp_print_flush fmt ();
Buffer.contents buf

429
external/jsonwheel/json_parser.ml vendored Normal file
View file

@ -0,0 +1,429 @@
type token =
| STRING of (string)
| INT of (int)
| FLOAT of (float)
| BOOL of (bool)
| OBJSTART
| OBJEND
| ARSTART
| AREND
| NULL
| COMMA
| COLON
| EOF
open Parsing;;
# 2 "json_parser.mly"
(*
Notes about error messages and error locations in ocamlyacc:
1) There is a predefined "error" symbol which can be used as a catch-all,
in order to get the location of the token that shouldn't be there.
2) Additional rules that match common errors are added, so that when
they are matched, a nice, handcrafted error message is produced.
3) Token locations are retrieved using functions from the Parsing
module, which relies on a global state. If you want your error locations
to be reliable, don't run two ocamlyacc parsers simultaneously.
In the end, the error messages are nicer than the ones that a camlp4
parser (extensible grammar) would produce because we write them
manually. However camlp4's messages are all automatic,
i.e. they tell you which tokens were expected at a given location.
For the file/line/char locations to be correct,
the lexbuf must be adjusted by the lexer when the file name
changes or a new line is encountered. This is not performed automatically
by ocamllex, see file json_lexer.mll.
*)
open Printf
open Json_type
let rhs_loc n = (Parsing.rhs_start_pos n, Parsing.rhs_end_pos n)
let unclosed opening_name opening_num closing_name closing_num =
let msg =
sprintf "%s:\nSyntax error: '%s' expected.\n\
%s:\nThis '%s' might be unmatched."
(string_of_loc (rhs_loc closing_num)) closing_name
(string_of_loc (rhs_loc opening_num)) opening_name in
json_error msg
let syntax_error s num =
let msg = sprintf "%s:\n%s" (string_of_loc (rhs_loc num)) s in
json_error msg
# 60 "json_parser.ml"
let yytransl_const = [|
261 (* OBJSTART *);
262 (* OBJEND *);
263 (* ARSTART *);
264 (* AREND *);
265 (* NULL *);
266 (* COMMA *);
267 (* COLON *);
0 (* EOF *);
0|]
let yytransl_block = [|
257 (* STRING *);
258 (* INT *);
259 (* FLOAT *);
260 (* BOOL *);
0|]
let yylhs = "\255\255\
\001\000\001\000\001\000\001\000\002\000\002\000\002\000\002\000\
\002\000\002\000\002\000\002\000\002\000\002\000\002\000\002\000\
\002\000\002\000\002\000\003\000\003\000\003\000\003\000\004\000\
\004\000\004\000\004\000\000\000"
let yylen = "\002\000\
\002\000\002\000\001\000\001\000\003\000\002\000\003\000\003\000\
\002\000\003\000\002\000\003\000\003\000\002\000\001\000\001\000\
\001\000\001\000\001\000\005\000\005\000\004\000\003\000\003\000\
\003\000\002\000\001\000\002\000"
let yydefred = "\000\000\
\000\000\000\000\004\000\015\000\018\000\019\000\016\000\000\000\
\000\000\017\000\003\000\028\000\000\000\009\000\000\000\006\000\
\000\000\014\000\011\000\000\000\000\000\002\000\001\000\000\000\
\008\000\005\000\007\000\000\000\026\000\013\000\010\000\012\000\
\000\000\025\000\024\000\022\000\000\000\021\000\020\000"
let yydgoto = "\002\000\
\012\000\020\000\017\000\021\000"
let yysindex = "\003\000\
\001\000\000\000\000\000\000\000\000\000\000\000\000\000\002\255\
\024\255\000\000\000\000\000\000\011\000\000\000\251\254\000\000\
\012\000\000\000\000\000\033\255\007\000\000\000\000\000\052\255\
\000\000\000\000\000\000\043\255\000\000\000\000\000\000\000\000\
\004\255\000\000\000\000\000\000\009\255\000\000\000\000"
let yyrindex = "\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\009\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\013\000\000\000\000\000\000\000\000\000\000\000\000\000"
let yygindex = "\000\000\
\000\000\255\255\235\255\245\255"
let yytablesize = 275
let yytable = "\013\000\
\011\000\014\000\015\000\001\000\036\000\024\000\032\000\016\000\
\027\000\015\000\023\000\027\000\023\000\037\000\038\000\039\000\
\035\000\000\000\029\000\000\000\000\000\000\000\033\000\018\000\
\004\000\005\000\006\000\007\000\008\000\000\000\009\000\019\000\
\010\000\004\000\005\000\006\000\007\000\008\000\000\000\009\000\
\000\000\010\000\028\000\004\000\005\000\006\000\007\000\008\000\
\000\000\009\000\034\000\010\000\004\000\005\000\006\000\007\000\
\008\000\000\000\009\000\000\000\010\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\003\000\004\000\005\000\006\000\007\000\008\000\030\000\009\000\
\027\000\010\000\022\000\025\000\023\000\000\000\031\000\000\000\
\027\000\026\000\023\000"
let yycheck = "\001\000\
\000\000\000\001\001\001\001\000\001\001\011\001\000\000\006\001\
\000\000\001\001\000\000\000\000\000\000\010\001\006\001\037\000\
\028\000\255\255\020\000\255\255\255\255\255\255\024\000\000\001\
\001\001\002\001\003\001\004\001\005\001\255\255\007\001\008\001\
\009\001\001\001\002\001\003\001\004\001\005\001\255\255\007\001\
\255\255\009\001\010\001\001\001\002\001\003\001\004\001\005\001\
\255\255\007\001\008\001\009\001\001\001\002\001\003\001\004\001\
\005\001\255\255\007\001\255\255\009\001\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
\000\001\001\001\002\001\003\001\004\001\005\001\000\001\007\001\
\000\001\009\001\000\001\000\001\000\001\255\255\008\001\255\255\
\008\001\006\001\006\001"
let yynames_const = "\
OBJSTART\000\
OBJEND\000\
ARSTART\000\
AREND\000\
NULL\000\
COMMA\000\
COLON\000\
EOF\000\
"
let yynames_block = "\
STRING\000\
INT\000\
FLOAT\000\
BOOL\000\
"
let yyact = [|
(fun _ -> failwith "parser")
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 1 : 'value) in
Obj.repr(
# 55 "json_parser.mly"
( _1 )
# 218 "json_parser.ml"
: Json_type.t))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 1 : 'value) in
Obj.repr(
# 56 "json_parser.mly"
( syntax_error "Junk after end of data" 2 )
# 225 "json_parser.ml"
: Json_type.t))
; (fun __caml_parser_env ->
Obj.repr(
# 57 "json_parser.mly"
( syntax_error "Empty data" 1 )
# 231 "json_parser.ml"
: Json_type.t))
; (fun __caml_parser_env ->
Obj.repr(
# 58 "json_parser.mly"
( syntax_error "Syntax error" 1 )
# 237 "json_parser.ml"
: Json_type.t))
; (fun __caml_parser_env ->
let _2 = (Parsing.peek_val __caml_parser_env 1 : 'pair_list) in
Obj.repr(
# 61 "json_parser.mly"
( Object _2 )
# 244 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
Obj.repr(
# 62 "json_parser.mly"
( Object [] )
# 250 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
let _2 = (Parsing.peek_val __caml_parser_env 1 : 'pair_list) in
Obj.repr(
# 63 "json_parser.mly"
( unclosed "{" 1 "}" 3 )
# 257 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
let _2 = (Parsing.peek_val __caml_parser_env 1 : 'pair_list) in
Obj.repr(
# 64 "json_parser.mly"
( unclosed "{" 1 "}" 3 )
# 264 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
Obj.repr(
# 65 "json_parser.mly"
( syntax_error
"Expecting a comma-separated sequence \
of string:value pairs" 2 )
# 272 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
let _2 = (Parsing.peek_val __caml_parser_env 1 : 'value_list) in
Obj.repr(
# 68 "json_parser.mly"
( Array _2 )
# 279 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
Obj.repr(
# 69 "json_parser.mly"
( Array [] )
# 285 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
let _2 = (Parsing.peek_val __caml_parser_env 1 : 'value_list) in
Obj.repr(
# 70 "json_parser.mly"
( unclosed "[" 1 "]" 3 )
# 292 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
let _2 = (Parsing.peek_val __caml_parser_env 1 : 'value_list) in
Obj.repr(
# 71 "json_parser.mly"
( unclosed "[" 1 "]" 3 )
# 299 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
Obj.repr(
# 72 "json_parser.mly"
( syntax_error
"Expecting a comma-separated sequence \
of values" 2 )
# 307 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 0 : string) in
Obj.repr(
# 75 "json_parser.mly"
( String _1 )
# 314 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 0 : bool) in
Obj.repr(
# 76 "json_parser.mly"
( Bool _1 )
# 321 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
Obj.repr(
# 77 "json_parser.mly"
( Null )
# 327 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 0 : int) in
Obj.repr(
# 78 "json_parser.mly"
( Int _1 )
# 334 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 0 : float) in
Obj.repr(
# 79 "json_parser.mly"
( Float _1 )
# 341 "json_parser.ml"
: 'value))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 4 : string) in
let _3 = (Parsing.peek_val __caml_parser_env 2 : 'value) in
let _5 = (Parsing.peek_val __caml_parser_env 0 : 'pair_list) in
Obj.repr(
# 82 "json_parser.mly"
( (_1, _3) :: _5 )
# 350 "json_parser.ml"
: 'pair_list))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 4 : string) in
let _3 = (Parsing.peek_val __caml_parser_env 2 : 'value) in
Obj.repr(
# 84 "json_parser.mly"
( syntax_error
"End-of-object commas are illegal" 4 )
# 359 "json_parser.ml"
: 'pair_list))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 3 : string) in
let _3 = (Parsing.peek_val __caml_parser_env 1 : 'value) in
let _4 = (Parsing.peek_val __caml_parser_env 0 : string) in
Obj.repr(
# 86 "json_parser.mly"
( syntax_error "Missing ','" 4 )
# 368 "json_parser.ml"
: 'pair_list))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 2 : string) in
let _3 = (Parsing.peek_val __caml_parser_env 0 : 'value) in
Obj.repr(
# 87 "json_parser.mly"
( [ (_1, _3) ] )
# 376 "json_parser.ml"
: 'pair_list))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 2 : 'value) in
let _3 = (Parsing.peek_val __caml_parser_env 0 : 'value_list) in
Obj.repr(
# 90 "json_parser.mly"
( _1 :: _3 )
# 384 "json_parser.ml"
: 'value_list))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 2 : 'value) in
Obj.repr(
# 91 "json_parser.mly"
( syntax_error
"End-of-array commas are illegal" 2 )
# 392 "json_parser.ml"
: 'value_list))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 1 : 'value) in
let _2 = (Parsing.peek_val __caml_parser_env 0 : 'value) in
Obj.repr(
# 93 "json_parser.mly"
( syntax_error "Missing ',' before this value" 2 )
# 400 "json_parser.ml"
: 'value_list))
; (fun __caml_parser_env ->
let _1 = (Parsing.peek_val __caml_parser_env 0 : 'value) in
Obj.repr(
# 94 "json_parser.mly"
( [ _1 ] )
# 407 "json_parser.ml"
: 'value_list))
(* Entry main *)
; (fun __caml_parser_env -> raise (Parsing.YYexit (Parsing.peek_val __caml_parser_env 0)))
|]
let yytables =
{ Parsing.actions=yyact;
Parsing.transl_const=yytransl_const;
Parsing.transl_block=yytransl_block;
Parsing.lhs=yylhs;
Parsing.len=yylen;
Parsing.defred=yydefred;
Parsing.dgoto=yydgoto;
Parsing.sindex=yysindex;
Parsing.rindex=yyrindex;
Parsing.gindex=yygindex;
Parsing.tablesize=yytablesize;
Parsing.table=yytable;
Parsing.check=yycheck;
Parsing.error_function=parse_error;
Parsing.names_const=yynames_const;
Parsing.names_block=yynames_block }
let main (lexfun : Lexing.lexbuf -> token) (lexbuf : Lexing.lexbuf) =
(Parsing.yyparse yytables 1 lexfun lexbuf : Json_type.t)

16
external/jsonwheel/json_parser.mli vendored Normal file
View file

@ -0,0 +1,16 @@
type token =
| STRING of (string)
| INT of (int)
| FLOAT of (float)
| BOOL of (bool)
| OBJSTART
| OBJEND
| ARSTART
| AREND
| NULL
| COMMA
| COLON
| EOF
val main :
(Lexing.lexbuf -> token) -> Lexing.lexbuf -> Json_type.t

153
external/jsonwheel/json_type.ml vendored Normal file
View file

@ -0,0 +1,153 @@
open Printf
open Lexing
type json_type =
| Object of (string * json_type) list
| Array of json_type list
| String of string
| Int of int
| Float of float
| Bool of bool
| Null
type t = json_type
exception Json_error of string
let json_error s = raise (Json_error s)
module Browse =
struct
let make_table l =
let tbl = Hashtbl.create (List.length l) in
List.iter (fun (key, data) -> Hashtbl.add tbl key data) l;
tbl
let field tbl x =
match Hashtbl.find_all tbl x with
[y] -> y
| [] -> json_error ("Missing field " ^ x)
| _ -> json_error ("Only one field " ^ x ^ " is expected")
let fieldx tbl x =
match Hashtbl.find_all tbl x with
[y] -> y
| [] -> Null
| _ -> json_error ("At most one field " ^ x ^ " is expected")
let optfield tbl x =
match Hashtbl.find_all tbl x with
[y] -> Some y
| [] -> None
| _ -> json_error ("At most one field " ^ x ^ " is expected")
let optfieldx tbl x =
match Hashtbl.find_all tbl x with
[y] ->
if y = Null then None
else Some y
| [] -> None
| _ -> json_error ("At most one field " ^ x ^ " is expected")
let describe = function
Bool true -> "true"
| Bool false -> "false"
| Int i -> string_of_int i
| Float x -> string_of_float x
| String s -> sprintf "%S" s
| Object _ -> "an object"
| Array _ -> "an array"
| Null -> "null"
let type_mismatch expected x =
let descr = describe x in
json_error (sprintf "Expecting %s, not %s" expected descr)
let is_null x = x = Null
let is_defined x = x <> Null
let null = function
Null -> ()
| x -> type_mismatch "a null value" x
let string = function
String s -> s
| x -> type_mismatch "a string" x
let bool = function
Bool x -> x
| x -> type_mismatch "a bool" x
let number = function
Float x -> x
| Int i -> Pervasives.float i
| x -> type_mismatch "a number" x
let int = function
Int x -> x
| x -> type_mismatch "an int" x
let float = function
Float x -> x
| x -> type_mismatch "a float" x
let array = function
Array x -> x
| x -> type_mismatch "an array" x
let objekt = function
Object x -> x
| x -> type_mismatch "an object" x
let list f x = List.map f (array x)
let option = function
Null -> None
| x -> Some x
let optional f = function
Null -> None
| x -> Some (f x)
let assert_object_or_array x =
match x with
Object _
| Array _ -> ()
| _ -> type_mismatch "an array or an object" x
end
module Build =
struct
let null = Null
let bool x = Bool x
let int x = Int x
let float x = Float x
let string x = String x
let objekt l = Object l
let array l = Array l
let list f l = Array (List.map f l)
let option = function
None -> Null
| Some x -> x
let optional f = function
None -> Null
| Some x -> f x
end
(* pad: *)
let json_of_list of_a xs = Array(List.map of_a xs)
let string_of_loc (pos1, pos2) =
let line1 = pos1.pos_lnum
and start1 = pos1.pos_bol in
Printf.sprintf "File %S, line %i, characters %i-%i"
pos1.pos_fname line1
(pos1.pos_cnum - start1)
(pos2.pos_cnum - start1)

224
external/jsonwheel/json_type.mli vendored Normal file
View file

@ -0,0 +1,224 @@
(** OCaml representation of JSON data *)
(** A [json_type] is a boolean, integer, real, string, null. It can
also be lists [Array] or string-keyed maps [Object] of
[json_type]'s. The JSON payload can only be an [Object] or [Array].
This type is used by the parsing and printing functions from the
{!Json_io} module. Typically, a program would convert such data into
a specialized type that uses records, etc. For the purpose of converting
from and to other types, two submodules are provided: {!Json_type.Browse}
and {!Json_type.Build}.
They are meant to be opened using either [open Json_type.Browse]
or [open Json_type.Build]. They provided simple functions for converting
JSON data. *)
type json_type =
Object of (string * json_type) list
| Array of json_type list
| String of string
| Int of int
| Float of float
| Bool of bool
| Null
(** [t] is an alias for [json_type]. *)
type t = json_type
(** Errors that are produced by the json-wheel library are represented
using the [Json_error] exception.
Other exceptions may be raised when calling functions from the library.
Either they come from
the failure of external functions or like [Not_found] they
are not errors per se, and are specifically documented.
*)
exception Json_error of string
(** This submodule provides some simple functions for checking
and reading the structure of JSON data.
Use [open Json_type.Browse] when you want to convert JSON data
into another OCaml type.
*)
module Browse :
sig
(** [make_table] creates a hash table from the contents of a JSON [Object].
For example, if [x] is a JSON [Object], then the corresponding table
can be created by [let tbl = make_table (objekt x)].
Hash tables are more efficient than lists
if several fields must be extracted
and converted into something like an OCaml record.
The key/value pairs are added from left to right.
Therefore if there are several bindings for the same key, the latest
to appear in the list will be the first in the list
returned by [Hashtbl.find_all]. *)
val make_table : (string * t) list -> (string, t) Hashtbl.t
(** [field tbl key] looks for a unique field [key] in hash table [tbl].
It raises a [Json_error] if [key] is not found in the table
or if it is present multiple times. *)
val field : (string, t) Hashtbl.t -> string -> t
(** [fieldx tbl key] works like [field tbl key], but returns [Null] if
[key] is not found in the table. This function is convenient when
assuming that a field which is set to [Null] is the same
as if it were not defined.
For instance, [optional int (fieldx tbl "year")] looks in
table [tbl] for a field ["year"]. If this field is set to [Null]
or if it is undefined, then [None] is returned, otherwise
an [Int] is expected and returned, for example as [Some 2006].
If the value is of another JSON type than [Int] or [Null], it causes an
error. *)
val fieldx : (string, t) Hashtbl.t -> string -> t
(** [optfield tbl key] queries hash table [tbl] for zero or one field [key].
The result is returned as [None] or [Some result]. If there are several
fields with the same [key], then a [Json_error] is produced.
[Null] is returned as [Some Null], not
as [None]. For other behaviors see {!Json_type.Browse.fieldx}
and {!Json_type.Browse.optfieldx}. *)
val optfield : (string, t) Hashtbl.t -> string -> t option
(** [optfieldx] is the same as [optfield] except that it
will never return [Some Null]
but [None] instead. *)
val optfieldx : (string, t) Hashtbl.t -> string -> t option
(** [describe x] returns a short description of the given JSON data.
Its purpose is to help build error messages. *)
val describe : t -> string
(** [type_mismatch expected x] raises the [Json_error msg] exception,
where [msg] is a message that describes the error as a type mismatch
between the element [x] and what is [expected]. *)
val type_mismatch : string -> t -> 'a
(** tells whether the given JSON element is null *)
val is_null : t -> bool
(** tells whether the given JSON element is not null *)
val is_defined : t -> bool
(** raises a [Json_error] exception if the given JSON value is not [Null]. *)
val null : t -> unit
(** reads a JSON element as a string or raises a [Json_error] exception. *)
val string : t -> string
(** reads a JSON element as a bool or raises a [Json_error] exception. *)
val bool : t -> bool
(** reads a JSON element as an int or a float and returns a float
or raises a [Json_error] exception. *)
val number : t -> float
(** reads a JSON element as an int or raises a [Json_error] exception. *)
val int : t -> int
(** reads a JSON element as a float or raises a [Json_error] exception. *)
val float : t -> float
(** reads a JSON element as a JSON [Array] and returns an OCaml list,
or raises a [Json_error] exception. *)
val array : t -> t list
(** reads a JSON element as a JSON [Object] and returns an OCaml list,
or raises a [Json_error] exception.
Note the unusual spelling. [object] being
a keyword in OCaml, we use [objekt]. [Object] with a capital is still
spelled [Object]. *)
val objekt : t -> (string * t) list
(** [list f x] maps a JSON [Array x] to an OCaml list,
converting each element
of list [x] using [f]. A [Json_error] exception is raised if
the given element is not a JSON [Array].
For example, converting a JSON array that must contain only ints
is performed using [list int x]. Similarly, a list of lists of ints
can be obtained using [list (list int) x]. *)
val list : (t -> 'a) -> t -> 'a list
(** [option x] returns [None] is [x] is [Null] and [Some x] otherwise. *)
val option : t -> t option
(** [optional f x] maps x using the given function [f] and returns
[Some result], unless [x] is [Null] in which case it returns [None].
For example, [optional int x] may return something like
[Some 123] or [None] or raise a [Json_error] exception in case
[x] is neither [Null] nor an [Int].
See also {!Json_type.Browse.fieldx}. *)
val optional : (t -> 'a) -> t -> 'a option
(**/**)
val assert_object_or_array : t -> unit
end
(** This submodule provides some simple functions for building
JSON data from other OCaml types.
Use [open Json_type.Build] when you want to convert JSON data
into another OCaml type.
*)
module Build :
sig
val null : t
(** The [Null] value *)
val bool : bool -> t
(** builds a JSON [Bool] *)
val int : int -> t
(** builds a JSON [Int] *)
val float : float -> t
(** builds a JSON [Float] *)
val string : string -> t
(** builds a JSON [String] *)
val objekt : (string * t) list -> t
(** builds a JSON [Object].
See {!Json_type.Browse.objekt} for an explanation about the unusual
spelling. *)
val array : t list -> t
(** builds a JSON [Array]. *)
val list : ('a -> t) -> 'a list -> t
(** [list f l] maps OCaml list [l] to a JSON list using
function [f] to convert the elements into JSON values.
For example, [list int [1; 2; 3]] is a shortcut for
[Array [ Int 1; Int 2; Int 3 ]]. *)
val option : t option -> t
(** [option x] returns [Null] is [x] is [None], or [y] if
[x] is [Some y]. *)
val optional : ('a -> t) -> 'a option -> t
(** [optional f x] returns [Null] if [x] is [None], or [f x]
otherwise.
For example, [list (optional int) [Some 1; Some 2; None]] returns
[Array [ Int 1; Int 2; Null ]]. *)
end
(**/**)
(* pad: *)
val json_of_list: ('a -> t) -> 'a list -> t
val string_of_loc : (Lexing.position * Lexing.position) -> string
val json_error : string -> 'a

22
external/jsonwheel/license.txt vendored Normal file
View file

@ -0,0 +1,22 @@
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. 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.
3. The name of the author may not be used to endorse or promote products
derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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.

8
external/jsonwheel/modif-orig.txt vendored Normal file
View file

@ -0,0 +1,8 @@
Modified Makefile to not require ocamlfind or netstring
and created a slice of json_io.ml in json_out.ml.
Json-wheel is better structured than sexplib. Martin correctly
realized that people may want to use Json as-is, without the automatic
converting camlp4 stuff. So he splitted in json-wheel and json-static.
They should have done that for sexplib too. Nevertheless he requires
netconversion stuff :(

8
external/jsonwheel/netconversion2.ml vendored Normal file
View file

@ -0,0 +1,8 @@
let once = ref false
let ustring_of_uchar x y =
if not !once then begin
prerr_string "(lib-json)ustring_of_uchar: Todo\n"; flush stderr;
once := true
end;
"PBUSTRINGOFCHAR"

70
external/jsonwheel/readme.txt vendored Normal file
View file

@ -0,0 +1,70 @@
This is an OCaml library which reads and writes data in the JSON format
(JavaScript Object Notation).
This format can be used as a light-weight replacement for XML.
Visit http://www.json.org for more information about JSON.
The documentation for this library is located at
http://martin.jambon.free.fr/json-wheel/
Installation
============
Requirements:
- OCaml
- GNU make
- the findlib library manager (ocamlfind command)
- the netstring library
From the source directory, do:
make
make install
If you want to remove the package do:
make uninstall
Standard compliance
===================
The JSON parser, in the default mode, conforms to the specifications
of RFC 4627, with only some limitations due to the implementation
of the corresponding OCaml types:
* ints that are too large to be represented with the OCaml int type
cause an error. The limit depends whether it is a 32-bit or 64-bit
platform (see min_int and max_int).
* floats may be represented with reduced precision as they must fit
into the 8 bytes of the "double" format.
* The size of OCaml strings is limited to about 16MB on 32-bit
platforms, and much more on 64-bit platforms (see Sys.max_string_length).
RFC 4627: http://www.ietf.org/rfc/rfc4627.txt?number=4627
The UTF-8 encoding is supported, however no attempt is made at
checking whether strings are actually valid UTF-8 or not. Therefore, other
ASCII-compatible encodings such as the ISO 8859 series are supported
as well.
Tests
=====
Json.org provides a test suite. You can download the file (test.zip),
unzip it in the parent directory, and run "make test".
Look for ERROR messages, which indicate that a file that should fail
actually passes or that a file that should pass fails the test.
../test/fail18.json doesn't pass: this is only because an int which is
too large for the OCaml int type on a 32-bit platform.
../test/fail18.json passes: it is marked as "should fail" because is
has a high number of nesting. Although the standard allows such
restrictions, there are not mandatory at all. Our parser does not have
such a restriction.