Work on the implementation

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
@@ -192,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)))
@@ -326,7 +338,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)
@@ -413,6 +425,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 '()
@@ -424,14 +443,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

srfi/json.sld

@@ -3,17 +3,25 @@
   (export json-null?
           json-error?
           json-stream-read
+          json-error-reason
           json-read
           json-write)
 
   (import (scheme base)
           (scheme case-lambda)
           (scheme char)
           (scheme text)
+          (scheme write)
           (check)
           (srfi 145)
-          (srfi 151)
-          (chibi ast)
           (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 (only (chibi ast) exception-kind)))
+               (else))
+
   (include "json.scm"))