Commit | Line | Data |
---|---|---|
54c6ce29 CY |
1 | ;;; semantic/bovine.el --- LL Parser/Analyzer core. |
2 | ||
114f9c96 | 3 | ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2009, 2010 |
cb758101 | 4 | ;; Free Software Foundation, Inc. |
54c6ce29 CY |
5 | |
6 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation, either version 3 of the License, or | |
13 | ;; (at your option) any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | ;;; Commentary: | |
24 | ;; | |
8d0ef656 | 25 | ;; Semantic 1.x uses an LL parser named the "bovinator". This parser |
54c6ce29 CY |
26 | ;; had several conveniences in it which made for parsing tags out of |
27 | ;; languages with list characters easy. This parser lives on as one | |
28 | ;; of many available parsers for semantic the tool. | |
29 | ;; | |
30 | ;; This parser should be used when the language is simple, such as | |
8d0ef656 | 31 | ;; makefiles or other data-declarative languages. |
54c6ce29 CY |
32 | |
33 | ;;; Code: | |
34 | (require 'semantic) | |
b90caf50 CY |
35 | |
36 | (declare-function semantic-create-bovine-debug-error-frame | |
37 | "semantic/bovine/debug") | |
38 | (declare-function semantic-bovine-debug-create-frame | |
39 | "semantic/bovine/debug") | |
40 | (declare-function semantic-debug-break "semantic/debug") | |
54c6ce29 CY |
41 | |
42 | ;;; Variables | |
43 | ;; | |
44 | (defvar semantic-bovinate-nonterminal-check-obarray nil | |
45 | "Obarray of streams already parsed for nonterminal symbols. | |
46 | Use this to detect infinite recursion during a parse.") | |
47 | (make-variable-buffer-local 'semantic-bovinate-nonterminal-check-obarray) | |
48 | ||
49 | ||
50 | \f | |
51 | ;; These are functions that can be called from within a bovine table. | |
52 | ;; Most of these have code auto-generated from other construct in the | |
53 | ;; bovine input grammar. | |
54 | (defmacro semantic-lambda (&rest return-val) | |
55 | "Create a lambda expression to return a list including RETURN-VAL. | |
56 | The return list is a lambda expression to be used in a bovine table." | |
57 | `(lambda (vals start end) | |
58 | (append ,@return-val (list start end)))) | |
59 | ||
60 | ;;; Semantic Bovination | |
61 | ;; | |
62 | ;; Take a semantic token stream, and convert it using the bovinator. | |
63 | ;; The bovinator takes a state table, and converts the token stream | |
64 | ;; into a new semantic stream defined by the bovination table. | |
65 | ;; | |
66 | (defsubst semantic-bovinate-symbol-nonterminal-p (sym table) | |
67 | "Return non-nil if SYM is in TABLE, indicating it is NONTERMINAL." | |
68 | ;; sym is always a sym, so assq should be ok. | |
69 | (if (assq sym table) t nil)) | |
70 | ||
71 | (defmacro semantic-bovinate-nonterminal-db-nt () | |
72 | "Return the current nonterminal symbol. | |
73 | Part of the grammar source debugger. Depends on the existing | |
74 | environment of `semantic-bovinate-stream'." | |
75 | `(if nt-stack | |
76 | (car (aref (car nt-stack) 2)) | |
77 | nonterminal)) | |
78 | ||
79 | (defun semantic-bovinate-nonterminal-check (stream nonterminal) | |
80 | "Check if STREAM not already parsed for NONTERMINAL. | |
81 | If so abort because an infinite recursive parse is suspected." | |
82 | (or (vectorp semantic-bovinate-nonterminal-check-obarray) | |
83 | (setq semantic-bovinate-nonterminal-check-obarray | |
84 | (make-vector 13 nil))) | |
85 | (let* ((nt (symbol-name nonterminal)) | |
86 | (vs (symbol-value | |
87 | (intern-soft | |
88 | nt semantic-bovinate-nonterminal-check-obarray)))) | |
89 | (if (memq stream vs) | |
90 | ;; Always enter debugger to see the backtrace | |
91 | (let ((debug-on-signal t) | |
92 | (debug-on-error t)) | |
93 | (setq semantic-bovinate-nonterminal-check-obarray nil) | |
94 | (error "Infinite recursive parse suspected on %s" nt)) | |
95 | (set (intern nt semantic-bovinate-nonterminal-check-obarray) | |
96 | (cons stream vs))))) | |
97 | ||
98 | ;;;###autoload | |
99 | (defun semantic-bovinate-stream (stream &optional nonterminal) | |
100 | "Bovinate STREAM, starting at the first NONTERMINAL rule. | |
101 | Use `bovine-toplevel' if NONTERMINAL is not provided. | |
102 | This is the core routine for converting a stream into a table. | |
103 | Return the list (STREAM SEMANTIC-STREAM) where STREAM are those | |
104 | elements of STREAM that have not been used. SEMANTIC-STREAM is the | |
105 | list of semantic tokens found." | |
106 | (if (not nonterminal) | |
107 | (setq nonterminal 'bovine-toplevel)) | |
108 | ||
109 | ;; Try to detect infinite recursive parse when doing a full reparse. | |
110 | (or semantic--buffer-cache | |
111 | (semantic-bovinate-nonterminal-check stream nonterminal)) | |
112 | ||
113 | (let* ((table semantic--parse-table) | |
114 | (matchlist (cdr (assq nonterminal table))) | |
115 | (starting-stream stream) | |
116 | (nt-loop t) ;non-terminal loop condition | |
117 | nt-popup ;non-nil if return from nt recursion | |
118 | nt-stack ;non-terminal recursion stack | |
119 | s ;Temp Stream Tracker | |
120 | lse ;Local Semantic Element | |
121 | lte ;Local matchlist element | |
122 | tev ;Matchlist entry values from buffer | |
123 | val ;Value found in buffer. | |
124 | cvl ;collected values list. | |
125 | out ;Output | |
126 | end ;End of match | |
127 | result | |
128 | ) | |
129 | (condition-case debug-condition | |
130 | (while nt-loop | |
131 | (catch 'push-non-terminal | |
132 | (setq nt-popup nil | |
133 | end (semantic-lex-token-end (car stream))) | |
134 | (while (or nt-loop nt-popup) | |
135 | (setq nt-loop nil | |
136 | out nil) | |
137 | (while (or nt-popup matchlist) | |
138 | (if nt-popup | |
139 | ;; End of a non-terminal recursion | |
140 | (setq nt-popup nil) | |
141 | ;; New matching process | |
142 | (setq s stream ;init s from stream. | |
143 | cvl nil ;re-init the collected value list. | |
144 | lte (car matchlist) ;Get the local matchlist entry. | |
145 | ) | |
146 | (if (or (byte-code-function-p (car lte)) | |
147 | (listp (car lte))) | |
148 | ;; In this case, we have an EMPTY match! Make | |
149 | ;; stuff up. | |
150 | (setq cvl (list nil)))) | |
151 | ||
152 | (while (and lte | |
153 | (not (byte-code-function-p (car lte))) | |
154 | (not (listp (car lte)))) | |
155 | ||
156 | ;; GRAMMAR SOURCE DEBUGGING! | |
b90caf50 CY |
157 | (if (and (boundp 'semantic-debug-enabled) |
158 | semantic-debug-enabled) | |
54c6ce29 CY |
159 | (let* ((db-nt (semantic-bovinate-nonterminal-db-nt)) |
160 | (db-ml (cdr (assq db-nt table))) | |
161 | (db-mlen (length db-ml)) | |
162 | (db-midx (- db-mlen (length matchlist))) | |
163 | (db-tlen (length (nth db-midx db-ml))) | |
164 | (db-tidx (- db-tlen (length lte))) | |
b90caf50 CY |
165 | (frame (progn |
166 | (require 'semantic/bovine/debug) | |
167 | (semantic-bovine-debug-create-frame | |
168 | db-nt db-midx db-tidx cvl (car s)))) | |
54c6ce29 CY |
169 | (cmd (semantic-debug-break frame)) |
170 | ) | |
171 | (cond ((eq 'fail cmd) (setq lte '(trash 0 . 0))) | |
172 | ((eq 'quit cmd) (signal 'quit "Abort")) | |
173 | ((eq 'abort cmd) (error "Abort")) | |
174 | ;; support more commands here. | |
175 | ||
176 | ))) | |
177 | ;; END GRAMMAR SOURCE DEBUGGING! | |
178 | ||
179 | (cond | |
180 | ;; We have a nonterminal symbol. Recurse inline. | |
181 | ((setq nt-loop (assq (car lte) table)) | |
182 | ||
183 | (setq | |
184 | ;; push state into the nt-stack | |
185 | nt-stack (cons (vector matchlist cvl lte stream end | |
186 | ) | |
187 | nt-stack) | |
188 | ;; new non-terminal matchlist | |
189 | matchlist (cdr nt-loop) | |
190 | ;; new non-terminal stream | |
191 | stream s) | |
192 | ||
193 | (throw 'push-non-terminal t) | |
194 | ||
195 | ) | |
196 | ;; Default case | |
197 | (t | |
198 | (setq lse (car s) ;Get the local stream element | |
199 | s (cdr s)) ;update stream. | |
200 | ;; Do the compare | |
201 | (if (eq (car lte) (semantic-lex-token-class lse)) ;syntactic match | |
202 | (let ((valdot (semantic-lex-token-bounds lse))) | |
203 | (setq val (semantic-lex-token-text lse)) | |
204 | (setq lte (cdr lte)) | |
205 | (if (stringp (car lte)) | |
206 | (progn | |
207 | (setq tev (car lte) | |
208 | lte (cdr lte)) | |
209 | (if (string-match tev val) | |
210 | (setq cvl (cons | |
211 | (if (memq (semantic-lex-token-class lse) | |
212 | '(comment semantic-list)) | |
213 | valdot val) | |
214 | cvl)) ;append this value | |
215 | (setq lte nil cvl nil))) ;clear the entry (exit) | |
216 | (setq cvl (cons | |
217 | (if (memq (semantic-lex-token-class lse) | |
218 | '(comment semantic-list)) | |
219 | valdot val) cvl))) ;append unchecked value. | |
220 | (setq end (semantic-lex-token-end lse)) | |
221 | ) | |
222 | (setq lte nil cvl nil)) ;No more matches, exit | |
223 | ))) | |
224 | (if (not cvl) ;lte=nil; there was no match. | |
225 | (setq matchlist (cdr matchlist)) ;Move to next matchlist entry | |
226 | (let ((start (semantic-lex-token-start (car stream)))) | |
227 | (setq out (cond | |
228 | ((car lte) | |
229 | (funcall (car lte) ;call matchlist fn on values | |
230 | (nreverse cvl) start end)) | |
231 | ((and (= (length cvl) 1) | |
232 | (listp (car cvl)) | |
233 | (not (numberp (car (car cvl))))) | |
234 | (append (car cvl) (list start end))) | |
235 | (t | |
236 | ;;(append (nreverse cvl) (list start end)))) | |
237 | ;; MAYBE THE FOLLOWING NEEDS LESS CONS | |
238 | ;; CELLS THAN THE ABOVE? | |
239 | (nreverse (cons end (cons start cvl))))) | |
240 | matchlist nil) ;;generate exit condition | |
241 | (if (not end) | |
242 | (setq out nil))) | |
243 | ;; Nothin? | |
244 | )) | |
245 | (setq result | |
246 | (if (eq s starting-stream) | |
247 | (list (cdr s) nil) | |
248 | (list s out))) | |
249 | (if nt-stack | |
250 | ;; pop previous state from the nt-stack | |
251 | (let ((state (car nt-stack))) | |
252 | ||
253 | (setq nt-popup t | |
254 | ;; pop actual parser state | |
255 | matchlist (aref state 0) | |
256 | cvl (aref state 1) | |
257 | lte (aref state 2) | |
258 | stream (aref state 3) | |
259 | end (aref state 4) | |
260 | ;; update the stack | |
261 | nt-stack (cdr nt-stack)) | |
262 | ||
263 | (if out | |
264 | (let ((len (length out)) | |
265 | (strip (nreverse (cdr (cdr (reverse out)))))) | |
266 | (setq end (nth (1- len) out) ;reset end to the end of exp | |
267 | cvl (cons strip cvl) ;prepend value of exp | |
268 | lte (cdr lte)) ;update the local table entry | |
269 | ) | |
270 | ;; No value means that we need to terminate this | |
271 | ;; match. | |
272 | (setq lte nil cvl nil)) ;No match, exit | |
273 | ))))) | |
274 | (error | |
275 | ;; On error just move forward the stream of lexical tokens | |
276 | (setq result (list (cdr starting-stream) nil)) | |
b90caf50 CY |
277 | (when (and (boundp 'semantic-debug-enabled) |
278 | semantic-debug-enabled) | |
279 | (require 'semantic/bovine/debug) | |
280 | (let ((frame (semantic-create-bovine-debug-error-frame | |
281 | debug-condition))) | |
282 | (semantic-debug-break frame))))) | |
54c6ce29 CY |
283 | result)) |
284 | ||
285 | ;; Make it the default parser | |
286 | ;;;###autoload | |
287 | (defalias 'semantic-parse-stream-default 'semantic-bovinate-stream) | |
288 | ||
289 | (provide 'semantic/bovine) | |
290 | ||
291 | ;; Local variables: | |
292 | ;; generated-autoload-file: "loaddefs.el" | |
54c6ce29 CY |
293 | ;; generated-autoload-load-name: "semantic/bovine" |
294 | ;; End: | |
295 | ||
3999968a | 296 | ;; arch-tag: 1e820899-2a26-499a-b0c0-57301365a6b0 |
54c6ce29 | 297 | ;;; semantic/bovine.el ends here |