From: Austin Clements Date: Sat, 18 May 2013 04:31:11 +0000 (+2000) Subject: [PATCH 4/5] emacs: Streaming S-expression parser X-Git-Url: http://git.tremily.us/?a=commitdiff_plain;h=e604d94e3fddc39ef882641bf8dc04e73b3b0db2;p=notmuch-archives.git [PATCH 4/5] emacs: Streaming S-expression parser --- diff --git a/eb/96729bb8891068f1ac8a191bac4671e1bff81b b/eb/96729bb8891068f1ac8a191bac4671e1bff81b new file mode 100644 index 000000000..0eaded6a7 --- /dev/null +++ b/eb/96729bb8891068f1ac8a191bac4671e1bff81b @@ -0,0 +1,329 @@ +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 1B19E431FC2 + for ; Fri, 17 May 2013 21:32:22 -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 cRhIAVnnV607 for ; + Fri, 17 May 2013 21:32:14 -0700 (PDT) +Received: from dmz-mailsec-scanner-4.mit.edu (DMZ-MAILSEC-SCANNER-4.MIT.EDU + [18.9.25.15]) + by olra.theworths.org (Postfix) with ESMTP id 039E8431FC7 + for ; Fri, 17 May 2013 21:32:13 -0700 (PDT) +X-AuditID: 1209190f-b7f256d000005616-b6-5197044d4c48 +Received: from mailhub-auth-3.mit.edu ( [18.9.21.43]) + by dmz-mailsec-scanner-4.mit.edu (Symantec Messaging Gateway) with SMTP + id 5F.3E.22038.D4407915; Sat, 18 May 2013 00:32:13 -0400 (EDT) +Received: from outgoing.mit.edu (OUTGOING-AUTH-1.MIT.EDU [18.9.28.11]) + by mailhub-auth-3.mit.edu (8.13.8/8.9.2) with ESMTP id r4I4W9NA022588; + Sat, 18 May 2013 00:32:09 -0400 +Received: from drake.dyndns.org + (216-15-114-40.c3-0.arl-ubr1.sbo-arl.ma.cable.rcn.com + [216.15.114.40]) (authenticated bits=0) + (User authenticated as amdragon@ATHENA.MIT.EDU) + by outgoing.mit.edu (8.13.8/8.12.4) with ESMTP id r4I4W6xL018816 + (version=TLSv1/SSLv3 cipher=AES256-SHA bits=256 verify=NOT); + Sat, 18 May 2013 00:32:08 -0400 +Received: from amthrax by drake.dyndns.org with local (Exim 4.77) + (envelope-from ) + id 1UdYo1-0001Z0-L0; Sat, 18 May 2013 00:31:41 -0400 +From: Austin Clements +To: notmuch@notmuchmail.org +Subject: [PATCH 4/5] emacs: Streaming S-expression parser +Date: Sat, 18 May 2013 00:31:11 -0400 +Message-Id: <1368851472-5382-5-git-send-email-amdragon@mit.edu> +X-Mailer: git-send-email 1.7.10.4 +In-Reply-To: <1368851472-5382-1-git-send-email-amdragon@mit.edu> +References: <1368851472-5382-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+NgFupjleLIzCtJLcpLzFFi42IR4hTV1vVlmR5osGadosXquTwW12/OZHZg + 8tg56y67x7NVt5gDmKK4bFJSczLLUov07RK4MhY+ucBY0OVd0fThBGMD43erLkZODgkBE4lV + O44zQ9hiEhfurWfrYuTiEBLYxyhx8sFuFghnI6PE7wP7oDJ3mCTWfdoF1iIkMJdR4spRIRCb + TUBDYtv+5YwgtoiAtMTOu7NZQWxmAUeJz/sXsYHYwgKhEjsv/QCLswioSpyZdgxsDq+AvcSq + 1umsEGcoSnQ/mwBWzyngIHF4/jE2iF32El0XbrJB1AtKnJz5BOg6DqD56hLr5wlBrJKXaN46 + m3kCo9AsJFWzEKpmIalawMi8ilE2JbdKNzcxM6c4NVm3ODkxLy+1SNdELzezRC81pXQTIzio + Jfl3MH47qHSIUYCDUYmH96PrtEAh1sSy4srcQ4ySHExKorwm/4BCfEn5KZUZicUZ8UWlOanF + hxglOJiVRHifFwPleFMSK6tSi/JhUtIcLErivFdTbvoLCaQnlqRmp6YWpBbBZGU4OJQkeHWZ + pwcKCRalpqdWpGXmlCCkmTg4QYbzAA23AqnhLS5IzC3OTIfIn2LU5Wj7OvkdoxBLXn5eqpQ4 + rzNIkQBIUUZpHtwcWDJ6xSgO9JYwrzRIFQ8wkcFNegW0hAloCeu1qSBLShIRUlINjEEKX/fa + f859G3jGVqqVve82Y5Sa/8qIZ1Nf8izSiq0X0Zlqc77ku/D8ifO/M79aa/zwAUvWcmnusLin + Lq4HHH4mpbLPXCUs1/tinXnBJ4OsY2wKJlanvO+K2Lkb/9lkPb2b82rTv9tmj0LvszbtcNR8 + 5vMqpGTpN7mCq/IzS2xEpW+82DX3jRJLcUaioRZzUXEiAEhDwYYhAwAA +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: Sat, 18 May 2013 04:32:22 -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 | 212 +++++++++++++++++++++++++++++++++++++++++++++++ + 2 files changed, 213 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..1b7cf64 +--- /dev/null ++++ b/emacs/notmuch-parser.el +@@ -0,0 +1,212 @@ ++;; 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 (buffer) ++ "Return a streaming S-expression parser that reads from BUFFER. ++ ++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 BUFFER's point. Hence, the ++caller is allowed to delete any data before point and may ++resynchronize after an error by moving point." ++ ++ (vector 'notmuch-sexp-parser ++ buffer ++ ;; List depth ++ 0 ++ ;; Partial parse position marker ++ nil ++ ;; Partial parse state ++ nil)) ++ ++(defmacro notmuch-sexp--buffer (sp) `(aref ,sp 1)) ++(defmacro notmuch-sexp--depth (sp) `(aref ,sp 2)) ++(defmacro notmuch-sexp--partial-pos (sp) `(aref ,sp 3)) ++(defmacro notmuch-sexp--partial-state (sp) `(aref ,sp 4)) ++ ++(defun notmuch-sexp-read (sp) ++ "Consume and return the value at point in SP's 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." ++ ++ (with-current-buffer (notmuch-sexp--buffer sp) ++ (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. ++ (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." ++ ++ (with-current-buffer (notmuch-sexp--buffer sp) ++ (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." ++ ++ (with-current-buffer (notmuch-sexp--buffer sp) ++ (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 consume 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 (current-buffer))) ++ (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 +