From 5988143185c3a658e1d90ee28b3eb60e63d77783 Mon Sep 17 00:00:00 2001 From: Austin Clements Date: Fri, 31 May 2013 13:13:35 +2000 Subject: [PATCH] [PATCH v2 4/5] emacs: Streaming S-expression parser --- 67/afc98b4f43cedad2aa061876d60d5d539943c5 | 324 ++++++++++++++++++++++ 1 file changed, 324 insertions(+) create mode 100644 67/afc98b4f43cedad2aa061876d60d5d539943c5 diff --git a/67/afc98b4f43cedad2aa061876d60d5d539943c5 b/67/afc98b4f43cedad2aa061876d60d5d539943c5 new file mode 100644 index 000000000..d3b7842b3 --- /dev/null +++ b/67/afc98b4f43cedad2aa061876d60d5d539943c5 @@ -0,0 +1,324 @@ +Return-Path: +X-Original-To: notmuch@notmuchmail.org +Delivered-To: notmuch@notmuchmail.org +Received: from localhost (localhost [127.0.0.1]) + by olra.theworths.org (Postfix) with ESMTP id 19937431FDE + for ; Thu, 30 May 2013 10:14:03 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at olra.theworths.org +X-Spam-Flag: NO +X-Spam-Score: -0.7 +X-Spam-Level: +X-Spam-Status: No, score=-0.7 tagged_above=-999 required=5 + tests=[RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled +Received: from olra.theworths.org ([127.0.0.1]) + by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) + with ESMTP id VsXe0Zi031BZ for ; + Thu, 30 May 2013 10:13:53 -0700 (PDT) +Received: from dmz-mailsec-scanner-3.mit.edu (dmz-mailsec-scanner-3.mit.edu + [18.9.25.14]) + by olra.theworths.org (Postfix) with ESMTP id 979CB431FC2 + for ; Thu, 30 May 2013 10:13:46 -0700 (PDT) +X-AuditID: 1209190e-b7f4f6d000005142-57-51a788cabd5d +Received: from mailhub-auth-4.mit.edu ( [18.7.62.39]) + by dmz-mailsec-scanner-3.mit.edu (Symantec Messaging Gateway) with SMTP + id F4.BD.20802.AC887A15; Thu, 30 May 2013 13:13:46 -0400 (EDT) +Received: from outgoing.mit.edu (outgoing-auth-1.mit.edu [18.9.28.11]) + by mailhub-auth-4.mit.edu (8.13.8/8.9.2) with ESMTP id r4UHDgxD001633; + Thu, 30 May 2013 13:13:43 -0400 +Received: from drake.dyndns.org (c-76-21-105-205.hsd1.ca.comcast.net + [76.21.105.205]) (authenticated bits=0) + (User authenticated as amdragon@ATHENA.MIT.EDU) + by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id r4UHDdTG009865 + (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT); + Thu, 30 May 2013 13:13:41 -0400 +Received: from amthrax by drake.dyndns.org with local (Exim 4.77) + (envelope-from ) + id 1Ui6Py-0005r6-F6; Thu, 30 May 2013 13:13:38 -0400 +From: Austin Clements +To: notmuch@notmuchmail.org +Subject: [PATCH v2 4/5] emacs: Streaming S-expression parser +Date: Thu, 30 May 2013 13:13:35 -0400 +Message-Id: <1369934016-22308-5-git-send-email-amdragon@mit.edu> +X-Mailer: git-send-email 1.7.10.4 +In-Reply-To: <1369934016-22308-1-git-send-email-amdragon@mit.edu> +References: <1369934016-22308-1-git-send-email-amdragon@mit.edu> +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit +X-Brightmail-Tracker: + H4sIAAAAAAAAA+NgFprBKsWRmVeSWpSXmKPExsUixG6nrnuqY3mgwYYfQhar5/JYXL85k9ni + zcp5rA7MHjtn3WX3OPx1IYvHs1W3mAOYo7hsUlJzMstSi/TtErgy5vWwFDz2qJh9YhVjA+Mx + yy5GTg4JAROJFV/Ps0LYYhIX7q1n62Lk4hAS2Mco8fzMZyYIZyOjxLPfm5khnNNMEmd7/7BD + OHMZJQ5/38QO0s8moCGxbf9yRhBbREBaYufd2WBzmQXiJLZM+Q8WFxaIkth9/BsLiM0ioCox + d+VKMJtXwEHi7cFz7BB3KEp0P5vABmJzCjhK7Jh8GmyOEFDNpb1fmSDqBSVOznwC1MsBNF9d + Yv08IYhV8hLNW2czT2AUmoWkahZC1SwkVQsYmVcxyqbkVunmJmbmFKcm6xYnJ+blpRbpGuvl + ZpbopaaUbmIEBTqnJN8Oxq8HlQ4xCnAwKvHwZiQtDxRiTSwrrsw9xCjJwaQkyru+FSjEl5Sf + UpmRWJwRX1Sak1p8iFGCg1lJhLfAGSjHm5JYWZValA+TkuZgURLnvZJy019IID2xJDU7NbUg + tQgmK8PBoSTBO6MdqFGwKDU9tSItM6cEIc3EwQkynAdo+DSQGt7igsTc4sx0iPwpRl2Otq+T + 3zEKseTl56VKifOuBSkSACnKKM2DmwNLUK8YxYHeEuZdCVLFA0xucJNeAS1hAlryxBpsSUki + QkqqgbHw+B/f9g0fzrqbPlYMZvfd/iRyDbvLQ8PN3y4uuJB3hi2oaYH+XsdK/asPfKtlre9F + 2uQ+zhaVe3xKReOWzMEKH2vnTaqPKye8cE6r3lb5J0Z6go6d792ED07Soi5/6i8a6GyLWvzC + x7PSMnPKBy3/hpctDSfOhV43uyWTvM9vBqvlSfep/UosxRmJhlrMRcWJACg9h/crAwAA +Cc: tomi.ollila@iki.fi +X-BeenThere: notmuch@notmuchmail.org +X-Mailman-Version: 2.1.13 +Precedence: list +List-Id: "Use and development of the notmuch mail system." + +List-Unsubscribe: , + +List-Archive: +List-Post: +List-Help: +List-Subscribe: , + +X-List-Received-Date: Thu, 30 May 2013 17:14:03 -0000 + +This provides the same interface as the streaming JSON parser, but +reads S-expressions incrementally. The only difference is that the +`notmuch-sexp-parse-partial-list' helper does not handle interleaved +error messages (since we now have the ability to separate these out at +the invocation level), so it no longer takes an error function and +does not need to do the horrible resynchronization that the JSON +parser had to. + +Some implementation improvements have been made over the JSON parser. +This uses a vector instead of a list for the parser data structure, +since this allows faster access to elements (and modern versions of +Emacs handle storage of small vectors efficiently). Private functions +follow the "prefix--name" convention. And the implementation is much +simpler overall because S-expressions are much easier to parse. +--- + emacs/Makefile.local | 1 + + emacs/notmuch-parser.el | 207 +++++++++++++++++++++++++++++++++++++++++++++++ + 2 files changed, 208 insertions(+) + create mode 100644 emacs/notmuch-parser.el + +diff --git a/emacs/Makefile.local b/emacs/Makefile.local +index 456700a..a910aff 100644 +--- a/emacs/Makefile.local ++++ b/emacs/Makefile.local +@@ -3,6 +3,7 @@ + dir := emacs + emacs_sources := \ + $(dir)/notmuch-lib.el \ ++ $(dir)/notmuch-parser.el \ + $(dir)/notmuch.el \ + $(dir)/notmuch-query.el \ + $(dir)/notmuch-show.el \ +diff --git a/emacs/notmuch-parser.el b/emacs/notmuch-parser.el +new file mode 100644 +index 0000000..d59c0e1 +--- /dev/null ++++ b/emacs/notmuch-parser.el +@@ -0,0 +1,207 @@ ++;; notmuch-parser.el --- streaming S-expression parser ++;; ++;; Copyright © Austin Clements ++;; ++;; This file is part of Notmuch. ++;; ++;; Notmuch 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. ++;; ++;; Notmuch 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 Notmuch. If not, see . ++;; ++;; Authors: Austin Clements ++ ++(require 'cl) ++ ++(defun notmuch-sexp-create-parser () ++ "Return a new streaming S-expression parser. ++ ++This parser is designed to incrementally read an S-expression ++whose structure is known to the caller. Like a typical ++S-expression parsing interface, it provides a function to read a ++complete S-expression from the input. However, it extends this ++with an additional function that requires the next value in the ++input to be a list and descends into it, allowing its elements to ++be read one at a time or further descended into. Both functions ++can return 'retry to indicate that not enough input is available. ++ ++The parser always consumes input from point in the current ++buffer. Hence, the caller is allowed to delete any data before ++point and may resynchronize after an error by moving point." ++ ++ (vector 'notmuch-sexp-parser ++ ;; List depth ++ 0 ++ ;; Partial parse position marker ++ nil ++ ;; Partial parse state ++ nil)) ++ ++(defmacro notmuch-sexp--depth (sp) `(aref ,sp 1)) ++(defmacro notmuch-sexp--partial-pos (sp) `(aref ,sp 2)) ++(defmacro notmuch-sexp--partial-state (sp) `(aref ,sp 3)) ++ ++(defun notmuch-sexp-read (sp) ++ "Consume and return the value at point in the current buffer. ++ ++Returns 'retry if there is insufficient input to parse a complete ++value (though it may still move point over whitespace). If the ++parser is currently inside a list and the next token ends the ++list, this moves point just past the terminator and returns 'end. ++Otherwise, this moves point to just past the end of the value and ++returns the value." ++ ++ (skip-chars-forward " \n\r\t") ++ (cond ((eobp) 'retry) ++ ((= (char-after) ?\)) ++ ;; We've reached the end of a list ++ (if (= (notmuch-sexp--depth sp) 0) ++ ;; .. but we weren't in a list. Let read signal the ++ ;; error to be consistent with all other code paths. ++ (read (current-buffer)) ++ ;; Go up a level and return an end token ++ (decf (notmuch-sexp--depth sp)) ++ (forward-char) ++ 'end)) ++ ((= (char-after) ?\() ++ ;; We're at the beginning of a list. If we haven't started ++ ;; a partial parse yet, attempt to read the list in its ++ ;; entirety. If this fails, or we've started a partial ++ ;; parse, extend the partial parse to figure out when we ++ ;; have a complete list. ++ (catch 'return ++ (when (null (notmuch-sexp--partial-state sp)) ++ (let ((start (point))) ++ (condition-case nil ++ (throw 'return (read (current-buffer))) ++ (end-of-file (goto-char start))))) ++ ;; Extend the partial parse ++ (let (is-complete) ++ (save-excursion ++ (let* ((new-state (parse-partial-sexp ++ (or (notmuch-sexp--partial-pos sp) (point)) ++ (point-max) 0 nil ++ (notmuch-sexp--partial-state sp))) ++ ;; A complete value is available if we've ++ ;; reached depth 0. ++ (depth (first new-state))) ++ (assert (>= depth 0)) ++ (if (= depth 0) ++ ;; Reset partial parse state ++ (setf (notmuch-sexp--partial-state sp) nil ++ (notmuch-sexp--partial-pos sp) nil ++ is-complete t) ++ ;; Update partial parse state ++ (setf (notmuch-sexp--partial-state sp) new-state ++ (notmuch-sexp--partial-pos sp) (point-marker))))) ++ (if is-complete ++ (read (current-buffer)) ++ 'retry)))) ++ (t ++ ;; Attempt to read a non-compound value ++ (let ((start (point))) ++ (condition-case nil ++ (let ((val (read (current-buffer)))) ++ ;; We got what looks like a complete read, but if ++ ;; we reached the end of the buffer in the process, ++ ;; we may not actually have all of the input we ++ ;; need (unless it's a string, which is delimited). ++ (if (or (stringp val) (not (eobp))) ++ val ++ ;; We can't be sure the input was complete ++ (goto-char start) ++ 'retry)) ++ (end-of-file ++ (goto-char start) ++ 'retry)))))) ++ ++(defun notmuch-sexp-begin-list (sp) ++ "Parse the beginning of a list value and enter the list. ++ ++Returns 'retry if there is insufficient input to parse the ++beginning of the list. If this is able to parse the beginning of ++a list, it moves point past the token that opens the list and ++returns t. Later calls to `notmuch-sexp-read' will return the ++elements inside the list. If the input in buffer is not the ++beginning of a list, throw invalid-read-syntax." ++ ++ (skip-chars-forward " \n\r\t") ++ (cond ((eobp) 'retry) ++ ((= (char-after) ?\() ++ (forward-char) ++ (incf (notmuch-sexp--depth sp)) ++ t) ++ (t ++ ;; Skip over the bad character like `read' does ++ (forward-char) ++ (signal 'invalid-read-syntax (list (string (char-before))))))) ++ ++(defun notmuch-sexp-eof (sp) ++ "Signal an error if there is more data in SP's buffer. ++ ++Moves point to the beginning of any trailing data or to the end ++of the buffer if there is only trailing whitespace." ++ ++ (skip-chars-forward " \n\r\t") ++ (unless (eobp) ++ (error "Trailing garbage following expression"))) ++ ++(defvar notmuch-sexp--parser nil ++ "The buffer-local notmuch-sexp-parser instance. ++ ++Used by `notmuch-sexp-parse-partial-list'.") ++ ++(defvar notmuch-sexp--state nil ++ "The buffer-local `notmuch-sexp-parse-partial-list' state.") ++ ++(defun notmuch-sexp-parse-partial-list (result-function result-buffer) ++ "Incrementally parse an S-expression list from the current buffer. ++ ++This function consumes an S-expression list from the current ++buffer, applying RESULT-FUNCTION in RESULT-BUFFER to each ++complete value in the list. It operates incrementally and should ++be called whenever the input buffer has been extended with ++additional data. The caller just needs to ensure it does not ++move point in the input buffer." ++ ++ ;; Set up the initial state ++ (unless (local-variable-p 'notmuch-sexp--parser) ++ (set (make-local-variable 'notmuch-sexp--parser) ++ (notmuch-sexp-create-parser)) ++ (set (make-local-variable 'notmuch-sexp--state) 'begin)) ++ (let (done) ++ (while (not done) ++ (case notmuch-sexp--state ++ (begin ++ ;; Enter the list ++ (if (eq (notmuch-sexp-begin-list notmuch-sexp--parser) 'retry) ++ (setq done t) ++ (setq notmuch-sexp--state 'result))) ++ (result ++ ;; Parse a result ++ (let ((result (notmuch-sexp-read notmuch-sexp--parser))) ++ (case result ++ (retry (setq done t)) ++ (end (setq notmuch-sexp--state 'end)) ++ (t (with-current-buffer result-buffer ++ (funcall result-function result)))))) ++ (end ++ ;; Any trailing data is unexpected ++ (notmuch-sexp-eof notmuch-sexp--parser) ++ (setq done t))))) ++ ;; Clear out what we've parsed ++ (delete-region (point-min) (point))) ++ ++(provide 'notmuch-parser) ++ ++;; Local Variables: ++;; byte-compile-warnings: (not cl-functions) ++;; End: +-- +1.7.10.4 + -- 2.26.2