static muse_cell json_read_object_expr_items( muse_env *env, muse_port_t p, muse_cell h, muse_cell t, int sp )
{
json_skip_whitespace(p);
if ( port_eof(p) )
return muse_raise_error( env, _csymbol(L"json:end-of-file-in-object"), MUSE_NIL );
else {
muse_char c = port_getchar(p);
if ( c == '}' ) {
return h;
} else {
muse_cell key, value;
port_ungetchar(c,p);
key = json_read_key(p);
json_skip_whitespace(p);
if ( port_eof(p) ) {
return muse_raise_error( env, _csymbol(L"json:end-of-file-in-object"), MUSE_NIL );
} else {
muse_char c = port_getchar(p);
if ( c == ':' ) {
muse_cell assoc;
value = json_read_expr(p);
if ( json_is_constant(env, value) ) {
assoc = _cons( muse_quote( env, _cons( key, value ) ), MUSE_NIL );
} else {
assoc = _cons( _cons( _mk_nativefn(fn_cons,NULL), _cons( muse_quote(env,key), _cons( value, MUSE_NIL ) ) ), MUSE_NIL );
}
_sett( t, assoc );
t = assoc;
_unwind(sp);
json_skip_whitespace(p);
{
muse_char c = port_getchar(p);
if ( c == ',' ) {
return json_read_object_expr_items( env, p, h, t, sp );
} else if ( c == '}' ) {
return h;
} else {
return muse_raise_error( env, _csymbol(L"json:object-syntax-error"), h );
}
}
} else {
return muse_raise_error( env, _csymbol(L"json:object-syntax-error"), h );
}
}
}
}
}
static muse_cell json_read( muse_port_t p )
{
json_skip_whitespace(p);
if ( !port_eof(p) ) {
muse_char c = port_getchar(p);
port_ungetchar(c,p);
switch ( c ) {
case '"': return json_read_string(p);
case '-':
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9': return json_read_number(p);
case '[': return json_read_array(p);
case '{': return json_read_object(p);
default:
if ( c >= 'a' && c <= 'z' )
return json_read_keyword(p);
else {
return muse_raise_error( p->env, muse_csymbol( p->env, L"json:syntax-error" ), MUSE_NIL );
}
}
} else {
return muse_raise_error( p->env, muse_csymbol( p->env, L"json:unexpected-end-of-stream" ), MUSE_NIL );
}
}
static muse_cell json_read_array_items( muse_env *env, muse_port_t p, muse_cell h, muse_cell t, int N )
{
int i;
if ( port_eof(p) ) {
return muse_raise_error( env, _csymbol(L"json:end-of-file-in-array"), MUSE_NIL );
} else {
muse_char c = port_getchar(p);
if ( c == ']' ) {
muse_cell v = muse_mk_vector( env, N );
for ( i = 0; i < N; ++i ) {
muse_vector_put( env, v, i, _next(&h) );
}
return v;
} else {
port_ungetchar( c, p );
}
}
if ( h ) {
int sp = _spos();
muse_cell n = _cons( json_read(p), MUSE_NIL );
_sett( t, n );
t = n;
_unwind(sp);
} else {
h = t = _cons( json_read(p), MUSE_NIL );
}
json_skip_whitespace(p);
if ( port_eof(p) ) {
return muse_raise_error( env, _csymbol(L"json:end-of-file-in-array"), h );
} else {
muse_char c = port_getchar(p);
if ( c == ',' ) {
return json_read_array_items( env, p, h, t, N+1 );
} else if ( c == ']' ) {
port_ungetc( c, p );
return json_read_array_items( env, p, h, t, N+1 );
} else {
return muse_raise_error( env, _csymbol(L"json:array-syntax-error"), h );
}
}
}
static muse_cell json_read_object_items( muse_env *env, muse_port_t p, muse_cell table )
{
json_skip_whitespace(p);
if ( port_eof(p) )
return muse_raise_error( env, _csymbol(L"json:end-of-file-in-object"), MUSE_NIL );
else {
muse_char c = port_getchar(p);
if ( c == '}' ) {
return table;
} else {
int sp = _spos();
muse_cell key, value;
port_ungetchar(c,p);
key = json_read_key(p);
json_skip_whitespace(p);
if ( port_eof(p) ) {
return muse_raise_error( env, _csymbol(L"json:end-of-file-in-object"), MUSE_NIL );
} else {
muse_char c = port_getchar(p);
if ( c == ':' ) {
value = json_read(p);
muse_hashtable_put( env, table, key, value );
_unwind(sp);
{
muse_char c = port_getchar(p);
if ( c == ',' ) {
return json_read_object_items( env, p, table );
} else if ( c == '}' ) {
return table;
} else {
return muse_raise_error( env, _csymbol(L"json:object-syntax-error"), table );
}
}
} else {
return muse_raise_error( env, _csymbol(L"json:object-syntax-error"), table );
}
}
}
}
}
static void json_skip_whitespace( muse_port_t p )
{
if ( port_eof(p) )
return;
else {
muse_char c = port_getchar(p);
if ( c == ' ' || c == '\t' || c == '\r' || c == '\n' || c == '\f' )
json_skip_whitespace(p);
else
port_ungetchar( c, p );
}
}
static muse_cell json_read_array_expr_items( muse_env *env, muse_port_t p, muse_cell h, muse_cell t, int N )
{
if ( port_eof(p) ) {
return muse_raise_error( env, _csymbol(L"json:end-of-file-in-array"), MUSE_NIL );
} else {
muse_char c = port_getchar(p);
if ( c == ']' ) {
return h;
} else {
port_ungetchar( c, p );
}
}
if ( h ) {
int sp = _spos();
muse_cell n = _cons( json_read_expr(p), MUSE_NIL );
_sett( t, n );
t = n;
_unwind(sp);
} else {
h = t = _cons( json_read_expr(p), MUSE_NIL );
}
json_skip_whitespace(p);
if ( port_eof(p) ) {
return muse_raise_error( env, _csymbol(L"json:end-of-file-in-array"), h );
} else {
muse_char c = port_getchar(p);
if ( c == ',' ) {
return json_read_array_expr_items( env, p, h, t, N+1 );
} else if ( c == ']' ) {
port_ungetchar( c, p );
return json_read_array_expr_items( env, p, h, t, N+1 );
} else {
return muse_raise_error( env, _csymbol(L"json:array-syntax-error"), h );
}
}
}
static muse_cell json_read_string( muse_port_t p )
{
muse_char c = port_getchar(p);
assert( c == '"' );
{
buffer_t *b = buffer_alloc();
while ( !port_eof(p) ) {
c = port_getchar(p);
if ( c == '"' )
break;
else if ( c == '\\' ) {
c = port_getchar(p);
switch( c ) {
case '"': buffer_putc( b, c ); break;
case '\\': buffer_putc( b, c ); break;
case '/': buffer_putc( b, c ); break;
case 'b': buffer_putc( b, '\b' ); break;
case 'f': buffer_putc( b, '\f' ); break;
case 'n': buffer_putc( b, '\n' ); break;
case 'r': buffer_putc( b, '\r' ); break;
case 't': buffer_putc( b, '\t' ); break;
case 'u':
{
muse_char d[4];
d[0] = port_getchar(p);
d[1] = port_getchar(p);
d[2] = port_getchar(p);
d[3] = port_getchar(p);
buffer_putc( b, hex2word(d) );
break;
}
default:
muse_raise_error( p->env, muse_csymbol(p->env,L"json:invalid-escape-code"), MUSE_NIL );
buffer_putc( b, c );
break;
}
} else {
buffer_putc( b, c );
}
}
{
muse_cell str = buffer_to_string( b, p->env );
buffer_free(b);
return str;
}
}
}
static muse_cell json_read_expr( muse_port_t p )
{
json_skip_whitespace(p);
if ( !port_eof(p) ) {
muse_char c = port_getchar(p);
port_ungetchar(c,p);
switch ( c ) {
case '"': return json_read_string(p);
case '-':
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9': return json_read_number(p);
case '[': return json_read_array_expr(p);
case '{': return json_read_object_expr(p);
case '(': return muse_pread(p);
default:
{
muse_cell e = muse_pread(p);
if ( _cellt(e) == MUSE_SYMBOL_CELL ) {
const muse_char *name = muse_symbol_name(p->env,e);
if ( wcscmp( name, L"null" ) == 0 )
return MUSE_NIL;
else if ( wcscmp( name, L"true" ) == 0 || wcscmp( name, L"false" ) == 0 )
return muse_quote( p->env, e );
else
return e;
}
else
return e;
}
}
} else {
return muse_raise_error( p->env, muse_csymbol( p->env, L"json:unexpected-end-of-stream" ), MUSE_NIL );
}
}
/***************************************************************
Load
***************************************************************/
static obj_ptr _load_imp(cptr file, obj_ptr env)
{
port_ptr p;
obj_ptr o = NIL;
p = port_open_input_file(file);
while (!port_eof(p))
{
o = obj_read(p);
if (ERRORP(o)) break;
o = obj_eval(o, env);
if (ERRORP(o)) break;
port_skip_while(p, isspace);
}
if (ERRORP(o))
error_add_file_info(o, port_name(p), port_line(p));
port_close(p);
return o;
}
