]> git.cworth.org Git - notmuch-old/blob - emacs/notmuch-parser.el
vim: doc: minor spelling fix
[notmuch-old] / emacs / notmuch-parser.el
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
31 This parser is designed to incrementally read an S-expression
32 whose structure is known to the caller.  Like a typical
33 S-expression parsing interface, it provides a function to read a
34 complete S-expression from the input.  However, it extends this
35 with an additional function that requires the next value in the
36 input to be a list and descends into it, allowing its elements to
37 be read one at a time or further descended into.  Both functions
38 can return 'retry to indicate that not enough input is available.
39
40 The parser always consumes input from point in the current
41 buffer.  Hence, the caller is allowed to delete any data before
42 point 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
55 Returns 'retry if there is insufficient input to parse a complete
56 value (though it may still move point over whitespace).  If the
57 parser is currently inside a list and the next token ends the
58 list, this moves point just past the terminator and returns 'end.
59 Otherwise, this moves point to just past the end of the value and
60 returns 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
128 Returns 'retry if there is insufficient input to parse the
129 beginning of the list.  If this is able to parse the beginning of
130 a list, it moves point past the token that opens the list and
131 returns t.  Later calls to `notmuch-sexp-read' will return the
132 elements inside the list.  If the input in buffer is not the
133 beginning 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
148 Used 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
156 This function consumes an S-expression list from the current
157 buffer, applying RESULT-FUNCTION in RESULT-BUFFER to each
158 complete value in the list.  It operates incrementally and should
159 be called whenever the input buffer has been extended with
160 additional data.  The caller just needs to ensure it does not
161 move 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