1;;; notmuch-parser.el --- streaming S-expression parser -*- lexical-binding: t -*- 2;; 3;; Copyright © Austin Clements 4;; 5;; This file is part of Notmuch. 6;; 7;; Notmuch is free software: you can redistribute it and/or modify it 8;; under the terms of the GNU General Public License as published by 9;; the Free Software Foundation, either version 3 of the License, or 10;; (at your option) any later version. 11;; 12;; Notmuch is distributed in the hope that it will be useful, but 13;; WITHOUT ANY WARRANTY; without even the implied warranty of 14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15;; General Public License for more details. 16;; 17;; You should have received a copy of the GNU General Public License 18;; along with Notmuch. If not, see <https://www.gnu.org/licenses/>. 19;; 20;; Authors: Austin Clements <aclements@csail.mit.edu> 21 22;;; Code: 23 24(require 'cl-lib) 25(require 'pcase) 26(require 'subr-x) 27 28(defun notmuch-sexp-create-parser () 29 "Return a new streaming S-expression parser. 30 31This parser is designed to incrementally read an S-expression 32whose structure is known to the caller. Like a typical 33S-expression parsing interface, it provides a function to read a 34complete S-expression from the input. However, it extends this 35with an additional function that requires the next value in the 36input to be a list and descends into it, allowing its elements to 37be read one at a time or further descended into. Both functions 38can return 'retry to indicate that not enough input is available. 39 40The parser always consumes input from point in the current 41buffer. Hence, the caller is allowed to delete any data before 42point and may resynchronize after an error by moving point." 43 (vector 'notmuch-sexp-parser 44 0 ; List depth 45 nil ; Partial parse position marker 46 nil)) ; Partial parse state 47 48(defmacro notmuch-sexp--depth (sp) `(aref ,sp 1)) 49(defmacro notmuch-sexp--partial-pos (sp) `(aref ,sp 2)) 50(defmacro notmuch-sexp--partial-state (sp) `(aref ,sp 3)) 51 52(defun notmuch-sexp-read (sp) 53 "Consume and return the value at point in the current buffer. 54 55Returns 'retry if there is insufficient input to parse a complete 56value (though it may still move point over whitespace). If the 57parser is currently inside a list and the next token ends the 58list, this moves point just past the terminator and returns 'end. 59Otherwise, this moves point to just past the end of the value and 60returns the value." 61 (skip-chars-forward " \n\r\t") 62 (cond ((eobp) 'retry) 63 ((= (char-after) ?\)) 64 ;; We've reached the end of a list 65 (if (= (notmuch-sexp--depth sp) 0) 66 ;; .. but we weren't in a list. Let read signal the 67 ;; error to be consistent with all other code paths. 68 (read (current-buffer)) 69 ;; Go up a level and return an end token 70 (cl-decf (notmuch-sexp--depth sp)) 71 (forward-char) 72 'end)) 73 ((= (char-after) ?\() 74 ;; We're at the beginning of a list. If we haven't started 75 ;; a partial parse yet, attempt to read the list in its 76 ;; entirety. If this fails, or we've started a partial 77 ;; parse, extend the partial parse to figure out when we 78 ;; have a complete list. 79 (catch 'return 80 (unless (notmuch-sexp--partial-state sp) 81 (let ((start (point))) 82 (condition-case nil 83 (throw 'return (read (current-buffer))) 84 (end-of-file (goto-char start))))) 85 ;; Extend the partial parse 86 (let (is-complete) 87 (save-excursion 88 (let* ((new-state (parse-partial-sexp 89 (or (notmuch-sexp--partial-pos sp) (point)) 90 (point-max) 0 nil 91 (notmuch-sexp--partial-state sp))) 92 ;; A complete value is available if we've 93 ;; reached depth 0. 94 (depth (car new-state))) 95 (cl-assert (>= depth 0)) 96 (if (= depth 0) 97 ;; Reset partial parse state 98 (setf (notmuch-sexp--partial-state sp) nil 99 (notmuch-sexp--partial-pos sp) nil 100 is-complete t) 101 ;; Update partial parse state 102 (setf (notmuch-sexp--partial-state sp) new-state 103 (notmuch-sexp--partial-pos sp) (point-marker))))) 104 (if is-complete 105 (read (current-buffer)) 106 'retry)))) 107 (t 108 ;; Attempt to read a non-compound value 109 (let ((start (point))) 110 (condition-case nil 111 (let ((val (read (current-buffer)))) 112 ;; We got what looks like a complete read, but if 113 ;; we reached the end of the buffer in the process, 114 ;; we may not actually have all of the input we 115 ;; need (unless it's a string, which is delimited). 116 (if (or (stringp val) (not (eobp))) 117 val 118 ;; We can't be sure the input was complete 119 (goto-char start) 120 'retry)) 121 (end-of-file 122 (goto-char start) 123 'retry)))))) 124 125(defun notmuch-sexp-begin-list (sp) 126 "Parse the beginning of a list value and enter the list. 127 128Returns 'retry if there is insufficient input to parse the 129beginning of the list. If this is able to parse the beginning of 130a list, it moves point past the token that opens the list and 131returns t. Later calls to `notmuch-sexp-read' will return the 132elements inside the list. If the input in buffer is not the 133beginning of a list, throw invalid-read-syntax." 134 (skip-chars-forward " \n\r\t") 135 (cond ((eobp) 'retry) 136 ((= (char-after) ?\() 137 (forward-char) 138 (cl-incf (notmuch-sexp--depth sp)) 139 t) 140 (t 141 ;; Skip over the bad character like `read' does 142 (forward-char) 143 (signal 'invalid-read-syntax (list (string (char-before))))))) 144 145(defvar notmuch-sexp--parser nil 146 "The buffer-local notmuch-sexp-parser instance. 147 148Used by `notmuch-sexp-parse-partial-list'.") 149 150(defvar notmuch-sexp--state nil 151 "The buffer-local `notmuch-sexp-parse-partial-list' state.") 152 153(defun notmuch-sexp-parse-partial-list (result-function result-buffer) 154 "Incrementally parse an S-expression list from the current buffer. 155 156This function consumes an S-expression list from the current 157buffer, applying RESULT-FUNCTION in RESULT-BUFFER to each 158complete value in the list. It operates incrementally and should 159be called whenever the input buffer has been extended with 160additional data. The caller just needs to ensure it does not 161move point in the input buffer." 162 ;; Set up the initial state 163 (unless (local-variable-p 'notmuch-sexp--parser) 164 (setq-local notmuch-sexp--parser (notmuch-sexp-create-parser)) 165 (setq-local notmuch-sexp--state 'begin)) 166 (let (done) 167 (while (not done) 168 (cl-case notmuch-sexp--state 169 (begin 170 ;; Enter the list 171 (if (eq (notmuch-sexp-begin-list notmuch-sexp--parser) 'retry) 172 (setq done t) 173 (setq notmuch-sexp--state 'result))) 174 (result 175 ;; Parse a result 176 (let ((result (notmuch-sexp-read notmuch-sexp--parser))) 177 (cl-case result 178 (retry (setq done t)) 179 (end (setq notmuch-sexp--state 'end)) 180 (t (with-current-buffer result-buffer 181 (funcall result-function result)))))) 182 (end 183 ;; Skip over trailing whitespace. 184 (skip-chars-forward " \n\r\t") 185 ;; Any trailing data is unexpected. 186 (unless (eobp) 187 (error "Trailing garbage following expression")) 188 (setq done t))))) 189 ;; Clear out what we've parsed 190 (delete-region (point-min) (point))) 191 192(provide 'notmuch-parser) 193 194;;; notmuch-parser.el ends here 195