lisp/progmodes/ebnf-yac.el

   1 ;;; ebnf-yac.el --- parser for Yacc/Bison
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
   7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
   8 ;; Keywords: wp, ebnf, PostScript
   9 ;; Version: 1.4
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 3, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31 ;;
  32 ;;
  33 ;; This is part of ebnf2ps package.
  34 ;;
  35 ;; This package defines a parser for Yacc/Bison.
  36 ;;
  37 ;; See ebnf2ps.el for documentation.
  38 ;;
  39 ;;
  40 ;; Yacc/Bison Syntax
  41 ;; -----------------
  42 ;;
  43 ;; YACC = { YACC-Definitions }* "%%" { YACC-Rule }* [ "%%" [ YACC-Code ] ].
  44 ;;
  45 ;; YACC-Definitions = ( "%token" | "%left" | "%right" | "%nonassoc" )
  46 ;;                    [ "<" Name ">" ] Name-List
  47 ;;                  | "%prec" Name
  48 ;;                  | "any other Yacc definition"
  49 ;;                  .
  50 ;;
  51 ;; YACC-Code = "any C definition".
  52 ;;
  53 ;; YACC-Rule = Name ":" Alternative ";".
  54 ;;
  55 ;; Alternative = { Sequence || "|" }*.
  56 ;;
  57 ;; Sequence = { Factor }*.
  58 ;;
  59 ;; Factor = Name
  60 ;;        | "'" "character" "'"
  61 ;;        | "error"
  62 ;;        | "{" "C like commands" "}"
  63 ;;        .
  64 ;;
  65 ;; Name-List = { Name || "," }*.
  66 ;;
  67 ;; Name = "[A-Za-z][A-Za-z0-9_.]*".
  68 ;;
  69 ;; Comment = "/*" "any character, but the sequence \"*/\"" "*/"
  70 ;;         | "//" "any character, but the newline \"\\n\"" "\\n".
  71 ;;
  72 ;;
  73 ;; In other words, a valid Name begins with a letter (upper or lower case)
  74 ;; followed by letters, decimal digits, underscore (_) or point (.).  For
  75 ;; example: this_is_a_valid.name, Another_EXAMPLE, mIxEd.CaSe.
  76 ;;
  77 ;;
  78 ;; Acknowledgements
  79 ;; ----------------
  80 ;;
  81 ;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal
  82 ;; with %right, %left and %prec pragmas.  His suggestion was extended to deal
  83 ;; with %nonassoc pragma too.
  84 ;;
  85 ;;
  86 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  87
  88 ;;; Code:
  89
  90
  91 (require 'ebnf-otz)
  92
  93
  94 (defvar ebnf-yac-lex nil
  95   "Value returned by `ebnf-yac-lex' function.")
  96
  97
  98 (defvar ebnf-yac-token-list nil
  99   "List of `%TOKEN' names.")
 100
 101
 102 (defvar ebnf-yac-skip-char nil
 103   "Non-nil means skip printable characters with no grammatical meaning.")
 104
 105
 106 (defvar ebnf-yac-error nil
 107   "Non-nil means \"error\" occurred.")
 108
 109 \f
 110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 111 ;; Syntactic analyzer
 112
 113
 114 ;;; YACC = { YACC-Definitions }* "%%" { YACC-Rule }* [ "%%" [ YACC-Code ] ].
 115 ;;;
 116 ;;; YACC-Code = "any C definition".
 117
 118 (defun ebnf-yac-parser (start)
 119   "yacc/Bison parser."
 120   (let ((total (+ (- ebnf-limit start) 1))
 121         (bias (1- start))
 122         (origin (point))
 123         syntax-list token rule)
 124     (goto-char start)
 125     (setq token (ebnf-yac-lex))
 126     (and (eq token 'end-of-input)
 127          (error "Invalid Yacc/Bison file format"))
 128     (or (eq (ebnf-yac-definitions token) 'yac-separator)
 129         (error "Missing `%%%%'"))
 130     (setq token (ebnf-yac-lex))
 131     (while (not (memq token '(end-of-input yac-separator)))
 132       (ebnf-message-float
 133        "Parsing...%s%%"
 134        (/ (* (- (point) bias) 100.0) total))
 135       (setq token (ebnf-yac-rule token)
 136             rule  (cdr token)
 137             token (car token))
 138       (or (ebnf-add-empty-rule-list rule)
 139           (setq syntax-list (cons rule syntax-list))))
 140     (goto-char origin)
 141     syntax-list))
 142
 143
 144 ;;; YACC-Definitions = ( "%token" | "%left" | "%right" | "%nonassoc" )
 145 ;;;                    [ "<" Name ">" ] Name-List
 146 ;;;                  | "%prec" Name
 147 ;;;                  | "any other Yacc definition"
 148 ;;;                  .
 149
 150 (defun ebnf-yac-definitions (token)
 151   (let ((ebnf-yac-skip-char t))
 152     (while (not (memq token '(yac-separator end-of-input)))
 153       (setq token
 154             (cond
 155              ;; ( "%token" | "%left" | "%right" | "%nonassoc" )
 156              ;; [ "<" Name ">" ] Name-List
 157              ((eq token 'yac-token)
 158               (setq token (ebnf-yac-lex))
 159               (when (eq token 'open-angle)
 160                 (or (eq (ebnf-yac-lex) 'non-terminal)
 161                     (error "Missing type name"))
 162                 (or (eq (ebnf-yac-lex) 'close-angle)
 163                     (error "Missing `>'"))
 164                 (setq token (ebnf-yac-lex)))
 165               (setq token               (ebnf-yac-name-list token)
 166                     ebnf-yac-token-list (nconc (cdr token)
 167                                                ebnf-yac-token-list))
 168               (car token))
 169              ;;  "%prec" Name
 170              ((eq token 'yac-prec)
 171               (or (eq (ebnf-yac-lex) 'non-terminal)
 172                   (error "Missing prec name"))
 173               (ebnf-yac-lex))
 174              ;;  "any other Yacc definition"
 175              (t
 176               (ebnf-yac-lex))
 177              )))
 178     token))
 179
 180
 181 ;;; YACC-Rule = Name ":" Alternative ";".
 182
 183 (defun ebnf-yac-rule (token)
 184   (let ((header ebnf-yac-lex)
 185         (action ebnf-action)
 186         body)
 187     (setq ebnf-action nil)
 188     (or (eq token 'non-terminal)
 189         (error "Invalid rule name"))
 190     (or (eq (ebnf-yac-lex) 'colon)
 191         (error "Invalid rule: missing `:'"))
 192     (setq body (ebnf-yac-alternative))
 193     (or (eq (car body) 'period)
 194         (error "Invalid rule: missing `;'"))
 195     (setq body (cdr body))
 196     (ebnf-eps-add-production header)
 197     (cons (ebnf-yac-lex)
 198           (ebnf-make-production header body action))))
 199
 200
 201 ;;; Alternative = { Sequence || "|" }*.
 202
 203 (defun ebnf-yac-alternative ()
 204   (let (body sequence)
 205     (while (eq (car (setq sequence (ebnf-yac-sequence)))
 206                'alternative)
 207       (and (setq sequence (cdr sequence))
 208            (setq body     (cons sequence body))))
 209     (ebnf-token-alternative body sequence)))
 210
 211
 212 ;;; Sequence = { Factor }*.
 213
 214 (defun ebnf-yac-sequence ()
 215   (let (ebnf-yac-error token seq factor)
 216     (while (setq token  (ebnf-yac-lex)
 217                  factor (ebnf-yac-factor token))
 218       (setq seq (cons factor seq)))
 219     (cons token
 220           (if (and ebnf-yac-ignore-error-recovery ebnf-yac-error)
 221               ;; ignore error recovery
 222               nil
 223             (ebnf-token-sequence seq)))))
 224
 225
 226 ;;; Factor = Name
 227 ;;;        | "'" "character" "'"
 228 ;;;        | "error"
 229 ;;;        | "{" "C like commands" "}"
 230 ;;;        .
 231
 232 (defun ebnf-yac-factor (token)
 233   (cond
 234    ;; 'character'
 235    ((eq token 'terminal)
 236     (ebnf-make-terminal ebnf-yac-lex))
 237    ;; Name
 238    ((eq token 'non-terminal)
 239     (ebnf-make-non-terminal ebnf-yac-lex))
 240    ;; "error"
 241    ((eq token 'yac-error)
 242     (ebnf-make-special ebnf-yac-lex))
 243    ;; not a factor
 244    (t
 245     nil)
 246    ))
 247
 248
 249 ;;; Name-List = { Name || "," }*.
 250
 251 (defun ebnf-yac-name-list (token)
 252   (let (names)
 253     (when (eq token 'non-terminal)
 254       (while (progn
 255                (setq names (cons ebnf-yac-lex names)
 256                      token (ebnf-yac-lex))
 257                (eq token 'comma))
 258         (or (eq (ebnf-yac-lex) 'non-terminal)
 259             (error "Missing token name"))))
 260     (cons token names)))
 261
 262 \f
 263 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 264 ;; Lexical analyzer
 265
 266
 267 ;;; Name = "[A-Za-z][A-Za-z0-9_.]*".
 268 ;;;
 269 ;;; Comment = "/*" "any character, but the sequence \"*/\"" "*/"
 270 ;;;         | "//" "any character" "\\n".
 271
 272 (defconst ebnf-yac-token-table
 273   ;; control character & 8-bit character are set to `error'
 274   (let ((table (make-vector 256 'error)))
 275     ;; upper & lower case letters:
 276     (mapc
 277      #'(lambda (char)
 278          (aset table char 'non-terminal))
 279      "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
 280     ;; printable characters:
 281     (mapc
 282      #'(lambda (char)
 283          (aset table char 'character))
 284      "!#$&()*+-.0123456789=?@[\\]^_`~")
 285     ;; Override space characters:
 286     (aset table ?\n 'space)             ; [NL] linefeed
 287     (aset table ?\r 'space)             ; [CR] carriage return
 288     (aset table ?\t 'space)             ; [HT] horizontal tab
 289     (aset table ?\  'space)             ; [SP] space
 290     ;; Override form feed character:
 291     (aset table ?\f 'form-feed)         ; [FF] form feed
 292     ;; Override other lexical characters:
 293     (aset table ?<  'open-angle)
 294     (aset table ?>  'close-angle)
 295     (aset table ?,  'comma)
 296     (aset table ?%  'yac-pragma)
 297     (aset table ?/  'slash)
 298     (aset table ?\{ 'yac-code)
 299     (aset table ?\" 'string)
 300     (aset table ?\' 'terminal)
 301     (aset table ?:  'colon)
 302     (aset table ?|  'alternative)
 303     (aset table ?\; 'period)
 304     table)
 305   "Vector used to map characters to a lexical token.")
 306
 307
 308 (defun ebnf-yac-initialize ()
 309   "Initializations for Yacc/Bison parser."
 310   (setq ebnf-yac-token-list nil))
 311
 312
 313 (defun ebnf-yac-lex ()
 314   "Lexical analyzer for Yacc/Bison.
 315
 316 Return a lexical token.
 317
 318 See documentation for variable `ebnf-yac-lex'."
 319   (if (>= (point) ebnf-limit)
 320       'end-of-input
 321     (let (token)
 322       ;; skip spaces, code blocks and comments
 323       (while (if (> (following-char) 255)
 324                  (progn
 325                    (setq token 'error)
 326                    nil)
 327                (setq token (aref ebnf-yac-token-table (following-char)))
 328                (cond
 329                 ((or (eq token 'space)
 330                      (and ebnf-yac-skip-char
 331                           (eq token 'character)))
 332                  (ebnf-yac-skip-spaces))
 333                 ((eq token 'yac-code)
 334                  (ebnf-yac-skip-code))
 335                 ((eq token 'slash)
 336                  (ebnf-yac-handle-comment))
 337                 ((eq token 'form-feed)
 338                  (forward-char)
 339                  (setq ebnf-action 'form-feed))
 340                 (t nil)
 341                 )))
 342       (cond
 343        ;; end of input
 344        ((>= (point) ebnf-limit)
 345         'end-of-input)
 346        ;; error
 347        ((eq token 'error)
 348         (error "Invalid character"))
 349        ;; "string"
 350        ((eq token 'string)
 351         (setq ebnf-yac-lex (ebnf-get-string))
 352         'string)
 353        ;; terminal: 'char'
 354        ((eq token 'terminal)
 355         (setq ebnf-yac-lex (ebnf-string " -&(-~" ?\' "terminal"))
 356         'terminal)
 357        ;; non-terminal, terminal or "error"
 358        ((eq token 'non-terminal)
 359         (setq ebnf-yac-lex (ebnf-buffer-substring "0-9A-Za-z_."))
 360         (cond ((member ebnf-yac-lex ebnf-yac-token-list)
 361                'terminal)
 362               ((string= ebnf-yac-lex "error")
 363                (setq ebnf-yac-error t)
 364                'yac-error)
 365               (t
 366                'non-terminal)
 367               ))
 368        ;; %% and Yacc pragmas (%TOKEN, %START, etc).
 369        ((eq token 'yac-pragma)
 370         (forward-char)
 371         (cond
 372          ;; Yacc separator
 373          ((eq (following-char) ?%)
 374           (forward-char)
 375           'yac-separator)
 376          ;; %TOKEN, %RIGHT, %LEFT,  %PREC, %NONASSOC
 377          ((cdr (assoc (upcase (ebnf-buffer-substring "0-9A-Za-z_"))
 378                       '(("TOKEN"    . yac-token)
 379                         ("RIGHT"    . yac-token)
 380                         ("LEFT"     . yac-token)
 381                         ("NONASSOC" . yac-token)
 382                         ("PREC"     . yac-prec)))))
 383          ;; other Yacc pragmas
 384          (t
 385           'yac-pragma)
 386          ))
 387        ;; miscellaneous
 388        (t
 389         (forward-char)
 390         token)
 391        ))))
 392
 393
 394 (defun ebnf-yac-skip-spaces ()
 395   (skip-chars-forward
 396    (if ebnf-yac-skip-char
 397        "\n\r\t !#$&()*+-.0123456789=?@[\\\\]^_`~"
 398      "\n\r\t ")
 399    ebnf-limit)
 400   (< (point) ebnf-limit))
 401
 402
 403 ;; replace the range "\177-\377" (see `ebnf-range-regexp').
 404 (defconst ebnf-yac-skip-chars
 405   (ebnf-range-regexp "^{}/'\"\000-\010\013\016-\037" ?\177 ?\377))
 406
 407
 408 (defun ebnf-yac-skip-code ()
 409   (forward-char)
 410   (let ((pair 1))
 411     (while (> pair 0)
 412       (skip-chars-forward ebnf-yac-skip-chars ebnf-limit)
 413       (cond
 414        ((= (following-char) ?{)
 415         (forward-char)
 416         (setq pair (1+ pair)))
 417        ((= (following-char) ?})
 418         (forward-char)
 419         (setq pair (1- pair)))
 420        ((= (following-char) ?/)
 421         (ebnf-yac-handle-comment))
 422        ((= (following-char) ?\")
 423         (ebnf-get-string))
 424        ((= (following-char) ?\')
 425         (ebnf-string " -&(-~" ?\' "character"))
 426        (t
 427         (error "Invalid character"))
 428        )))
 429   (ebnf-yac-skip-spaces))
 430
 431
 432 (defun ebnf-yac-handle-comment ()
 433   (forward-char)
 434   (cond
 435    ;; begin comment
 436    ((= (following-char) ?*)
 437     (ebnf-yac-skip-comment)
 438     (ebnf-yac-skip-spaces))
 439    ;; line comment
 440    ((= (following-char) ?/)
 441     (end-of-line)
 442     (ebnf-yac-skip-spaces))
 443    ;; no comment
 444    (t nil)
 445    ))
 446
 447
 448 ;; replace the range "\177-\237" (see `ebnf-range-regexp').
 449 (defconst ebnf-yac-comment-chars
 450   (ebnf-range-regexp "^*\000-\010\013\016-\037" ?\177 ?\237))
 451
 452
 453 (defun ebnf-yac-skip-comment ()
 454   (forward-char)
 455   (cond
 456    ;; open EPS file
 457    ((and ebnf-eps-executing (= (following-char) ?\[))
 458     (ebnf-eps-add-context (ebnf-yac-eps-filename)))
 459    ;; close EPS file
 460    ((and ebnf-eps-executing (= (following-char) ?\]))
 461     (ebnf-eps-remove-context (ebnf-yac-eps-filename)))
 462    ;; EPS header
 463    ((and ebnf-eps-executing (= (following-char) ?H))
 464     (ebnf-eps-header-comment (ebnf-yac-eps-filename)))
 465    ;; EPS footer
 466    ((and ebnf-eps-executing (= (following-char) ?F))
 467     (ebnf-eps-footer-comment (ebnf-yac-eps-filename)))
 468    ;; any other action in comment
 469    (t
 470     (setq ebnf-action (aref ebnf-comment-table (following-char))))
 471    )
 472   (let ((not-end t))
 473     (while not-end
 474       (skip-chars-forward ebnf-yac-comment-chars ebnf-limit)
 475       (cond ((>= (point) ebnf-limit)
 476              (error "Missing end of comment: `*/'"))
 477             ((= (following-char) ?*)
 478              (skip-chars-forward "*" ebnf-limit)
 479              (when (= (following-char) ?/)
 480                ;; end of comment
 481                (forward-char)
 482                (setq not-end nil)))
 483             (t
 484              (error "Invalid character"))
 485             ))))
 486
 487
 488 (defun ebnf-yac-eps-filename ()
 489   (forward-char)
 490   (buffer-substring-no-properties
 491    (point)
 492    (let ((chars (concat ebnf-yac-comment-chars "\n"))
 493          found)
 494      (while (not found)
 495        (skip-chars-forward chars ebnf-limit)
 496        (setq found
 497              (cond ((>= (point) ebnf-limit)
 498                     (point))
 499                    ((= (following-char) ?*)
 500                     (skip-chars-forward "*" ebnf-limit)
 501                     (if (/= (following-char) ?\/)
 502                         nil
 503                       (backward-char)
 504                       (point)))
 505                    (t
 506                     (point))
 507                    )))
 508      found)))
 509
 510 \f
 511 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 512
 513
 514 (provide 'ebnf-yac)
 515
 516
 517 ;; arch-tag: 8a96989c-0b1d-42ba-a020-b2901f9a2a4d
 518 ;;; ebnf-yac.el ends here