mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-03 03:06:39 +02:00
parent
4dab8b81d4
commit
c026c0884d
2 changed files with 31 additions and 15 deletions
|
@ -9,6 +9,8 @@
|
||||||
(test 1 (string->json "1"))
|
(test 1 (string->json "1"))
|
||||||
(test 1.5 (string->json "1.5"))
|
(test 1.5 (string->json "1.5"))
|
||||||
(test 1000.0 (string->json "1e3"))
|
(test 1000.0 (string->json "1e3"))
|
||||||
|
(test 'null (string->json "null"))
|
||||||
|
(test '((null . 3)) (string->json "{\"null\": 3}"))
|
||||||
(test "á" (string->json "\"\\u00e1\""))
|
(test "á" (string->json "\"\\u00e1\""))
|
||||||
(test "𐐷" (string->json "\"\\uD801\\uDC37\""))
|
(test "𐐷" (string->json "\"\\uD801\\uDC37\""))
|
||||||
(test "😐" (string->json "\"\\uD83D\\uDE10\""))
|
(test "😐" (string->json "\"\\uD83D\\uDE10\""))
|
||||||
|
@ -119,6 +121,8 @@
|
||||||
(test "1" (json->string 1))
|
(test "1" (json->string 1))
|
||||||
(test "1.5" (json->string 1.5))
|
(test "1.5" (json->string 1.5))
|
||||||
(test "1000" (json->string 1E3))
|
(test "1000" (json->string 1E3))
|
||||||
|
(test "null" (json->string 'null))
|
||||||
|
(test "{\"null\":3}" (json->string '((null . 3))))
|
||||||
(test "\"\\u00E1\"" (json->string "á"))
|
(test "\"\\u00E1\"" (json->string "á"))
|
||||||
(test "\"\\uD801\\uDC37\"" (json->string "𐐷"))
|
(test "\"\\uD801\\uDC37\"" (json->string "𐐷"))
|
||||||
(test "\"\\uD83D\\uDE10\"" (json->string "😐"))
|
(test "\"\\uD83D\\uDE10\"" (json->string "😐"))
|
||||||
|
|
|
@ -293,7 +293,7 @@ sexp json_read (sexp ctx, sexp self, sexp in) {
|
||||||
res = json_read_number(ctx, self, in);
|
res = json_read_number(ctx, self, in);
|
||||||
break;
|
break;
|
||||||
case 'n': case 'N':
|
case 'n': case 'N':
|
||||||
res = json_read_literal(ctx, self, in, "null", SEXP_VOID);
|
res = json_read_literal(ctx, self, in, "null", sexp_intern(ctx, "null", -1));
|
||||||
break;
|
break;
|
||||||
case 't': case 'T':
|
case 't': case 'T':
|
||||||
res = json_read_literal(ctx, self, in, "true", SEXP_TRUE);
|
res = json_read_literal(ctx, self, in, "true", SEXP_TRUE);
|
||||||
|
@ -406,30 +406,43 @@ sexp json_write_array(sexp ctx, sexp self, const sexp obj, sexp out) {
|
||||||
}
|
}
|
||||||
|
|
||||||
sexp json_write_object(sexp ctx, sexp self, const sexp obj, sexp out) {
|
sexp json_write_object(sexp ctx, sexp self, const sexp obj, sexp out) {
|
||||||
sexp ls, cur, key, val, tmp;
|
sexp ls, cur, key, val;
|
||||||
|
sexp_gc_var2(tmp, res);
|
||||||
if (sexp_length(ctx, obj) == SEXP_FALSE)
|
if (sexp_length(ctx, obj) == SEXP_FALSE)
|
||||||
return sexp_json_write_exception(ctx, self, "unable to encode circular list", obj);
|
sexp_json_write_exception(ctx, self, "unable to encode circular list", obj);
|
||||||
|
sexp_gc_preserve2(ctx, tmp, res);
|
||||||
|
res = SEXP_VOID;
|
||||||
sexp_write_char(ctx, '{', out);
|
sexp_write_char(ctx, '{', out);
|
||||||
for (ls = obj; sexp_pairp(ls); ls = sexp_cdr(ls)) {
|
for (ls = obj; sexp_pairp(ls); ls = sexp_cdr(ls)) {
|
||||||
if (ls != obj)
|
if (ls != obj)
|
||||||
sexp_write_char(ctx, ',', out);
|
sexp_write_char(ctx, ',', out);
|
||||||
cur = sexp_car(ls);
|
cur = sexp_car(ls);
|
||||||
if (!sexp_pairp(cur))
|
if (!sexp_pairp(cur)) {
|
||||||
return sexp_json_write_exception(ctx, self, "unable to encode key-value pair: not a pair", obj);
|
res = sexp_json_write_exception(ctx, self, "unable to encode key-value pair: not a pair", obj);
|
||||||
|
break;
|
||||||
|
}
|
||||||
key = sexp_car(cur);
|
key = sexp_car(cur);
|
||||||
if (!sexp_symbolp(key))
|
if (!sexp_symbolp(key)) {
|
||||||
return sexp_json_write_exception(ctx, self, "unable to encode key: not a symbol", key);
|
res = sexp_json_write_exception(ctx, self, "unable to encode key: not a symbol", key);
|
||||||
tmp = json_write(ctx, self, key, out);
|
break;
|
||||||
if (sexp_exceptionp(tmp))
|
}
|
||||||
return tmp;
|
tmp = sexp_symbol_to_string(ctx, key);
|
||||||
|
tmp = json_write(ctx, self, tmp, out);
|
||||||
|
if (sexp_exceptionp(tmp)) {
|
||||||
|
res = tmp;
|
||||||
|
break;
|
||||||
|
}
|
||||||
sexp_write_char(ctx, ':', out);
|
sexp_write_char(ctx, ':', out);
|
||||||
val = sexp_cdr(cur);
|
val = sexp_cdr(cur);
|
||||||
tmp = json_write(ctx, self, val, out);
|
tmp = json_write(ctx, self, val, out);
|
||||||
if (sexp_exceptionp(tmp))
|
if (sexp_exceptionp(tmp)) {
|
||||||
return tmp;
|
res = tmp;
|
||||||
|
break;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
sexp_write_char(ctx, '}', out);
|
sexp_write_char(ctx, '}', out);
|
||||||
return SEXP_VOID;
|
sexp_gc_release2(ctx);
|
||||||
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
sexp json_write (sexp ctx, sexp self, const sexp obj, sexp out) {
|
sexp json_write (sexp ctx, sexp self, const sexp obj, sexp out) {
|
||||||
|
@ -437,8 +450,7 @@ sexp json_write (sexp ctx, sexp self, const sexp obj, sexp out) {
|
||||||
sexp_gc_preserve1(ctx, res);
|
sexp_gc_preserve1(ctx, res);
|
||||||
res = SEXP_VOID;
|
res = SEXP_VOID;
|
||||||
if (sexp_symbolp(obj)) {
|
if (sexp_symbolp(obj)) {
|
||||||
res = sexp_symbol_to_string(ctx, obj);
|
res = sexp_write(ctx, obj, out);
|
||||||
res = json_write_string(ctx, self, res, out);
|
|
||||||
} else if (sexp_stringp(obj)) {
|
} else if (sexp_stringp(obj)) {
|
||||||
res = json_write_string(ctx, self, obj, out);
|
res = json_write_string(ctx, self, obj, out);
|
||||||
} else if (sexp_listp(ctx, obj) == SEXP_TRUE) {
|
} else if (sexp_listp(ctx, obj) == SEXP_TRUE) {
|
||||||
|
|
Loading…
Add table
Reference in a new issue