(import (std text json)
	(scheme case-lambda)
	(scheme hash-table))
(begin
  (define (json-object . pairs)
    (alist->hash-table pairs eq?))

  (define json-list list)
  (define json-null (if #f #f))

  (define (json-object? obj)
    (or (hash-table? obj)
	(json-record? obj)))

  (define json-list? list?)

  (define (json-null? obj)
    (eq? obj json-null))

  (define (json-object-contains-key? json key)
    (or (and (hash-table? json)
	     (hash-table-contains? json key))
	(and (json-record? json)
	     (json-object-contains-key? (json-record->fields json) key))))

  (define string->json string->json-object)

  (define (json->string json)
    (json-object->string (json->typeless-json json)))

  (define (json-object-ref json key)
    (cond
     ((hash-table? json)
      (if (json-object-contains-key? json key)
	(hash-table-ref json key)
	((json-key-not-found))))
     ((json-record? json)
      (json-object-ref (json-record->fields json) key))
     (else ((json-key-not-found)))))

  (define (json-object-set! json key value)
    (cond
     ((and (hash-table? json)
	   (json-object-contains-key? json key))
      (hash-table-set! json key value)
      json)
     ((json-record? json)
      (or (let ((pair (assoc key (json-record->mutators json))))
	    (if pair
		(let ((mutator (cdr pair)))
		  (if mutator
		      (begin
			(mutator json value)
			json)
		      #f))
		#f))
	  (error "json-object-set!: no mutator for field" (json-record->name json) key)))))

  (define json-list-ref list-ref)
  (define json-list-length length)

  (define (json-object-map proc json)
    (define res (json-object))
    (hash-table-for-each
     (lambda (key value)
       (call-with-values (lambda () (proc key value))
	 (case-lambda
	   ((key value) (hash-table-set! res key value))
	   (_ (error "json-object-map: proc did not return two values")))))
     json)
    res)

  (define json-list-map map)

  (define (json-object->alist obj)
    (cond
     ((hash-table? obj)
      (hash-table->alist obj))
     ((json-record? obj)
      (json-object->alist (json->typeless-json obj)))
     (else (error "json-object->alist: not an object" obj))))

  (define json-list->list values))