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