ref: c0a28bad03c29788d9fc18b5ab56c13a6222bf7d
dir: /appl/lib/json.b/
implement JSON;
#
# Javascript `Object' Notation (JSON): RFC4627
#
include "sys.m";
sys: Sys;
include "bufio.m";
bufio: Bufio;
Iobuf: import bufio;
include "json.m";
init(b: Bufio)
{
sys = load Sys Sys->PATH;
bufio = b;
}
jvarray(a: array of ref JValue): ref JValue.Array
{
return ref JValue.Array(a);
}
jvbig(i: big): ref JValue.Int
{
return ref JValue.Int(i);
}
jvfalse(): ref JValue.False
{
return ref JValue.False;
}
jvint(i: int): ref JValue.Int
{
return ref JValue.Int(big i);
}
jvnull(): ref JValue.Null
{
return ref JValue.Null;
}
jvobject(m: list of (string, ref JValue)): ref JValue.Object
{
# could `uniq' the labels
return ref JValue.Object(m);
}
jvreal(r: real): ref JValue.Real
{
return ref JValue.Real(r);
}
jvstring(s: string): ref JValue.String
{
return ref JValue.String(s);
}
jvtrue(): ref JValue.True
{
return ref JValue.True;
}
Syntax: exception(string);
Badwrite: exception;
readjson(fd: ref Iobuf): (ref JValue, string)
{
{
p := Parse.mk(fd);
c := p.getns();
if(c == Bufio->EOF)
return (nil, nil);
p.unget(c);
return (readval(p), nil);
}exception e{
Syntax =>
return (nil, sys->sprint("JSON syntax error (offset %bd): %s", fd.offset(), e));
}
}
writejson(fd: ref Iobuf, val: ref JValue): int
{
{
writeval(fd, val);
return 0;
}exception{
Badwrite =>
return -1;
}
}
#
# value ::= string | number | object | array | 'true' | 'false' | 'null'
#
readval(p: ref Parse): ref JValue raises(Syntax)
{
{
while((c := p.getc()) == ' ' || c == '\t' || c == '\n' || c == '\r')
{}
if(c < 0){
if(c == Bufio->EOF)
raise Syntax("unexpected end-of-input");
raise Syntax(sys->sprint("read error: %r"));
}
case c {
'{' =>
# object ::= '{' [pair (',' pair)*] '}'
l: list of (string, ref JValue);
if((c = p.getns()) != '}'){
p.unget(c);
rl: list of (string, ref JValue);
do{
# pair ::= string ':' value
c = p.getns();
if(c != '"')
raise Syntax("missing member name");
name := readstring(p, c);
if(p.getns() != ':')
raise Syntax("missing ':'");
rl = (name, readval(p)) :: rl;
}while((c = p.getns()) == ',');
for(; rl != nil; rl = tl rl)
l = hd rl :: l;
}
if(c != '}')
raise Syntax("missing '}' at end of object");
return ref JValue.Object(l);
'[' =>
# array ::= '[' [value (',' value)*] ']'
l: list of ref JValue;
n := 0;
if((c = p.getns()) != ']'){
p.unget(c);
do{
l = readval(p) :: l;
n++;
}while((c = p.getns()) == ',');
}
if(c != ']')
raise Syntax("missing ']' at end of array");
a := array[n] of ref JValue;
for(; --n >= 0; l = tl l)
a[n] = hd l;
return ref JValue.Array(a);
'"' =>
return ref JValue.String(readstring(p, c));
'-' or '0' to '9' =>
# number ::= int frac? exp?
# int ::= '-'? [0-9] | [1-9][0-9]+
# frac ::= '.' [0-9]+
# exp ::= [eE][-+]? [0-9]+
if(c == '-')
intp := "-";
else
p.unget(c);
intp += readdigits(p); # we don't enforce the absence of leading zeros
fracp: string;
c = p.getc();
if(c == '.'){
fracp = readdigits(p);
c = p.getc();
}
exp := "";
if(c == 'e' || c == 'E'){
exp[0] = c;
c = p.getc();
if(c == '-' || c == '+')
exp[1] = c;
else
p.unget(c);
exp += readdigits(p);
}else
p.unget(c);
if(fracp != nil || exp != nil)
return ref JValue.Real(real (intp+"."+fracp+exp));
return ref JValue.Int(big intp);
'a' to 'z' =>
# 'true' | 'false' | 'null'
s: string;
do{
s[len s] = c;
}while((c = p.getc()) >= 'a' && c <= 'z');
p.unget(c);
case s {
"true" => return ref JValue.True();
"false" => return ref JValue.False();
"null" => return ref JValue.Null();
* => raise Syntax("invalid literal: "+s);
}
* =>
raise Syntax(sys->sprint("unexpected character #%.4ux", c));
}
}exception{
Syntax =>
raise;
}
}
# string ::= '"' char* '"'
# char ::= [^\x00-\x1F"\\] | '\"' | '\/' | '\b' | '\f' | '\n' | '\r' | '\t' | '\u' hex hex hex hex
readstring(p: ref Parse, delim: int): string raises(Syntax)
{
{
s := "";
while((c := p.getc()) != delim && c >= 0){
if(c == '\\'){
c = p.getc();
if(c < 0)
break;
case c {
'b' => c = '\b';
'f' => c = '\f';
'n' => c = '\n';
'r' => c = '\r';
't' => c = '\t';
'u' =>
c = 0;
for(i := 0; i < 4; i++)
c = (c<<4) | hex(p.getc());
* => ; # identity, including '"', '/', and '\'
}
}
s[len s] = c;
}
if(c < 0){
if(c == Bufio->ERROR)
raise Syntax(sys->sprint("read error: %r"));
raise Syntax("unterminated string");
}
return s;
}exception{
Syntax =>
raise;
}
}
# hex ::= [0-9a-fA-F]
hex(c: int): int raises(Syntax)
{
case c {
'0' to '9' =>
return c-'0';
'a' to 'f' =>
return 10+(c-'a');
'A' to 'F' =>
return 10+(c-'A');
* =>
raise Syntax("invalid hex digit");
}
}
# digits ::= [0-9]+
readdigits(p: ref Parse): string raises(Syntax)
{
c := p.getc();
if(!(c >= '0' && c <= '9'))
raise Syntax("expected integer literal");
s := "";
s[0] = c;
while((c = p.getc()) >= '0' && c <= '9')
s[len s] = c;
p.unget(c);
return s;
}
writeval(out: ref Iobuf, o: ref JValue) raises(Badwrite)
{
{
if(o == nil){
puts(out, "null");
return;
}
pick r := o {
String =>
writestring(out, r.s);
Int =>
puts(out, r.text());
Real =>
puts(out, r.text());
Object => # '{' [pair (',' pair)*] '}'
putc(out, '{');
for(l := r.mem; l != nil; l = tl l){
if(l != r.mem)
putc(out, ',');
(n, v) := hd l;
writestring(out, n);
putc(out, ':');
writeval(out, v);
}
putc(out, '}');
Array => # '[' [value (',' value)*] ']'
putc(out, '[');
for(i := 0; i < len r.a; i++){
if(i != 0)
putc(out, ',');
writeval(out, r.a[i]);
}
putc(out, ']');
True =>
puts(out, "true");
False =>
puts(out, "false");
Null =>
puts(out, "null");
* =>
raise "writeval: unknown value"; # can't happen
}
}exception{
Badwrite =>
raise;
}
}
writestring(out: ref Iobuf, s: string) raises(Badwrite)
{
{
putc(out, '"');
for(i := 0; i < len s; i++){
c := s[i];
if(needesc(c))
puts(out, escout(c));
else
putc(out, c);
}
putc(out, '"');
}exception{
Badwrite =>
raise;
}
}
escout(c: int): string
{
case c {
'"' => return "\\\"";
'\\' => return "\\\\";
'/' => return "\\/";
'\b' => return "\\b";
'\f' => return "\\f";
'\n' => return "\\n";
'\t' => return "\\t";
'\r' => return "\\r";
* => return sys->sprint("\\u%.4ux", c);
}
}
puts(out: ref Iobuf, s: string) raises(Badwrite)
{
if(out.puts(s) == Bufio->ERROR)
raise Badwrite;
}
putc(out: ref Iobuf, c: int) raises(Badwrite)
{
if(out.putc(c) == Bufio->ERROR)
raise Badwrite;
}
Parse: adt {
input: ref Iobuf;
eof: int;
mk: fn(io: ref Iobuf): ref Parse;
getc: fn(nil: self ref Parse): int;
unget: fn(nil: self ref Parse, c: int);
getns: fn(nil: self ref Parse): int;
};
Parse.mk(io: ref Iobuf): ref Parse
{
return ref Parse(io, 0);
}
Parse.getc(p: self ref Parse): int
{
if(p.eof)
return p.eof;
c := p.input.getc();
if(c < 0)
p.eof = c;
return c;
}
Parse.unget(p: self ref Parse, c: int)
{
if(c >= 0)
p.input.ungetc();
}
# skip white space
Parse.getns(p: self ref Parse): int
{
while((c := p.getc()) == ' ' || c == '\t' || c == '\n' || c == '\r')
{}
return c;
}
JValue.isarray(v: self ref JValue): int
{
return tagof v == tagof JValue.Array;
}
JValue.isint(v: self ref JValue): int
{
return tagof v == tagof JValue.Int;
}
JValue.isnumber(v: self ref JValue): int
{
return tagof v == tagof JValue.Int || tagof v == tagof JValue.Real;
}
JValue.isobject(v: self ref JValue): int
{
return tagof v == tagof JValue.Object;
}
JValue.isreal(v: self ref JValue): int
{
return tagof v == tagof JValue.Real;
}
JValue.isstring(v: self ref JValue): int
{
return tagof v == tagof JValue.String;
}
JValue.istrue(v: self ref JValue): int
{
return tagof v == tagof JValue.True;
}
JValue.isfalse(v: self ref JValue): int
{
return tagof v == tagof JValue.False;
}
JValue.isnull(v: self ref JValue): int
{
return tagof v == tagof JValue.Null;
}
JValue.copy(v: self ref JValue): ref JValue
{
pick r := v {
True or False or Null =>
return ref *r;
Int =>
return ref *r;
Real =>
return ref *r;
String =>
return ref *r;
Array =>
a := array[len r.a] of ref JValue;
a[0:] = r.a;
return ref JValue.Array(a);
Object =>
return ref *r;
* =>
raise "json: bad copy"; # can't happen
}
}
JValue.eq(a: self ref JValue, b: ref JValue): int
{
if(a == b)
return 1;
if(a == nil || b == nil || tagof a != tagof b)
return 0;
pick r := a {
True or False or Null =>
return 1; # tags were equal above
Int =>
pick s := b {
Int =>
return r.value == s.value;
}
Real =>
pick s := b {
Real =>
return r.value == s.value;
}
String =>
pick s := b {
String =>
return r.s == s.s;
}
Array =>
pick s := b {
Array =>
if(len r.a != len s.a)
return 0;
for(i := 0; i < len r.a; i++)
if(r.a[i] == nil){
if(s.a[i] != nil)
return 0;
}else if(!r.a[i].eq(s.a[i]))
return 0;
return 1;
}
Object =>
pick s := b {
Object =>
ls := s.mem;
for(lr := r.mem; lr != nil; lr = tl lr){
if(ls == nil)
return 0;
(rn, rv) := hd lr;
(sn, sv) := hd ls;
if(rn != sn)
return 0;
if(rv == nil){
if(sv != nil)
return 0;
}else if(!rv.eq(sv))
return 0;
}
return ls == nil;
}
}
return 0;
}
JValue.get(v: self ref JValue, mem: string): ref JValue
{
pick r := v {
Object =>
for(l := r.mem; l != nil; l = tl l)
if((hd l).t0 == mem)
return (hd l).t1;
return nil;
* =>
return nil;
}
}
# might be better if the interface were applicative?
# this is similar to behaviour of Limbo's own ref adt, though
JValue.set(v: self ref JValue, mem: string, val: ref JValue)
{
pick j := v {
Object =>
ol: list of (string, ref JValue);
for(l := j.mem; l != nil; l = tl l)
if((hd l).t0 == mem){
l = tl l;
for(; ol != nil; ol = tl ol)
l = hd ol :: l;
j.mem = l;
return;
}else
ol = hd l :: ol;
j.mem = (mem, val) :: j.mem;
* =>
raise "json: set non-object";
}
}
JValue.text(v: self ref JValue): string
{
if(v == nil)
return "null";
pick r := v {
True =>
return "true";
False =>
return "false";
Null =>
return "null";
Int =>
return string r.value;
Real =>
return sys->sprint("%f", r.value);
String =>
return quote(r.s); # quoted, or not?
Array =>
s := "[";
for(i := 0; i < len r.a; i++){
if(i != 0)
s += ", ";
s += r.a[i].text();
}
return s+"]";
Object =>
s := "{";
for(l := r.mem; l != nil; l = tl l){
if(l != r.mem)
s += ", ";
s += quote((hd l).t0)+": "+(hd l).t1.text();
}
return s+"}";
* =>
return nil;
}
}
quote(s: string): string
{
ns := "\"";
for(i := 0; i < len s; i++){
c := s[i];
if(needesc(c))
ns += escout(c);
else
ns[len ns] = c;
}
return ns+"\"";
}
needesc(c: int): int
{
return c == '"' || c == '\\' || c == '/' || c <= 16r1F; # '/' is escaped to prevent "</xyz>" looking like an XML end tag(!)
}