1 ;;; semantic/bovine.el --- LL Parser/Analyzer core.
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2009, 2010
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 ;; arch-tag: 1e820899-2a26-499a-b0c0-57301365a6b0
297 ;;; semantic/bovine.el ends here