Mercurial > emacs
diff lisp/cedet/semantic/bovine.el @ 105260:bbd7017a25d9
CEDET (development tools) package merged.
* cedet/*.el:
* cedet/ede/*.el:
* cedet/semantic/*.el:
* cedet/srecode/*.el: New files.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 28 Sep 2009 15:15:00 +0000 |
parents | a19d1a45b823 |
children | 108a3a6d8be0 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/bovine.el Mon Sep 28 15:15:00 2009 +0000 @@ -0,0 +1,297 @@ +;;; semantic/bovine.el --- LL Parser/Analyzer core. + +;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007 +;;; Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Semantix 1.x uses an LL parser named the "bovinator". This parser +;; had several conveniences in it which made for parsing tags out of +;; languages with list characters easy. This parser lives on as one +;; of many available parsers for semantic the tool. +;; +;; This parser should be used when the language is simple, such as +;; makefiles or other data-declaritive langauges. + +;;; Code: +(require 'semantic) + +(declare-function semantic-create-bovine-debug-error-frame + "semantic/bovine/debug") +(declare-function semantic-bovine-debug-create-frame + "semantic/bovine/debug") +(declare-function semantic-debug-break "semantic/debug") + +;;; Variables +;; +(defvar semantic-bovinate-nonterminal-check-obarray nil + "Obarray of streams already parsed for nonterminal symbols. +Use this to detect infinite recursion during a parse.") +(make-variable-buffer-local 'semantic-bovinate-nonterminal-check-obarray) + + + +;; These are functions that can be called from within a bovine table. +;; Most of these have code auto-generated from other construct in the +;; bovine input grammar. +(defmacro semantic-lambda (&rest return-val) + "Create a lambda expression to return a list including RETURN-VAL. +The return list is a lambda expression to be used in a bovine table." + `(lambda (vals start end) + (append ,@return-val (list start end)))) + +;;; Semantic Bovination +;; +;; Take a semantic token stream, and convert it using the bovinator. +;; The bovinator takes a state table, and converts the token stream +;; into a new semantic stream defined by the bovination table. +;; +(defsubst semantic-bovinate-symbol-nonterminal-p (sym table) + "Return non-nil if SYM is in TABLE, indicating it is NONTERMINAL." + ;; sym is always a sym, so assq should be ok. + (if (assq sym table) t nil)) + +(defmacro semantic-bovinate-nonterminal-db-nt () + "Return the current nonterminal symbol. +Part of the grammar source debugger. Depends on the existing +environment of `semantic-bovinate-stream'." + `(if nt-stack + (car (aref (car nt-stack) 2)) + nonterminal)) + +(defun semantic-bovinate-nonterminal-check (stream nonterminal) + "Check if STREAM not already parsed for NONTERMINAL. +If so abort because an infinite recursive parse is suspected." + (or (vectorp semantic-bovinate-nonterminal-check-obarray) + (setq semantic-bovinate-nonterminal-check-obarray + (make-vector 13 nil))) + (let* ((nt (symbol-name nonterminal)) + (vs (symbol-value + (intern-soft + nt semantic-bovinate-nonterminal-check-obarray)))) + (if (memq stream vs) + ;; Always enter debugger to see the backtrace + (let ((debug-on-signal t) + (debug-on-error t)) + (setq semantic-bovinate-nonterminal-check-obarray nil) + (error "Infinite recursive parse suspected on %s" nt)) + (set (intern nt semantic-bovinate-nonterminal-check-obarray) + (cons stream vs))))) + +;;;###autoload +(defun semantic-bovinate-stream (stream &optional nonterminal) + "Bovinate STREAM, starting at the first NONTERMINAL rule. +Use `bovine-toplevel' if NONTERMINAL is not provided. +This is the core routine for converting a stream into a table. +Return the list (STREAM SEMANTIC-STREAM) where STREAM are those +elements of STREAM that have not been used. SEMANTIC-STREAM is the +list of semantic tokens found." + (if (not nonterminal) + (setq nonterminal 'bovine-toplevel)) + + ;; Try to detect infinite recursive parse when doing a full reparse. + (or semantic--buffer-cache + (semantic-bovinate-nonterminal-check stream nonterminal)) + + (let* ((table semantic--parse-table) + (matchlist (cdr (assq nonterminal table))) + (starting-stream stream) + (nt-loop t) ;non-terminal loop condition + nt-popup ;non-nil if return from nt recursion + nt-stack ;non-terminal recursion stack + s ;Temp Stream Tracker + lse ;Local Semantic Element + lte ;Local matchlist element + tev ;Matchlist entry values from buffer + val ;Value found in buffer. + cvl ;collected values list. + out ;Output + end ;End of match + result + ) + (condition-case debug-condition + (while nt-loop + (catch 'push-non-terminal + (setq nt-popup nil + end (semantic-lex-token-end (car stream))) + (while (or nt-loop nt-popup) + (setq nt-loop nil + out nil) + (while (or nt-popup matchlist) + (if nt-popup + ;; End of a non-terminal recursion + (setq nt-popup nil) + ;; New matching process + (setq s stream ;init s from stream. + cvl nil ;re-init the collected value list. + lte (car matchlist) ;Get the local matchlist entry. + ) + (if (or (byte-code-function-p (car lte)) + (listp (car lte))) + ;; In this case, we have an EMPTY match! Make + ;; stuff up. + (setq cvl (list nil)))) + + (while (and lte + (not (byte-code-function-p (car lte))) + (not (listp (car lte)))) + + ;; GRAMMAR SOURCE DEBUGGING! + (if (and (boundp 'semantic-debug-enabled) + semantic-debug-enabled) + (let* ((db-nt (semantic-bovinate-nonterminal-db-nt)) + (db-ml (cdr (assq db-nt table))) + (db-mlen (length db-ml)) + (db-midx (- db-mlen (length matchlist))) + (db-tlen (length (nth db-midx db-ml))) + (db-tidx (- db-tlen (length lte))) + (frame (progn + (require 'semantic/bovine/debug) + (semantic-bovine-debug-create-frame + db-nt db-midx db-tidx cvl (car s)))) + (cmd (semantic-debug-break frame)) + ) + (cond ((eq 'fail cmd) (setq lte '(trash 0 . 0))) + ((eq 'quit cmd) (signal 'quit "Abort")) + ((eq 'abort cmd) (error "Abort")) + ;; support more commands here. + + ))) + ;; END GRAMMAR SOURCE DEBUGGING! + + (cond + ;; We have a nonterminal symbol. Recurse inline. + ((setq nt-loop (assq (car lte) table)) + + (setq + ;; push state into the nt-stack + nt-stack (cons (vector matchlist cvl lte stream end + ) + nt-stack) + ;; new non-terminal matchlist + matchlist (cdr nt-loop) + ;; new non-terminal stream + stream s) + + (throw 'push-non-terminal t) + + ) + ;; Default case + (t + (setq lse (car s) ;Get the local stream element + s (cdr s)) ;update stream. + ;; Do the compare + (if (eq (car lte) (semantic-lex-token-class lse)) ;syntactic match + (let ((valdot (semantic-lex-token-bounds lse))) + (setq val (semantic-lex-token-text lse)) + (setq lte (cdr lte)) + (if (stringp (car lte)) + (progn + (setq tev (car lte) + lte (cdr lte)) + (if (string-match tev val) + (setq cvl (cons + (if (memq (semantic-lex-token-class lse) + '(comment semantic-list)) + valdot val) + cvl)) ;append this value + (setq lte nil cvl nil))) ;clear the entry (exit) + (setq cvl (cons + (if (memq (semantic-lex-token-class lse) + '(comment semantic-list)) + valdot val) cvl))) ;append unchecked value. + (setq end (semantic-lex-token-end lse)) + ) + (setq lte nil cvl nil)) ;No more matches, exit + ))) + (if (not cvl) ;lte=nil; there was no match. + (setq matchlist (cdr matchlist)) ;Move to next matchlist entry + (let ((start (semantic-lex-token-start (car stream)))) + (setq out (cond + ((car lte) + (funcall (car lte) ;call matchlist fn on values + (nreverse cvl) start end)) + ((and (= (length cvl) 1) + (listp (car cvl)) + (not (numberp (car (car cvl))))) + (append (car cvl) (list start end))) + (t + ;;(append (nreverse cvl) (list start end)))) + ;; MAYBE THE FOLLOWING NEEDS LESS CONS + ;; CELLS THAN THE ABOVE? + (nreverse (cons end (cons start cvl))))) + matchlist nil) ;;generate exit condition + (if (not end) + (setq out nil))) + ;; Nothin? + )) + (setq result + (if (eq s starting-stream) + (list (cdr s) nil) + (list s out))) + (if nt-stack + ;; pop previous state from the nt-stack + (let ((state (car nt-stack))) + + (setq nt-popup t + ;; pop actual parser state + matchlist (aref state 0) + cvl (aref state 1) + lte (aref state 2) + stream (aref state 3) + end (aref state 4) + ;; update the stack + nt-stack (cdr nt-stack)) + + (if out + (let ((len (length out)) + (strip (nreverse (cdr (cdr (reverse out)))))) + (setq end (nth (1- len) out) ;reset end to the end of exp + cvl (cons strip cvl) ;prepend value of exp + lte (cdr lte)) ;update the local table entry + ) + ;; No value means that we need to terminate this + ;; match. + (setq lte nil cvl nil)) ;No match, exit + ))))) + (error + ;; On error just move forward the stream of lexical tokens + (setq result (list (cdr starting-stream) nil)) + (when (and (boundp 'semantic-debug-enabled) + semantic-debug-enabled) + (require 'semantic/bovine/debug) + (let ((frame (semantic-create-bovine-debug-error-frame + debug-condition))) + (semantic-debug-break frame))))) + result)) + +;; Make it the default parser +;;;###autoload +(defalias 'semantic-parse-stream-default 'semantic-bovinate-stream) + +(provide 'semantic/bovine) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-feature: semantic/loaddefs +;; generated-autoload-load-name: "semantic/bovine" +;; End: + +;;; semantic/bovine.el ends here