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.
(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)
;;; 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