Date: Wed, 20 Jul 2011 16:50:07 -0400
From: Austin Clements <amdragon@MIT.EDU>
To: Pieter Praet <pieter@praet.org>
Subject: JSON parsing performance (was Re: [PATCH v2] emacs: bad regexp @
	`notmuch-search-process-filter')
Message-ID: <20110720205007.GB21316@mit.edu>
References: <20110705214234.GA15360@mit.edu>
	<1310416993-31031-1-git-send-email-pieter@praet.org>
	<20110711210532.GC25558@mit.edu> <878vs28dvo.fsf@praet.org>
	<20110713185721.GI25558@mit.edu>
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="/04w6evG8XlLl3ft"
Content-Disposition: inline
In-Reply-To: <20110713185721.GI25558@mit.edu>
User-Agent: Mutt/1.5.20 (2009-06-14)
Cc: servilio <servilio@gmail.com>, Notmuch Mail <notmuch@notmuchmail.org>,
	David Edmondson <dme@dme.org>
Precedence: list


--/04w6evG8XlLl3ft
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

Quoth myself on Jul 13 at  2:57 pm:
> Quoth Pieter Praet on Jul 13 at  4:16 pm:
> > Jamie Zawinski once said/wrote [1]:
> >   'Some people, when confronted with a problem, think "I know,
> >   I'll use regular expressions." Now they have two problems.'
> > 
> > With this in mind, I set out to get rid of this whole regex mess altogether,
> > by populating the search buffer using Notmuch's JSON output instead of doing
> > brittle text matching tricks.
> > 
> > Looking for some documentation, I stumbled upon a long-forgotten gem [2].
> > 
> > David's already done pretty much all of the work for us!
> 
> Yes, similar thoughts were running through my head as I futzed with
> the formatting for this.  My concern with moving to JSON for search
> buffers is that parsing it is about *30 times slower* than the current
> regexp-based approach (0.6 seconds versus 0.02 seconds for a mere 1413
> result search buffer).  I think JSON makes a lot of sense for show
> buffers because there's generally less data and it has a lot of
> complicated structure.  Search results, on the other hand, have a very
> simple, regular, and constrained structure, so JSON doesn't buy us
> nearly as much.
> 
> JSON is hard to parse because, like the text search output, it's
> designed for human consumption (of course, unlike the text search
> output, it's also designed for computer consumption).  There's
> something to be said for the debuggability and generality of this and
> JSON is very good for exchanging small objects, but it's a remarkably
> inefficient way to exchange large amounts of data between two
> programs.
> 
> I guess what I'm getting at, though it pains me to say it, is perhaps
> search needs a fast, computer-readable interchange format.  The
> structure of the data is so simple and constrained that this could be
> altogether trivial.
> 
> Or maybe I need a faster computer.

Or maybe I need to un-lame my benchmark.

TL;DR: We should use JSON for search results, but possibly not the
json.el shipped with Emacs.

I realized that my text benchmark didn't capture the cost of
extracting the match strings.  re-search-forward records matches as
buffer positions, which don't get realized into strings until you call
match-string.  Hence, match-string is quite expensive.

Also, Emacs' json.el is slow, so I perked it up.  My modified json.el
is ~3X faster, particularly for string-heavy output like notmuch's.
Though now I'm well into the realm of "eq is faster than =" and "M-x
disassemble", so unless I missed something big, this is as fast as it
gets.

While I was still thinking about new IPC formats, I realized that the
text format and the Emacs UI are already tightly coupled, so why not
go all the way and use S-expressions for IPC?  I now think JSON is
fast enough to use, but S-expressions still have a certain appeal.
They share most of the benefits of JSON; structure and extensibility
in particular.  Further, while the content of some ad-hoc format could
easily diverge from both the text and JSON formats, S-expressions
could exactly parallel the JSON content (with a little more
abstraction, they could even share the same format code).  For kicks,
I included an S-expression benchmark.  It beats out the text parser by
a factor of two and the optimized JSON parser by a factor of three.

Here are the results for my 1,413 result search buffer and timeworn
computer

                 Time   Normalized
--format=text   0.148s     1.00x
--format=json   0.598s     4.04x
custom json.el  0.209s     1.41x
 + string keys  0.195s     1.32x
S-expressions   0.066s     0.45x

I don't have time right now, but next week I might be able to look
through and update dme's JSON-based search code.


The benchmark and modified json.el are attached.

The benchmark is written so you can open it and eval-buffer, then C-x
C-e the various calls in the comments.  You can either
make-text/make-json, or run notmuch manually, pipe the results into
files "text" and "json", and open them in Emacs.

Please excuse the modified json.el code; it's gone through zero
cleanup.

--/04w6evG8XlLl3ft
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="timeparse.el"

(defmacro time-it (repeat &rest body)
  (declare (indent 1))
  (when (not (numberp repeat))
    (push repeat body)
    (setq repeat 1))
  (let ((start-time (gensym)) (i (gensym)))
    `(let ((,start-time (get-internal-run-time)))
       (dotimes (,i ,repeat)
	 ,@body)
       (/ (float-time (time-subtract (get-internal-run-time) ,start-time))
	  ,repeat))))

;; Text

(defun make-text ()
  (with-current-buffer (get-buffer-create "text")
    (erase-buffer)
    (call-process "notmuch" nil t nil "search" "--format=text" "--" "tag:x/notmuch")))

(defun time-text ()
  (with-current-buffer "text"
    (time-it 10
      (goto-char (point-min))
      (while (re-search-forward "^\\(thread:[0-9A-Fa-f]*\\) \\([^][]*\\) \\(\\[[0-9/]*\\]\\) \\([^;]*\\); \\(.*\\) (\\([^()]*\\))$" nil t)
	(let* ((thread-id (match-string 1))
	       (date (match-string 2))
	       (count (match-string 3))
	       (authors (match-string 4))
	       (subject (match-string 5))
	       (tags (match-string 6))
	       (tag-list (if tags (save-match-data (split-string tags)))))
	  t)))))

(byte-compile 'time-text)
;; (make-text)
;; (time-text)

;; JSON

(defun load-custom-json ()
  (byte-compile-file "json.el")
  (load-file "./json.elc"))

(defun make-json ()
  (with-current-buffer (get-buffer-create "json")
    (erase-buffer)
    (call-process "notmuch" nil t nil "search" "--format=json" "--" "tag:x/notmuch")))

(defun time-json (&optional buf)
  (with-current-buffer (or buf "json")
    (let ((json-array-type 'list)
	  (json-object-type 'alist)
	  (json-key-type 'symbol))
      (time-it 10
	(goto-char (point-min))
	(dolist (ent (json-read))
	  ;; (Surprisingly, traversing the structure has no noticeable
	  ;; impact to performance)
	  (let ((thread-id (assq 'thread ent))
		(date (assq 'timestamp ent))
		(matched (assq 'matched ent))
		(total (assq 'total ent))
		(authors (assq 'authors ent))
		(subject (assq 'subject ent))
		(tag-list (assq 'tags ent)))
	    t))))))

(defun time-json-string-keys (&optional buf)
  (with-current-buffer (or buf "json")
    (let ((json-array-type 'list)
	  (json-object-type 'alist)
	  (json-key-type 'string))
      (time-it 10
	(goto-char (point-min))
	(dolist (ent (json-read))
	  (let ((thread-id (assoc "thread" ent))
		(date (assoc "timestamp" ent))
		(matched (assoc "matched" ent))
		(total (assoc "total" ent))
		(authors (assoc "authors" ent))
		(subject (assoc "subject" ent))
		(tag-list (assoc "tags" ent)))
	    t))))))

(byte-compile 'time-json)
(byte-compile 'time-json-string-keys)
;; (make-json)
;; (time-json)
;; (time-json-string-keys)
;; (load-custom-json)

;; S-expression

(defun make-sexp ()
  (with-current-buffer (get-buffer-create "sexp")
    (erase-buffer))
  (print
   (with-current-buffer "json"
     (let ((json-array-type 'list)
	   (json-object-type 'alist)
	   (json-key-type 'symbol))
       (goto-char (point-min))
       (json-read)))
   (get-buffer "sexp"))
  t)

(defun time-sexp ()
  (with-current-buffer "sexp"
    (let ((buf (current-buffer)))
      (time-it 10 (goto-char (point-min)) (read buf)))))

(byte-compile 'time-sexp)
;; (make-sexp)
;; (time-sexp)

;; Packed JSON

(defun make-packed-json ()
  (let ((buf (get-buffer-create "packed-json")))
    (with-current-buffer "json"
      (copy-to-buffer buf (point-min) (point-max)))
    (with-current-buffer buf
      (while (re-search-forward "^\\([^\"]*\"[^\"]+\"\\): \\([[\"0-9]\\)" nil t)
	(replace-match "\\1:\\2" nil nil))
      (goto-char (point-min))
      (while (re-search-forward "\\([\"0-9]\\),\n" nil t)
	(replace-match "\\1," nil nil)))))

(defun time-packed-json ()
  (time-json "packed-json"))

;; (make-packed-json)
;; (time-packed-json)

--/04w6evG8XlLl3ft
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="json.el"

;;; json.el --- JavaScript Object Notation parser / generator

;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.

;; Author: Edward O'Connor <ted@oconnor.cx>
;; Version: 1.2
;; Keywords: convenience

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This is a library for parsing and generating JSON (JavaScript Object
;; Notation).

;; Learn all about JSON here: <URL:http://json.org/>.

;; The user-serviceable entry points for the parser are the functions
;; `json-read' and `json-read-from-string'. The encoder has a single
;; entry point, `json-encode'.

;; Since there are several natural representations of key-value pair
;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
;; to specify which you'd prefer (see `json-object-type' and
;; `json-array-type').

;; Similarly, since `false' and `null' are distinct in JSON, you can
;; distinguish them by binding `json-false' and `json-null' as desired.

;;; History:

;; 2011-07-20 - Optimized by Austin Clements <aclements@csail.mit.edu>.
;; 2006-03-11 - Initial version.
;; 2006-03-13 - Added JSON generation in addition to parsing. Various
;;              other cleanups, bugfixes, and improvements.
;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>.
;; 2008-02-21 - Installed in GNU Emacs.

;;; Code:

(eval-when-compile (require 'cl))

;; Compatibility code

(defalias 'json-encode-char0 'encode-char)
(defalias 'json-decode-char0 'decode-char)


;; Parameters

(defvar json-object-type 'alist
  "Type to convert JSON objects to.
Must be one of `alist', `plist', or `hash-table'.  Consider let-binding
this around your call to `json-read' instead of `setq'ing it.")

(defvar json-array-type 'vector
  "Type to convert JSON arrays to.
Must be one of `vector' or `list'.  Consider let-binding this around
your call to `json-read' instead of `setq'ing it.")

(defvar json-key-type nil
  "Type to convert JSON keys to.
Must be one of `string', `symbol', `keyword', or nil.

If nil, `json-read' will guess the type based on the value of
`json-object-type':

    If `json-object-type' is:   nil will be interpreted as:
      `hash-table'                `string'
      `alist'                     `symbol'
      `plist'                     `keyword'

Note that values other than `string' might behave strangely for
Sufficiently Weird keys.  Consider let-binding this around your call to
`json-read' instead of `setq'ing it.")

(defvar json-false :json-false
  "Value to use when reading JSON `false'.
If this has the same value as `json-null', you might not be able to tell
the difference between `false' and `null'.  Consider let-binding this
around your call to `json-read' instead of `setq'ing it.")

(defvar json-null nil
  "Value to use when reading JSON `null'.
If this has the same value as `json-false', you might not be able to
tell the difference between `false' and `null'.  Consider let-binding
this around your call to `json-read' instead of `setq'ing it.")




;;; Utilities

(defun json-join (strings separator)
  "Join STRINGS with SEPARATOR."
  (mapconcat 'identity strings separator))

(defun json-alist-p (list)
  "Non-null if and only if LIST is an alist."
  (or (null list)
      (and (consp (car list))
           (json-alist-p (cdr list)))))

(defun json-plist-p (list)
  "Non-null if and only if LIST is a plist."
  (or (null list)
      (and (keywordp (car list))
           (consp (cdr list))
           (json-plist-p (cddr list)))))

;; Reader utilities

;; (defsubst json-advance (&optional n)
;;   "Skip past the following N characters."
;;   (forward-char n))

(defalias 'json-advance 'forward-char)

;; (defsubst json-peek ()
;;   "Return the character at point."
;;   (let ((char (char-after (point))))
;;     (or char :json-eof)))

(defsubst json-peek ()
  "Return the character at point."
  (or (char-after) :json-eof))

(defsubst json-pop ()
  "Advance past the character at point, returning it."
  (let ((char (json-peek)))
    (if (eq char :json-eof)
        (signal 'end-of-file nil)
      (json-advance)
      char)))

;; (defun json-skip-whitespace ()
;;   "Skip past the whitespace at point."
;;   (skip-chars-forward "\t\r\n\f\b "))

(defsubst json-skip-whitespace ()
  "Skip past the whitespace at point."
  (skip-chars-forward "\t\r\n\f\b "))




;; Error conditions

(put 'json-error 'error-message "Unknown JSON error")
(put 'json-error 'error-conditions '(json-error error))

(put 'json-readtable-error 'error-message "JSON readtable error")
(put 'json-readtable-error 'error-conditions
     '(json-readtable-error json-error error))

(put 'json-unknown-keyword 'error-message "Unrecognized keyword")
(put 'json-unknown-keyword 'error-conditions
     '(json-unknown-keyword json-error error))

(put 'json-number-format 'error-message "Invalid number format")
(put 'json-number-format 'error-conditions
     '(json-number-format json-error error))

(put 'json-string-escape 'error-message "Bad unicode escape")
(put 'json-string-escape 'error-conditions
     '(json-string-escape json-error error))

(put 'json-string-format 'error-message "Bad string format")
(put 'json-string-format 'error-conditions
     '(json-string-format json-error error))

(put 'json-object-format 'error-message "Bad JSON object")
(put 'json-object-format 'error-conditions
     '(json-object-format json-error error))




;;; Keywords

(defvar json-keywords '("true" "false" "null")
  "List of JSON keywords.")

;; Keyword parsing

(defun json-read-keyword (keyword)
  "Read a JSON keyword at point.
KEYWORD is the keyword expected."
  (unless (member keyword json-keywords)
    (signal 'json-unknown-keyword (list keyword)))
  (mapc (lambda (char)
          (unless (char-equal char (json-peek))
            (signal 'json-unknown-keyword
                    (list (save-excursion
                            (backward-word 1)
                            (thing-at-point 'word)))))
          (json-advance))
        keyword)
  (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
    (signal 'json-unknown-keyword
            (list (save-excursion
                    (backward-word 1)
                    (thing-at-point 'word)))))
  (cond ((string-equal keyword "true") t)
        ((string-equal keyword "false") json-false)
        ((string-equal keyword "null") json-null)))

;; Keyword encoding

(defun json-encode-keyword (keyword)
  "Encode KEYWORD as a JSON value."
  (cond ((eq keyword t)          "true")
        ((eq keyword json-false) "false")
        ((eq keyword json-null)  "null")))

;;; Numbers

;; Number parsing

;; (defun json-read-number (&optional sign)
;;  "Read the JSON number following point.
;; The optional SIGN argument is for internal use.

;; N.B.: Only numbers which can fit in Emacs Lisp's native number
;; representation will be parsed correctly."
;;  ;; If SIGN is non-nil, the number is explicitly signed.
;;  (let ((number-regexp
;;         "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
;;    (cond ((and (null sign) (char-equal (json-peek) ?-))
;;           (json-advance)
;;           (- (json-read-number t)))
;;          ((and (null sign) (char-equal (json-peek) ?+))
;;           (json-advance)
;;           (json-read-number t))
;;          ((and (looking-at number-regexp)
;;                (or (match-beginning 1)
;;                    (match-beginning 2)))
;;           (goto-char (match-end 0))
;;           (string-to-number (match-string 0)))
;;          (t (signal 'json-number-format (list (point)))))))

(defun json-read-number ()
 "Read the JSON number following point.

N.B.: Only numbers which can fit in Emacs Lisp's native number
representation will be parsed correctly."
 ;; This regexp requires one character of backtrack in the common case
 ;; of a whole number, but is slightly faster than a more explicit
 ;; regexp like "\\([0-9]+\\)?\\(\\.[0-9]+\\)?"
 (if (looking-at "[-+]?[0-9]*[.0-9][0-9]*\\([Ee][+-]?[0-9]+\\)?")
     (progn
       (goto-char (match-end 0))
       (string-to-number (match-string 0)))
   (signal 'json-number-format (list (point)))))

;; Number encoding

(defun json-encode-number (number)
  "Return a JSON representation of NUMBER."
  (format "%s" number))

;;; Strings

(defvar json-special-chars
  '((?\" . ?\")
    (?\\ . ?\\)
    (?/ . ?/)
    (?b . ?\b)
    (?f . ?\f)
    (?n . ?\n)
    (?r . ?\r)
    (?t . ?\t))
  "Characters which are escaped in JSON, with their elisp counterparts.")

;; String parsing

(defun json-read-escaped-char ()
  "Read the JSON string escaped character at point."
  ;; Skip over the '\'
  (json-advance)
  (let* ((char (json-pop))
         (special (assq char json-special-chars)))
    (cond
     (special (cdr special))
     ((not (eq char ?u)) char)
     ((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
      (let ((hex (match-string 0)))
        (json-advance 4)
        (json-decode-char0 'ucs (string-to-number hex 16))))
     (t
      (signal 'json-string-escape (list (point)))))))

;; (defun json-read-string ()
;;   "Read the JSON string at point."
;;   (unless (char-equal (json-peek) ?\")
;;     (signal 'json-string-format (list "doesn't start with '\"'!")))
;;   ;; Skip over the '"'
;;   (json-advance)
;;   (let ((characters '())
;;         (char (json-peek)))
;;     (while (not (char-equal char ?\"))
;;       (push (if (char-equal char ?\\)
;;                 (json-read-escaped-char)
;;               (json-pop))
;;             characters)
;;       (setq char (json-peek)))
;;     ;; Skip over the '"'
;;     (json-advance)
;;     (if characters
;;         (apply 'string (nreverse characters))
;;       "")))

;; Really matters
(defun json-read-string ()
  "Read the JSON string at point."
;;  (unless (char-equal (json-peek) ?\")
;;    (signal 'json-string-format (list "doesn't start with '\"'!")))
  ;; Skip over the '"'
  (json-advance)
  (let ((parts '()) (more t))
    (while more
      (let ((start (point)))
	(when (> (skip-chars-forward "^\\\\\"") 0)
	  (push (buffer-substring-no-properties start (point)) parts)))
      ;; Helps a little
      (let ((char (char-after)))
	(cond ((eq char ?\") (json-advance) (setq more nil))
	      ((eq char ?\\) (push (string (json-read-escaped-char)) parts))
	      (t (error "XXX Unterminated string")))))
      ;; (let ((char (json-peek)))
      ;; 	(case char
      ;; 	  ((?\") (json-advance) (setq done t))
      ;; 	  ((?\\) (push (string (json-read-escaped-char)) parts))
      ;; 	  (t     (error "XXX Unterminated string")))))
    (if parts
	(if (cdr parts)
	    (apply 'concat (nreverse parts))
	  (car parts))
      "")))

;; String encoding

(defun json-encode-char (char)
  "Encode CHAR as a JSON string."
  (setq char (json-encode-char0 char 'ucs))
  (let ((control-char (car (rassoc char json-special-chars))))
    (cond
     ;; Special JSON character (\n, \r, etc.)
     (control-char
      (format "\\%c" control-char))
     ;; ASCIIish printable character
     ((and (> char 31) (< char 161))
      (format "%c" char))
     ;; Fallback: UCS code point in \uNNNN form
     (t
      (format "\\u%04x" char)))))

(defun json-encode-string (string)
  "Return a JSON representation of STRING."
  (format "\"%s\"" (mapconcat 'json-encode-char string "")))

;;; JSON Objects

(defun json-new-object ()
  "Create a new Elisp object corresponding to a JSON object.
Please see the documentation of `json-object-type'."
  (cond ((eq json-object-type 'hash-table)
         (make-hash-table :test 'equal))
        (t
         (list))))

(defun json-add-to-object (object key value)
  "Add a new KEY -> VALUE association to OBJECT.
Returns the updated object, which you should save, e.g.:
    (setq obj (json-add-to-object obj \"foo\" \"bar\"))
Please see the documentation of `json-object-type' and `json-key-type'."
  (let ((json-key-type
         (if (eq json-key-type nil)
             (cdr (assq json-object-type '((hash-table . string)
                                           (alist . symbol)
                                           (plist . keyword))))
           json-key-type)))
    (setq key
          (cond ((eq json-key-type 'string)
                 key)
                ((eq json-key-type 'symbol)
                 (intern key))
                ((eq json-key-type 'keyword)
                 (intern (concat ":" key)))))
    (cond ((eq json-object-type 'hash-table)
           (puthash key value object)
           object)
          ((eq json-object-type 'alist)
           (cons (cons key value) object))
          ((eq json-object-type 'plist)
           (cons key (cons value object))))))

;; JSON object parsing

;; (defun json-read-object ()
;;   "Read the JSON object at point."
;;   ;; Skip over the "{"
;;   (json-advance)
;;   (json-skip-whitespace)
;;   ;; read key/value pairs until "}"
;;   (let ((elements (json-new-object))
;;         key value)
;;     (while (not (char-equal (json-peek) ?}))
;;       (json-skip-whitespace)
;;       (setq key (json-read-string))
;;       (json-skip-whitespace)
;;       (if (char-equal (json-peek) ?:)
;;           (json-advance)
;;         (signal 'json-object-format (list ":" (json-peek))))
;;       (setq value (json-read))
;;       (setq elements (json-add-to-object elements key value))
;;       (json-skip-whitespace)
;;       (unless (char-equal (json-peek) ?})
;;         (if (char-equal (json-peek) ?,)
;;             (json-advance)
;;           (signal 'json-object-format (list "," (json-peek))))))
;;     ;; Skip over the "}"
;;     (json-advance)
;;     elements))


(defun json-read-object ()
  "Read the JSON object at point."
  ;; Skip over the "{"
  (json-advance)
  (json-skip-whitespace)
  ;; read key/value pairs until "}"
  (let ((elements (json-new-object))
        key value (more t))
    (unless (eq (char-after) ?})
;;    (while (not (eq (char-after) ?}))
      (while more
	(unless (eq (char-after) ?\")
	  (json-skip-whitespace)
	  (unless (eq (char-after) ?\")
	    (signal 'json-string-format (list "doesn't start with '\"'!"))))
      (setq key (json-read-string))
      ;; Makes a small but surprising difference, adds up if done
      ;; consistently
      (if (eq (char-after) ?:)
          (json-advance)
	(if (progn (json-skip-whitespace) (eq (char-after) ?:))
	    (json-advance)
	  (signal 'json-object-format (list ":" (json-peek)))))
      (setq value (json-read))
      (setq elements (json-add-to-object elements key value))
      ;; Order matters a little
      (cond ((eq (char-after) ?,) (json-advance))
      	    ((eq (char-after) ?}) (setq more nil))
      	    ((progn
      	       (json-skip-whitespace)
      	       (eq (char-after) ?,)) (json-advance))
      	    ((eq (char-after) ?}) (setq more nil))
      	    (t (signal 'json-object-format (list "," (json-peek)))))))
      ;; (unless (char-equal (json-peek) ?})
      ;;   (if (char-equal (json-peek) ?,)
      ;;       (json-advance)
      ;;     (signal 'json-object-format (list "," (json-peek))))))
    ;; Skip over the "}"
    (json-advance)
    elements))

;; Hash table encoding

(defun json-encode-hash-table (hash-table)
  "Return a JSON representation of HASH-TABLE."
  (format "{%s}"
          (json-join
           (let (r)
             (maphash
              (lambda (k v)
                (push (format "%s:%s"
                              (json-encode k)
                              (json-encode v))
                      r))
              hash-table)
             r)
           ", ")))

;; List encoding (including alists and plists)

(defun json-encode-alist (alist)
  "Return a JSON representation of ALIST."
  (format "{%s}"
          (json-join (mapcar (lambda (cons)
                               (format "%s:%s"
                                       (json-encode (car cons))
                                       (json-encode (cdr cons))))
                             alist)
                     ", ")))

(defun json-encode-plist (plist)
  "Return a JSON representation of PLIST."
  (let (result)
    (while plist
      (push (concat (json-encode (car plist))
                    ":"
                    (json-encode (cadr plist)))
            result)
      (setq plist (cddr plist)))
    (concat "{" (json-join (nreverse result) ", ") "}")))

(defun json-encode-list (list)
  "Return a JSON representation of LIST.
Tries to DWIM: simple lists become JSON arrays, while alists and plists
become JSON objects."
  (cond ((null list)         "null")
        ((json-alist-p list) (json-encode-alist list))
        ((json-plist-p list) (json-encode-plist list))
        ((listp list)        (json-encode-array list))
        (t
         (signal 'json-error (list list)))))

;;; Arrays

;; Array parsing

;; (defun json-read-array ()
;;   "Read the JSON array at point."
;;   ;; Skip over the "["
;;   (json-advance)
;;   (json-skip-whitespace)
;;   ;; read values until "]"
;;   (let (elements)
;;     (while (not (char-equal (json-peek) ?\]))
;;       (push (json-read) elements)
;;       (json-skip-whitespace)
;;       (unless (char-equal (json-peek) ?\])
;;         (if (char-equal (json-peek) ?,)
;;             (json-advance)
;;           (signal 'json-error (list 'bleah)))))
;;     ;; Skip over the "]"
;;     (json-advance)
;;     (apply json-array-type (nreverse elements))))

(defun json-read-array ()
  "Read the JSON array at point."
  ;; Skip over the "["
  (json-advance)
  (json-skip-whitespace)
  ;; read values until "]"
  (let* (elements (more t))
    (unless (eq (char-after) ?\])
      (while more
;;    (while (not (char-equal (json-peek) ?\]))
      (push (json-read) elements)
      ;; Doesn't help
;;	(setq tail (setcdr tail (cons (json-read) nil)))

;;      (json-skip-whitespace)
      (cond ((eq (char-after) ?,) (json-advance))
	    ((eq (char-after) ?\]) (setq more nil))
	    ((progn
	       (json-skip-whitespace)
	       (eq (char-after) ?,)) (json-advance))
	    ((eq (char-after) ?\]) (setq more nil))
	    (t (signal 'json-error (list 'bleah))))))
      ;; (unless (char-equal (json-peek) ?\])
      ;;   (if (char-equal (json-peek) ?,)
      ;;       (json-advance)
      ;;     (signal 'json-error (list 'bleah))))))
    ;; Skip over the "]"
    (json-advance)
    ;; Matters
    (if (eq json-array-type 'list)
	(nreverse elements)
      (apply json-array-type (nreverse elements)))))

;; Array encoding

(defun json-encode-array (array)
  "Return a JSON representation of ARRAY."
  (concat "[" (mapconcat 'json-encode array ", ") "]"))




;;; JSON reader.

;; (defvar json-readtable
;;   (let ((table
;;          '((?t json-read-keyword "true")
;;            (?f json-read-keyword "false")
;;            (?n json-read-keyword "null")
;;            (?{ json-read-object)
;;            (?\[ json-read-array)
;;            (?\" json-read-string))))
;;     (mapc (lambda (char)
;;             (push (list char 'json-read-number) table))
;;           '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
;;     table)
;;   "Readtable for JSON reader.")

;; (defun json-read ()
;;   "Parse and return the JSON object following point.
;; Advances point just past JSON object."
;;   (json-skip-whitespace)
;;   (let ((char (json-peek)))
;;     (if (not (eq char :json-eof))
;;         (let ((record (cdr (assq char json-readtable))))
;;           (if (functionp (car record))
;;               (apply (car record) (cdr record))
;;             (signal 'json-readtable-error record)))
;;       (signal 'end-of-file nil))))

(defvar my-json-readtable
  (let ((table (make-char-table nil)))
    (aset table ?t '(json-read-keyword "true"))
    (aset table ?f '(json-read-keyword "false"))
    (aset table ?n '(json-read-keyword "null"))
    (aset table ?{ '(json-read-object))
    (aset table ?\[ '(json-read-array))
    (aset table ?\" '(json-read-string))
    (mapc (lambda (char)
	    (aset table char '(json-read-number)))
	  '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
    table)
  "Readtable for JSON reader.")

;; Char-table matters a bit; (if (null ..)) matters more
;; (defun json-read ()
;;   "Parse and return the JSON object following point.
;; Advances point just past JSON object."
;;   (json-skip-whitespace)
;;   (let ((char (json-peek)))
;;     (if (not (eq char :json-eof))
;; 	(let ((record (aref my-json-readtable char)))
;; 	  (if (null (car record))
;; 	      (signal 'json-readtable-error record)
;; 	    (apply (car record) (cdr record))))
;;       (signal 'end-of-file nil))))

;; Makes no difference or slower, probably because there's usually whitespace
;; (defun json-read ()
;;   "Parse and return the JSON object following point.
;; Advances point just past JSON object."
;;   (let ((record (and (char-after) (aref my-json-readtable (char-after)))))
;;     (when (null record)
;;       (json-skip-whitespace)
;;       (when (eobp)
;; 	(signal 'end-of-file nil))
;;       (setq record (aref my-json-readtable (char-after)))
;;       (when (null record)
;; 	(signal 'json-readtable-error record)))
;;     (apply (car record) (cdr record))))

;; Makes a difference
(defun json-read ()
  "Parse and return the JSON object following point.
Advances point just past JSON object."
  (json-skip-whitespace)
  (if (char-after)
      (let ((record (aref my-json-readtable (char-after))))
	(if record
	    (apply (car record) (cdr record))
	  (signal 'json-readtable-error record)))
    (signal 'end-of-file nil)))

;; Syntactic sugar for the reader

(defun json-read-from-string (string)
  "Read the JSON object contained in STRING and return it."
  (with-temp-buffer
    (insert string)
    (goto-char (point-min))
    (json-read)))

(defun json-read-file (file)
  "Read the first JSON object contained in FILE and return it."
  (with-temp-buffer
    (insert-file-contents file)
    (goto-char (point-min))
    (json-read)))




;;; JSON encoder

(defun json-encode (object)
  "Return a JSON representation of OBJECT as a string."
  (cond ((memq object (list t json-null json-false))
         (json-encode-keyword object))
        ((stringp object)      (json-encode-string object))
        ((keywordp object)     (json-encode-string
                                (substring (symbol-name object) 1)))
        ((symbolp object)      (json-encode-string
                                (symbol-name object)))
        ((numberp object)      (json-encode-number object))
        ((arrayp object)       (json-encode-array object))
        ((hash-table-p object) (json-encode-hash-table object))
        ((listp object)        (json-encode-list object))
        (t                     (signal 'json-error (list object)))))

(provide 'json)

;; arch-tag: 15f6e4c8-b831-4172-8749-bbc680c50ea1
;;; json.el ends here

--/04w6evG8XlLl3ft--