From f1b977be5244d0f651d382b4d9ce650bc33ac942 Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Sat, 25 Jan 2020 15:04:37 +0200 Subject: [PATCH 1/6] Export json-error-reason --- srfi/json.sld | 1 + 1 file changed, 1 insertion(+) diff --git a/srfi/json.sld b/srfi/json.sld index c65e8b1..7e04c8f 100644 --- a/srfi/json.sld +++ b/srfi/json.sld @@ -3,6 +3,7 @@ (export json-null? json-error? json-stream-read + json-error-reason json-read json-write) From a42fa46e90bdd3b89641d1f3365725f0b07fe690 Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Sat, 25 Jan 2020 15:20:34 +0200 Subject: [PATCH 2/6] Refactor invalid-object-value errors --- srfi/json.scm | 14 +++++++++++--- srfi/json.sld | 1 + 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/srfi/json.scm b/srfi/json.scm index 497df4d..d7b034c 100644 --- a/srfi/json.scm +++ b/srfi/json.scm @@ -6,6 +6,14 @@ json-error? (reason json-error-reason)) +(define (written obj) + (call-with-port (open-output-string) + (lambda (out) (write obj out) (get-output-string out)))) + +(define (invalid-object-value obj) + (raise (make-json-error + (string-append "Invalid object value: " (written obj) ".")))) + (define (json-whitespace? char) (assume (char? char)) (case char @@ -326,7 +334,7 @@ ;; continue! (lambda (obj) (read-object-maybe-continue callback obj k))))) - (else (raise (make-json-error "Invalid object value."))))) + (else (invalid-object-value obj)))) (define (read-object-colon callback obj k) (if (eq? obj 'colon) @@ -424,14 +432,14 @@ type obj return)))))) - (else (raise (make-json-error "Invalid object value."))))) + (else (invalid-object-value obj)))) ((json-value) (let ((value obj)) (lambda (type obj) (read-object-maybe-key (cons (cons key value) out) type obj return)))) - (else (raise (make-json-error "Invalid object value"))))) + (else (invalid-object-value obj)))) (define (read-object-maybe-key out type obj return) (case type diff --git a/srfi/json.sld b/srfi/json.sld index 7e04c8f..e74a438 100644 --- a/srfi/json.sld +++ b/srfi/json.sld @@ -11,6 +11,7 @@ (scheme case-lambda) (scheme char) (scheme text) + (scheme write) (check) (srfi 145) (srfi 151) From 7dfe61b04f343a7609c5690ea582d7f611528b0c Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Sat, 25 Jan 2020 16:28:40 +0200 Subject: [PATCH 3/6] Support nested objects in json-read Parses { "outer": { "inner": 1 } } without error. --- srfi/json.scm | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/srfi/json.scm b/srfi/json.scm index d7b034c..3923573 100644 --- a/srfi/json.scm +++ b/srfi/json.scm @@ -421,6 +421,13 @@ (case type ((json-structure) (case obj + ((object-open) + (lambda (type obj) + (read-object-maybe-key '() + type + obj + (lambda (value) + (return (cons (cons key value) out)))))) ((array-open) (lambda (type obj) (read-array '() From 5fdcf636ee7c9a7d35e4bbe9144f1c4ce1af71a2 Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Sun, 26 Jan 2020 02:16:07 +0200 Subject: [PATCH 4/6] Use cond-expand for (chibi ast) --- srfi/json.scm | 6 +++++- srfi/json.sld | 4 +++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/srfi/json.scm b/srfi/json.scm index 3923573..ff43e02 100644 --- a/srfi/json.scm +++ b/srfi/json.scm @@ -200,7 +200,11 @@ (define (%read-error? x) - (and (error-object? x) (memq (exception-kind x) '(user read read-incomplete)) #t)) + (and (error-object? x) + (cond-expand + (chibi (memq (exception-kind x) '(user read read-incomplete))) + (else #f)) + #t)) (assume (procedure? callback)) (assume (and (textual-port? port) (input-port? port))) diff --git a/srfi/json.sld b/srfi/json.sld index e74a438..1285d48 100644 --- a/srfi/json.sld +++ b/srfi/json.sld @@ -15,7 +15,9 @@ (check) (srfi 145) (srfi 151) - (chibi ast) (chibi regexp)) + (cond-expand (chibi (import (chibi ast))) + (else)) + (include "json.scm")) From 904aaa3369a764d3f64ad0b7b5b9110ef1d13b5e Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Sun, 26 Jan 2020 02:28:43 +0200 Subject: [PATCH 5/6] Support SRFI 60 for bitwise procedures Cyclone provides SRFI 60, but not 151. --- srfi/json.sld | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/srfi/json.sld b/srfi/json.sld index 1285d48..efd8f8a 100644 --- a/srfi/json.sld +++ b/srfi/json.sld @@ -14,9 +14,13 @@ (scheme write) (check) (srfi 145) - (srfi 151) (chibi regexp)) + (cond-expand ((library (srfi 60)) + (import (only (srfi 60) arithmetic-shift bitwise-ior))) + ((library (srfi 151)) + (import (only (srfi 151) arithmetic-shift bitwise-ior)))) + (cond-expand (chibi (import (chibi ast))) (else)) From 166d1a4380bc096b1484eb0b73c8cccbabbe9ce7 Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Sun, 26 Jan 2020 02:30:12 +0200 Subject: [PATCH 6/6] Clarify (chibi ast) import --- srfi/json.sld | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/srfi/json.sld b/srfi/json.sld index efd8f8a..975ea31 100644 --- a/srfi/json.sld +++ b/srfi/json.sld @@ -21,7 +21,7 @@ ((library (srfi 151)) (import (only (srfi 151) arithmetic-shift bitwise-ior)))) - (cond-expand (chibi (import (chibi ast))) + (cond-expand (chibi (import (only (chibi ast) exception-kind))) (else)) (include "json.scm"))