semantic-grammar-wy.el

;;; semantic-grammar-wy.el --- Generated parser support file

;; Copyright (C) 2002, 2003, 2004 David Ponce

;; Author:  <russ@RUSS>
;; Created: 2009-04-29 18:01:34-0400
;; Keywords: syntax
;; X-RCS: $Id$

;; This file is not part of GNU Emacs.
;;
;; This program 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 2, or (at
;; your option) any later version.
;;
;; This software 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:
;;
;; PLEASE DO NOT MANUALLY EDIT THIS FILE!  It is automatically
;; generated from the grammar file semantic-grammar.wy.

;;; History:
;;

;;; Code:

;;; Prologue
;;
;; Current parsed nonterminal name.
  (defvar semantic-grammar-wy--nterm nil)
  ;; Index of rule in a nonterminal clause.
  (defvar semantic-grammar-wy--rindx nil)

;;; Declarations
;;
(defconst semantic-grammar-wy--keyword-table
    (semantic-lex-make-keyword-table
     '(("%default-prec" . DEFAULT-PREC)
       ("%no-default-prec" . NO-DEFAULT-PREC)
       ("%keyword" . KEYWORD)
       ("%languagemode" . LANGUAGEMODE)
       ("%left" . LEFT)
       ("%nonassoc" . NONASSOC)
       ("%package" . PACKAGE)
       ("%prec" . PREC)
       ("%put" . PUT)
       ("%quotemode" . QUOTEMODE)
       ("%right" . RIGHT)
       ("%scopestart" . SCOPESTART)
       ("%start" . START)
       ("%token" . TOKEN)
       ("%type" . TYPE)
       ("%use-macros" . USE-MACROS))
     'nil)
  "Table of language keywords.")

(defconst semantic-grammar-wy--token-table
    (semantic-lex-make-type-table
     '(("punctuation"
	(GT . ">")
	(LT . "<")
	(OR . "|")
	(SEMI . ";")
	(COLON . ":"))
       ("close-paren"
	(RBRACE . "}")
	(RPAREN . ")"))
       ("open-paren"
	(LBRACE . "{")
	(LPAREN . "("))
       ("block"
	(BRACE_BLOCK . "(LBRACE RBRACE)")
	(PAREN_BLOCK . "(LPAREN RPAREN)"))
       ("code"
	(EPILOGUE . "%%...EOF")
	(PROLOGUE . "%{...%}"))
       ("sexp"
	(SEXP))
       ("qlist"
	(PREFIXED_LIST))
       ("char"
	(CHARACTER))
       ("symbol"
	(PERCENT_PERCENT . "\\`%%\\'")
	(SYMBOL))
       ("string"
	(STRING)))
     '(("punctuation" :declared t)
       ("block" :declared t)
       ("sexp" matchdatatype sexp)
       ("sexp" syntax "\\=")
       ("sexp" :declared t)
       ("qlist" matchdatatype sexp)
       ("qlist" syntax "\\s'\\s-*(")
       ("qlist" :declared t)
       ("char" syntax semantic-grammar-lex-c-char-re)
       ("char" :declared t)
       ("symbol" syntax ":?\\(\\sw\\|\\s_\\)+")
       ("symbol" :declared t)
       ("string" :declared t)
       ("keyword" :declared t)))
  "Table of lexical tokens.")

(defconst semantic-grammar-wy--parse-table
    (progn
      (eval-when-compile
	(require 'wisent-comp))
      (wisent-compile-grammar
       '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT)
	 nil
	 (grammar
	  ((prologue))
	  ((epilogue))
	  ((declaration))
	  ((nonterminal))
	  ((PERCENT_PERCENT)))
	 (prologue
	  ((PROLOGUE)
	   (wisent-raw-tag
	    (semantic-tag-new-code "prologue" nil))))
	 (epilogue
	  ((EPILOGUE)
	   (wisent-raw-tag
	    (semantic-tag-new-code "epilogue" nil))))
	 (declaration
	  ((decl)
	   (eval $1)))
	 (decl
	  ((default_prec_decl))
	  ((no_default_prec_decl))
	  ((languagemode_decl))
	  ((package_decl))
	  ((precedence_decl))
	  ((put_decl))
	  ((quotemode_decl))
	  ((scopestart_decl))
	  ((start_decl))
	  ((keyword_decl))
	  ((token_decl))
	  ((type_decl))
	  ((use_macros_decl)))
	 (default_prec_decl
	     ((DEFAULT-PREC)
	      `(wisent-raw-tag
		(semantic-tag "default-prec" 'assoc :value
			      '("t")))))
	 (no_default_prec_decl
	  ((NO-DEFAULT-PREC)
	   `(wisent-raw-tag
	     (semantic-tag "default-prec" 'assoc :value
			   '("nil")))))
	 (languagemode_decl
	  ((LANGUAGEMODE symbols)
	   `(wisent-raw-tag
	     (semantic-tag ',(car $2)
			   'languagemode :rest ',(cdr $2)))))
	 (package_decl
	  ((PACKAGE SYMBOL)
	   `(wisent-raw-tag
	     (semantic-tag-new-package ',$2 nil))))
	 (precedence_decl
	  ((associativity token_type_opt items)
	   `(wisent-raw-tag
	     (semantic-tag ',$1 'assoc :type ',$2 :value ',$3))))
	 (associativity
	  ((LEFT)
	   (progn "left"))
	  ((RIGHT)
	   (progn "right"))
	  ((NONASSOC)
	   (progn "nonassoc")))
	 (put_decl
	  ((PUT put_name put_value)
	   `(wisent-raw-tag
	     (semantic-tag ',$2 'put :value ',(list $3))))
	  ((PUT put_name put_value_list)
	   `(wisent-raw-tag
	     (semantic-tag ',$2 'put :value ',$3)))
	  ((PUT put_name_list put_value)
	   `(wisent-raw-tag
	     (semantic-tag ',(car $2)
			   'put :rest ',(cdr $2)
			   :value ',(list $3))))
	  ((PUT put_name_list put_value_list)
	   `(wisent-raw-tag
	     (semantic-tag ',(car $2)
			   'put :rest ',(cdr $2)
			   :value ',$3))))
	 (put_name_list
	  ((BRACE_BLOCK)
	   (mapcar 'semantic-tag-name
		   (semantic-parse-region
		    (car $region1)
		    (cdr $region1)
		    'put_names 1))))
	 (put_names
	  ((LBRACE)
	   nil)
	  ((RBRACE)
	   nil)
	  ((put_name)
	   (wisent-raw-tag
	    (semantic-tag $1 'put-name))))
	 (put_name
	  ((SYMBOL))
	  ((token_type)))
	 (put_value_list
	  ((BRACE_BLOCK)
	   (mapcar 'semantic-tag-code-detail
		   (semantic-parse-region
		    (car $region1)
		    (cdr $region1)
		    'put_values 1))))
	 (put_values
	  ((LBRACE)
	   nil)
	  ((RBRACE)
	   nil)
	  ((put_value)
	   (wisent-raw-tag
	    (semantic-tag-new-code "put-value" $1))))
	 (put_value
	  ((SYMBOL any_value)
	   (cons $1 $2)))
	 (scopestart_decl
	  ((SCOPESTART SYMBOL)
	   `(wisent-raw-tag
	     (semantic-tag ',$2 'scopestart))))
	 (quotemode_decl
	  ((QUOTEMODE SYMBOL)
	   `(wisent-raw-tag
	     (semantic-tag ',$2 'quotemode))))
	 (start_decl
	  ((START symbols)
	   `(wisent-raw-tag
	     (semantic-tag ',(car $2)
			   'start :rest ',(cdr $2)))))
	 (keyword_decl
	  ((KEYWORD SYMBOL string_value)
	   `(wisent-raw-tag
	     (semantic-tag ',$2 'keyword :value ',$3))))
	 (token_decl
	  ((TOKEN token_type_opt SYMBOL string_value)
	   `(wisent-raw-tag
	     (semantic-tag ',$3 ',(if $2 'token 'keyword)
			   :type ',$2 :value ',$4)))
	  ((TOKEN token_type_opt symbols)
	   `(wisent-raw-tag
	     (semantic-tag ',(car $3)
			   'token :type ',$2 :rest ',(cdr $3)))))
	 (token_type_opt
	  (nil)
	  ((token_type)))
	 (token_type
	  ((LT SYMBOL GT)
	   (progn $2)))
	 (type_decl
	  ((TYPE token_type plist_opt)
	   `(wisent-raw-tag
	     (semantic-tag ',$2 'type :value ',$3))))
	 (plist_opt
	  (nil)
	  ((plist)))
	 (plist
	  ((plist put_value)
	   (append
	    (list $2)
	    $1))
	  ((put_value)
	   (list $1)))
	 (use_name_list
	  ((BRACE_BLOCK)
	   (mapcar 'semantic-tag-name
		   (semantic-parse-region
		    (car $region1)
		    (cdr $region1)
		    'use_names 1))))
	 (use_names
	  ((LBRACE)
	   nil)
	  ((RBRACE)
	   nil)
	  ((SYMBOL)
	   (wisent-raw-tag
	    (semantic-tag $1 'use-name))))
	 (use_macros_decl
	  ((USE-MACROS SYMBOL use_name_list)
	   `(wisent-raw-tag
	     (semantic-tag "macro" 'macro :type ',$2 :value ',$3))))
	 (string_value
	  ((STRING)
	   (read $1)))
	 (any_value
	  ((SYMBOL))
	  ((STRING))
	  ((PAREN_BLOCK))
	  ((PREFIXED_LIST))
	  ((SEXP)))
	 (symbols
	  ((lifo_symbols)
	   (nreverse $1)))
	 (lifo_symbols
	  ((lifo_symbols SYMBOL)
	   (cons $2 $1))
	  ((SYMBOL)
	   (list $1)))
	 (nonterminal
	  ((SYMBOL
	    (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0)
	    COLON rules SEMI)
	   (wisent-raw-tag
	    (semantic-tag $1 'nonterminal :children $4))))
	 (rules
	  ((lifo_rules)
	   (apply 'nconc
		  (nreverse $1))))
	 (lifo_rules
	  ((lifo_rules OR rule)
	   (cons $3 $1))
	  ((rule)
	   (list $1)))
	 (rule
	  ((rhs)
	   (let*
	       ((nterm semantic-grammar-wy--nterm)
		(rindx semantic-grammar-wy--rindx)
		(rhs $1)
		comps prec action elt)
	     (setq semantic-grammar-wy--rindx
		   (1+ semantic-grammar-wy--rindx))
	     (while rhs
	       (setq elt
		     (car rhs)
		     rhs
		     (cdr rhs))
	       (cond
		 ((vectorp elt)
		  (if prec
		      (error "duplicate %%prec in `%s:%d' rule" nterm rindx))
		  (setq prec
			(aref elt 0)))
		 ((consp elt)
		  (if
		      (or action comps)
		      (setq comps
			    (cons elt comps)
			    semantic-grammar-wy--rindx
			    (1+ semantic-grammar-wy--rindx))
		      (setq action
			    (car elt))))
		 (t
		  (setq comps
			(cons elt comps)))))
	     (wisent-cook-tag
	      (wisent-raw-tag
	       (semantic-tag
		(format "%s:%d" nterm rindx)
		'rule :type
		(if comps "group" "empty")
		:value comps :prec prec :expr action))))))
	 (rhs
	  (nil)
	  ((rhs item)
	   (cons $2 $1))
	  ((rhs action)
	   (cons
	    (list $2)
	    $1))
	  ((rhs PREC item)
	   (cons
	    (vector $3)
	    $1)))
	 (action
	  ((PAREN_BLOCK))
	  ((PREFIXED_LIST))
	  ((BRACE_BLOCK)
	   (format "(progn\n%s)"
		   (let
		       ((s $1))
		     (if
			 (string-match "^{[
\n	 ]*" s)
			 (setq s
			       (substring s
					  (match-end 0))))
		     (if
			 (string-match "[
\n	 ]*}$" s)
			 (setq s
			       (substring s 0
					  (match-beginning 0))))
		     s))))
	 (items
	  ((lifo_items)
	   (nreverse $1)))
	 (lifo_items
	  ((lifo_items item)
	   (cons $2 $1))
	  ((item)
	   (list $1)))
	 (item
	  ((SYMBOL))
	  ((CHARACTER))))
       '(grammar prologue epilogue declaration nonterminal rule put_names put_values use_names)))
  "Parser table.")

(defun semantic-grammar-wy--install-parser ()
  "Setup the Semantic Parser."
  (semantic-install-function-overrides
   '((parse-stream . wisent-parse-stream)))
  (setq semantic-parser-name "LALR"
	semantic--parse-table semantic-grammar-wy--parse-table
	semantic-debug-parser-source "semantic-grammar.wy"
	semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table
	semantic-lex-types-obarray semantic-grammar-wy--token-table)
  ;; Collect unmatched syntax lexical tokens
  (semantic-make-local-hook 'wisent-discarding-token-functions)
  (add-hook 'wisent-discarding-token-functions
	    'wisent-collect-unmatched-syntax nil t))


;;; Analyzers
;;
(require 'semantic-lex)

(define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer
    "sexp analyzer for <sexp> tokens."
  "\\="
  'SEXP)

(define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer
    "sexp analyzer for <qlist> tokens."
  "\\s'\\s-*("
  'PREFIXED_LIST)

(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer
    "keyword analyzer for <keyword> tokens."
  "\\(\\sw\\|\\s_\\)+")

(define-lex-block-type-analyzer semantic-grammar-wy--<block>-block-analyzer
    "block analyzer for <block> tokens."
  "\\s(\\|\\s)"
  '((("(" LPAREN PAREN_BLOCK)
     ("{" LBRACE BRACE_BLOCK))
    (")" RPAREN)
    ("}" RBRACE))
  )

(define-lex-regex-type-analyzer semantic-grammar-wy--<char>-regexp-analyzer
    "regexp analyzer for <char> tokens."
  semantic-grammar-lex-c-char-re
  nil
  'CHARACTER)

(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer
    "sexp analyzer for <string> tokens."
  "\\s\""
  'STRING)

(define-lex-regex-type-analyzer semantic-grammar-wy--<symbol>-regexp-analyzer
    "regexp analyzer for <symbol> tokens."
  ":?\\(\\sw\\|\\s_\\)+"
  '((PERCENT_PERCENT . "\\`%%\\'"))
  'SYMBOL)

(define-lex-string-type-analyzer semantic-grammar-wy--<punctuation>-string-analyzer
    "string analyzer for <punctuation> tokens."
  "\\(\\s.\\|\\s$\\|\\s'\\)+"
  '((GT . ">")
    (LT . "<")
    (OR . "|")
    (SEMI . ";")
    (COLON . ":"))
  'punctuation)


;;; Epilogue
;;
(define-lex semantic-grammar-lexer
  "Lexical analyzer that handles Semantic grammar buffers.
It ignores whitespaces, newlines and comments."
  semantic-lex-ignore-newline
  semantic-lex-ignore-whitespace
  ;; Must detect prologue/epilogue before other symbols/keywords!
  semantic-grammar-lex-prologue
  semantic-grammar-lex-epilogue
  semantic-grammar-wy--<keyword>-keyword-analyzer
  semantic-grammar-wy--<symbol>-regexp-analyzer
  semantic-grammar-wy--<char>-regexp-analyzer
  semantic-grammar-wy--<string>-sexp-analyzer
  ;; Must detect comments after strings because `comment-start-skip'
  ;; regexp match semicolons inside strings!
  semantic-lex-ignore-comments
  ;; Must detect prefixed list before punctuation because prefix chars
  ;; are also punctuations!
  semantic-grammar-wy--<qlist>-sexp-analyzer
  ;; Must detect punctuations after comments because the semicolon can
  ;; be a punctuation or a comment start!
  semantic-grammar-wy--<punctuation>-string-analyzer
  semantic-grammar-wy--<block>-block-analyzer
  semantic-grammar-wy--<sexp>-sexp-analyzer
  )

(provide 'semantic-grammar-wy)

;;; semantic-grammar-wy.el ends here