8 files changed, 283 insertions, 0 deletions
diff --git a/lib/zambyte/meta/180.scm b/lib/zambyte/meta/180.scm
new file mode 100644
index 0000000..735a895
--- /dev/null
+++ b/lib/zambyte/meta/180.scm
@@ -0,0 +1,40 @@
+(import (except (srfi 180) json-null)
+	(srfi 1)
+	(srfi 2))
+(begin
+  (define (string->json str)
+    (call-with-port (open-input-string str)
+      (lambda (port)
+	(json-read port))))
+
+  (define (json->string json)
+    (call-with-port (open-output-string)
+      (lambda (port)
+	(json-write json port)
+	(get-output-string port))))
+
+  (define (json-object . pairs)
+    (map
+     (lambda (pair)
+       (cons (string->symbol (car pair)) (cdr pair)))
+     pairs))
+
+  (define json-list vector)
+  (define json-null 'null)
+  (define json-object? list?)
+  (define json-list? vector?)
+  ;; json-null? already defined in srfi 180
+
+  (define (json-object-ref json key)
+    (and-let* ((pair (assoc (string->symbol key) json)))
+      (cdr pair)))
+
+  (define json-list-ref vector-ref)
+
+  (define (json-object->alist json)
+    (map
+     (lambda (pair)
+       (cons (symbol->string (car pair)) (cdr pair)))
+     json))
+
+  (define (json-list->list vector->list)))
diff --git a/lib/zambyte/meta/chibi.scm b/lib/zambyte/meta/chibi.scm
new file mode 100644
index 0000000..49f72f6
--- /dev/null
+++ b/lib/zambyte/meta/chibi.scm
@@ -0,0 +1,34 @@
+(import (chibi json)
+	(srfi 1)
+	(srfi 2))
+(begin
+  ;; json->string already defined in chibi json
+  ;; string->json already defined in chibi json
+
+  (define (json-object . pairs)
+    (map
+     (lambda (pair)
+       (cons (string->symbol (car pair)) (cdr pair)))
+     pairs))
+
+  (define json-list vector)
+  (define json-null (if #f #f))
+  (define json-object? list?)
+  (define json-list? vector?)
+
+  (define (json-null? obj)
+    (eq? obj json-null))
+
+  (define (json-object-ref json key)
+    (and-let* ((pair (assoc (string->symbol key) json)))
+      (cdr pair)))
+
+  (define json-list-ref vector-ref)
+
+  (define (json-object->alist json)
+    (map
+     (lambda (pair)
+       (cons (symbol->string (car pair)) (cdr pair)))
+     json))
+
+  (define json-list->list vector->list))
diff --git a/lib/zambyte/meta/gauche.scm b/lib/zambyte/meta/gauche.scm
new file mode 100644
index 0000000..733599a
--- /dev/null
+++ b/lib/zambyte/meta/gauche.scm
@@ -0,0 +1,32 @@
+(import (gauche base)
+	(rfc json)
+	(srfi 1))
+(begin
+  (define array-handler list->vector)
+  (define object-handler identity)
+  (define (special-handler x)
+    (case x
+      ((true) #t)
+      ((false) #f)
+      (else => identity)))
+
+  (define (string->json str)
+    (parameterize ((json-array-handler array-handler)
+		   (json-object-handler object-handler)
+		   (json-special-handler special-handler))
+      (parse-json-string str)))
+
+  (define json->string construct-json-string)
+  (define json-object list)
+  (define json-list vector)
+  (define json-null 'null)
+  (define json-object? list?)
+  (define json-list? vector?)
+
+  (define (json-null? obj)
+    (eq? obj json-null))
+
+  (define json-object-ref assoc-ref)
+  (define json-list-ref vector-ref)
+  (define json-object->alist identity)
+  (define json-list->list vector->list))
diff --git a/lib/zambyte/meta/gerbil.scm b/lib/zambyte/meta/gerbil.scm
new file mode 100644
index 0000000..00f7b0e
--- /dev/null
+++ b/lib/zambyte/meta/gerbil.scm
@@ -0,0 +1,23 @@
+(import (std text json)
+	(scheme hash-table))
+(begin
+  (define string->json string->json-object)
+  (define json->string json-object->string)
+
+  (define (json-object . pairs)
+    (alist->hash-table pairs equal?))
+
+  (define json-list list)
+  (define json-null #!void)
+  (define json-object? hash-table?)
+  (define json-list? list?)
+
+  (define (json-null? obj)
+    (eq? obj json-null))
+
+  (define (json-object-ref json key)
+    (hash-table-ref json (string->symbol key)))
+
+  (define json-list-ref list-ref)
+  (define json-object->alist hash-table->alist)
+  (define json-list->list values))
diff --git a/lib/zambyte/meta/guile.scm b/lib/zambyte/meta/guile.scm
new file mode 100644
index 0000000..cbd998b
--- /dev/null
+++ b/lib/zambyte/meta/guile.scm
@@ -0,0 +1,22 @@
+(import (json)
+	(srfi 1)
+	(srfi 2))
+(begin
+  (define string->json json-string->scm)
+  (define json->string scm->json-string)
+  (define json-object list)
+  (define json-list vector)
+  (define json-null 'null)
+  (define json-object? list?)
+  (define json-list? vector?)
+
+  (define (json-null? obj)
+    (eq? obj json-null))
+
+  (define (json-object-ref json key)
+    (and-let* ((pair (assoc key json)))
+      (cdr pair)))
+
+  (define json-list-ref vector-ref)
+  (define json-object->alist values)
+  (define json-list->list vector->list))
diff --git a/lib/zambyte/meta/json.sld b/lib/zambyte/meta/json.sld
new file mode 100644
index 0000000..0313516
--- /dev/null
+++ b/lib/zambyte/meta/json.sld
@@ -0,0 +1,57 @@
+(define-library (zambyte meta json)
+  ;; portable
+  (export json-ref
+	  json-value?)
+  ;; non-portable
+  (export string->json
+	  json->string
+
+	  json-object
+	  json-list
+	  json-null
+
+	  json-object?
+	  json-list?
+	  json-null?
+
+	  json-object-ref
+	  json-list-ref
+
+	  json-object->alist
+	  json-list->list)
+  (import (scheme base))
+  ;; portable
+  (begin
+    (define (json-ref json key . keys)
+      (let ((ref (cond ((json-object? json) json-object-ref)
+		       ((json-list? json) json-list-ref)
+		       (else (error "json-ref: cannot get reference on json value" json)))))
+	(if (null? keys)
+	    (ref json key)
+	    (apply json-ref (ref json key) keys))))
+
+    (define (json-value? obj)
+      (or (boolean? obj)
+	  (number? obj)
+	  (string? obj)
+	  (json-null? obj)
+	  (json-list? obj)
+	  (json-object? obj))))
+  ;; non-portable
+  (cond-expand
+   ((and (library (macduffie json)) (srfi 69))
+    (include-library-declarations "macduffie.scm"))
+   ((and guile (library (json)))
+    (include-library-declarations "guile.scm"))
+   (gauche
+    (include-library-declarations "gauche.scm"))
+   (gerbil
+    (include-library-declarations "gerbil.scm"))
+   (sagittarius
+    (include-library-declarations "sagittarius.scm"))
+   ((library (chibi json))
+    (include-library-declarations "chibi.scm"))
+   ((library (srfi 180))
+    (include-library-declarations "180.scm"))
+   (else
+    (error "No implementation of JSON library available."))))
diff --git a/lib/zambyte/meta/macduffie.scm b/lib/zambyte/meta/macduffie.scm
new file mode 100644
index 0000000..f80ea18
--- /dev/null
+++ b/lib/zambyte/meta/macduffie.scm
@@ -0,0 +1,19 @@
+(import (rename (macduffie json)
+		(json-null md:json-null))
+	(srfi 69))
+(begin
+  (define string->json json-read-string)
+  (define json->string json-write-string)
+
+  (define (json-object . pairs)
+    (alist->hash-table pairs))
+
+  (define json-list list)
+  (define json-null (md:json-null))
+  (define json-object? hash-table?)
+  (define json-list? list?)
+  ;; json-null? already defined in macduffie json
+  (define json-object-ref hash-table-ref)
+  (define json-list-ref list-ref)
+  (define json-object->alist hash-table->alist)
+  (define json-list->list values))
diff --git a/lib/zambyte/meta/sagittarius.scm b/lib/zambyte/meta/sagittarius.scm
new file mode 100644
index 0000000..3b5a741
--- /dev/null
+++ b/lib/zambyte/meta/sagittarius.scm
@@ -0,0 +1,56 @@
+(import (text json)
+	(srfi 1)
+	(srfi 2))
+(begin
+  (define (string->json str)
+    (call-with-port (open-input-string str)
+      (lambda (port)
+	(json-read port))))
+
+  (define (json->string json)
+    (call-with-port (open-output-string)
+      (lambda (port)
+	(json-write json port)
+	(get-output-string port))))
+
+  (define (json-object . pairs)
+    (if (eq? (*json-map-type*) 'vector)
+	(apply vector pairs)
+	(apply list pairs)))
+
+  (define (json-list . objs)
+    (if (eq? (*json-map-type*) 'vector)
+	(apply list objs)
+	(apply vector objs)))
+
+  (define json-null 'null)
+
+  (define (json-object? json)
+    (if (eq? (*json-map-type*) 'vector)
+	(vector? json)
+	(list? json)))
+
+  (define (json-list? json)
+    (if (eq? (*json-map-type*) 'vector)
+	(list? json)
+	(vector? json)))
+
+  (define (json-null? obj)
+    (eq? obj json-null))
+
+  (define (json-object-ref json key)
+    (and-let* ((pair (assoc key (json-object->alist json))))
+      (cdr pair)))
+
+  (define (json-list-ref json index)
+    (list-ref (json-list->list json) index))
+
+  (define (json-object->alist json)
+    (if (eq? (*json-map-type*) 'vector)
+	(vector->list json)
+	json))
+
+  (define (json-list->list json)
+    (if (eq? (*json-map-type*) 'vector)
+	json
+	(vector->list json))))