git.notmuchmail.org Git - notmuch/blob - emacs/notmuch-parser.el

   1 ;;; notmuch-parser.el --- streaming S-expression parser
   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 (eval-when-compile (require 'cl-lib))
  25
  26 (defun notmuch-sexp-create-parser ()
  27   "Return a new streaming S-expression parser.
  28
  29 This parser is designed to incrementally read an S-expression
  30 whose structure is known to the caller.  Like a typical
  31 S-expression parsing interface, it provides a function to read a
  32 complete S-expression from the input.  However, it extends this
  33 with an additional function that requires the next value in the
  34 input to be a list and descends into it, allowing its elements to
  35 be read one at a time or further descended into.  Both functions
  36 can return 'retry to indicate that not enough input is available.
  37
  38 The parser always consumes input from point in the current
  39 buffer.  Hence, the caller is allowed to delete any data before
  40 point and may resynchronize after an error by moving point."
  41
  42   (vector 'notmuch-sexp-parser
  43           ;; List depth
  44           0
  45           ;; Partial parse position marker
  46           nil
  47           ;; Partial parse state
  48           nil))
  49
  50 (defmacro notmuch-sexp--depth (sp)         `(aref ,sp 1))
  51 (defmacro notmuch-sexp--partial-pos (sp)   `(aref ,sp 2))
  52 (defmacro notmuch-sexp--partial-state (sp) `(aref ,sp 3))
  53
  54 (defun notmuch-sexp-read (sp)
  55   "Consume and return the value at point in the current buffer.
  56
  57 Returns 'retry if there is insufficient input to parse a complete
  58 value (though it may still move point over whitespace).  If the
  59 parser is currently inside a list and the next token ends the
  60 list, this moves point just past the terminator and returns 'end.
  61 Otherwise, this moves point to just past the end of the value and
  62 returns the value."
  63
  64   (skip-chars-forward " \n\r\t")
  65   (cond ((eobp) 'retry)
  66         ((= (char-after) ?\))
  67          ;; We've reached the end of a list
  68          (if (= (notmuch-sexp--depth sp) 0)
  69              ;; .. but we weren't in a list.  Let read signal the
  70              ;; error to be consistent with all other code paths.
  71              (read (current-buffer))
  72            ;; Go up a level and return an end token
  73            (cl-decf (notmuch-sexp--depth sp))
  74            (forward-char)
  75            'end))
  76         ((= (char-after) ?\()
  77          ;; We're at the beginning of a list.  If we haven't started
  78          ;; a partial parse yet, attempt to read the list in its
  79          ;; entirety.  If this fails, or we've started a partial
  80          ;; parse, extend the partial parse to figure out when we
  81          ;; have a complete list.
  82          (catch 'return
  83            (when (null (notmuch-sexp--partial-state sp))
  84              (let ((start (point)))
  85                (condition-case nil
  86                    (throw 'return (read (current-buffer)))
  87                  (end-of-file (goto-char start)))))
  88            ;; Extend the partial parse
  89            (let (is-complete)
  90              (save-excursion
  91                (let* ((new-state (parse-partial-sexp
  92                                   (or (notmuch-sexp--partial-pos sp) (point))
  93                                   (point-max) 0 nil
  94                                   (notmuch-sexp--partial-state sp)))
  95                       ;; A complete value is available if we've
  96                       ;; reached depth 0.
  97                       (depth (car new-state)))
  98                  (cl-assert (>= depth 0))
  99                  (if (= depth 0)
 100                      ;; Reset partial parse state
 101                      (setf (notmuch-sexp--partial-state sp) nil
 102                            (notmuch-sexp--partial-pos sp) nil
 103                            is-complete t)
 104                    ;; Update partial parse state
 105                    (setf (notmuch-sexp--partial-state sp) new-state
 106                          (notmuch-sexp--partial-pos sp) (point-marker)))))
 107              (if is-complete
 108                  (read (current-buffer))
 109                'retry))))
 110         (t
 111          ;; Attempt to read a non-compound value
 112          (let ((start (point)))
 113            (condition-case nil
 114                (let ((val (read (current-buffer))))
 115                  ;; We got what looks like a complete read, but if
 116                  ;; we reached the end of the buffer in the process,
 117                  ;; we may not actually have all of the input we
 118                  ;; need (unless it's a string, which is delimited).
 119                  (if (or (stringp val) (not (eobp)))
 120                      val
 121                    ;; We can't be sure the input was complete
 122                    (goto-char start)
 123                    'retry))
 124              (end-of-file
 125               (goto-char start)
 126               'retry))))))
 127
 128 (defun notmuch-sexp-begin-list (sp)
 129   "Parse the beginning of a list value and enter the list.
 130
 131 Returns 'retry if there is insufficient input to parse the
 132 beginning of the list.  If this is able to parse the beginning of
 133 a list, it moves point past the token that opens the list and
 134 returns t.  Later calls to `notmuch-sexp-read' will return the
 135 elements inside the list.  If the input in buffer is not the
 136 beginning of a list, throw invalid-read-syntax."
 137
 138   (skip-chars-forward " \n\r\t")
 139   (cond ((eobp) 'retry)
 140         ((= (char-after) ?\()
 141          (forward-char)
 142          (cl-incf (notmuch-sexp--depth sp))
 143          t)
 144         (t
 145          ;; Skip over the bad character like `read' does
 146          (forward-char)
 147          (signal 'invalid-read-syntax (list (string (char-before)))))))
 148
 149 (defun notmuch-sexp-eof (sp)
 150   "Signal an error if there is more data in SP's buffer.
 151
 152 Moves point to the beginning of any trailing data or to the end
 153 of the buffer if there is only trailing whitespace."
 154
 155   (skip-chars-forward " \n\r\t")
 156   (unless (eobp)
 157     (error "Trailing garbage following expression")))
 158
 159 (defvar notmuch-sexp--parser nil
 160   "The buffer-local notmuch-sexp-parser instance.
 161
 162 Used by `notmuch-sexp-parse-partial-list'.")
 163
 164 (defvar notmuch-sexp--state nil
 165   "The buffer-local `notmuch-sexp-parse-partial-list' state.")
 166
 167 (defun notmuch-sexp-parse-partial-list (result-function result-buffer)
 168   "Incrementally parse an S-expression list from the current buffer.
 169
 170 This function consumes an S-expression list from the current
 171 buffer, applying RESULT-FUNCTION in RESULT-BUFFER to each
 172 complete value in the list.  It operates incrementally and should
 173 be called whenever the input buffer has been extended with
 174 additional data.  The caller just needs to ensure it does not
 175 move point in the input buffer."
 176
 177   ;; Set up the initial state
 178   (unless (local-variable-p 'notmuch-sexp--parser)
 179     (set (make-local-variable 'notmuch-sexp--parser)
 180          (notmuch-sexp-create-parser))
 181     (set (make-local-variable 'notmuch-sexp--state) 'begin))
 182   (let (done)
 183     (while (not done)
 184       (cl-case notmuch-sexp--state
 185         (begin
 186          ;; Enter the list
 187          (if (eq (notmuch-sexp-begin-list notmuch-sexp--parser) 'retry)
 188              (setq done t)
 189            (setq notmuch-sexp--state 'result)))
 190         (result
 191          ;; Parse a result
 192          (let ((result (notmuch-sexp-read notmuch-sexp--parser)))
 193            (cl-case result
 194              (retry (setq done t))
 195              (end   (setq notmuch-sexp--state 'end))
 196              (t     (with-current-buffer result-buffer
 197                       (funcall result-function result))))))
 198         (end
 199          ;; Any trailing data is unexpected
 200          (notmuch-sexp-eof notmuch-sexp--parser)
 201          (setq done t)))))
 202   ;; Clear out what we've parsed
 203   (delete-region (point-min) (point)))
 204
 205 (provide 'notmuch-parser)
 206
 207 ;;; notmuch-parser.el ends here