1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
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 <http://www.gnu.org/licenses/>.
;;
;; Authors: Austin Clements <aclements@csail.mit.edu>
(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:
|
