1 ;;; semantic/bovine.el --- LL Parser/Analyzer core.
3 ;; Copyright (C) 1999-2004, 2006-2007, 2009-2012
4 ;; Free Software Foundation, Inc.
6 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
8 ;; This file is part of GNU Emacs.
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.
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.
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/>.
25 ;; Semantic 1.x uses an LL parser named the "bovinator". This parser
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.
30 ;; This parser should be used when the language is simple, such as
31 ;; makefiles or other data-declarative languages.
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")
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
)
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
))))
60 ;;; Semantic Bovination
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.
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
))
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'."
76 (car (aref (car nt-stack
) 2))
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
))
88 nt semantic-bovinate-nonterminal-check-obarray
))))
90 ;; Always enter debugger to see the backtrace
91 (let ((debug-on-signal 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
)
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
))
109 ;; Try to detect infinite recursive parse when doing a full reparse.
110 (or semantic--buffer-cache
111 (semantic-bovinate-nonterminal-check stream nonterminal
))
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.
129 (condition-case debug-condition
131 (catch 'push-non-terminal
133 end
(semantic-lex-token-end (car stream
)))
134 (while (or nt-loop nt-popup
)
137 (while (or nt-popup matchlist
)
139 ;; End of a non-terminal recursion
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.
146 (if (or (byte-code-function-p (car lte
))
148 ;; In this case, we have an EMPTY match! Make
150 (setq cvl
(list nil
))))
153 (not (byte-code-function-p (car lte
)))
154 (not (listp (car lte
))))
156 ;; GRAMMAR SOURCE DEBUGGING!
157 (if (and (boundp 'semantic-debug-enabled
)
158 semantic-debug-enabled
)
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
)))
166 (require 'semantic
/bovine
/debug
)
167 (semantic-bovine-debug-create-frame
168 db-nt db-midx db-tidx cvl
(car s
))))
169 (cmd (semantic-debug-break frame
))
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.
177 ;; END GRAMMAR SOURCE DEBUGGING!
180 ;; We have a nonterminal symbol. Recurse inline.
181 ((setq nt-loop
(assq (car lte
) table
))
184 ;; push state into the nt-stack
185 nt-stack
(cons (vector matchlist cvl lte stream end
188 ;; new non-terminal matchlist
189 matchlist
(cdr nt-loop
)
190 ;; new non-terminal stream
193 (throw 'push-non-terminal t
)
198 (setq lse
(car s
) ;Get the local stream element
199 s
(cdr s
)) ;update stream.
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
))
205 (if (stringp (car lte
))
209 (if (string-match tev val
)
211 (if (memq (semantic-lex-token-class lse
)
212 '(comment semantic-list
))
214 cvl
)) ;append this value
215 (setq lte nil cvl nil
))) ;clear the entry (exit)
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
))
222 (setq lte nil cvl nil
)) ;No more matches, exit
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
))))
229 (funcall (car lte
) ;call matchlist fn on values
230 (nreverse cvl
) start end
))
231 ((and (= (length cvl
) 1)
233 (not (numberp (car (car cvl
)))))
234 (append (car cvl
) (list start end
)))
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
246 (if (eq s starting-stream
)
250 ;; pop previous state from the nt-stack
251 (let ((state (car nt-stack
)))
254 ;; pop actual parser state
255 matchlist
(aref state
0)
258 stream
(aref state
3)
261 nt-stack
(cdr nt-stack
))
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
270 ;; No value means that we need to terminate this
272 (setq lte nil cvl nil
)) ;No match, exit
275 ;; On error just move forward the stream of lexical tokens
276 (setq result
(list (cdr starting-stream
) nil
))
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
282 (semantic-debug-break frame
)))))
285 ;; Make it the default parser
287 (defalias 'semantic-parse-stream-default
'semantic-bovinate-stream
)
289 (provide 'semantic
/bovine
)
292 ;; generated-autoload-file: "loaddefs.el"
293 ;; generated-autoload-load-name: "semantic/bovine"
296 ;;; semantic/bovine.el ends here