lisp/progmodes/ebnf-yac.el

   1 ;;; ebnf-yac.el --- parser for Yacc/Bison
   2
   3 ;; Copyright (C) 1999, 2000 Free Sofware Foundation, Inc.
   4
   5 ;; Author:     Vinicius Jose Latorre <vinicius@cpqd.com.br>
   6 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
   7 ;; Keywords:   wp, ebnf, PostScript
   8 ;; Time-stamp: <2001-07-15 01:04:02 pavel>
   9 ;; Version:    1.1
  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 2, 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., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, 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" [ "<" Name ">" ] Name-List
  46 ;;                  | "any other Yacc definition"
  47 ;;                  .
  48 ;;
  49 ;; YACC-Code = "any C definition".
  50 ;;
  51 ;; YACC-Rule = Name ":" Alternative ";".
  52 ;;
  53 ;; Alternative = { Sequence || "|" }*.
  54 ;;
  55 ;; Sequence = { Factor }*.
  56 ;;
  57 ;; Factor = Name
  58 ;;        | "'" "character" "'"
  59 ;;        | "error"
  60 ;;        | "{" "C like commands" "}"
  61 ;;        .
  62 ;;
  63 ;; Name-List = { Name || "," }*.
  64 ;;
  65 ;; Name = "[A-Za-z][A-Za-z0-9_.]*".
  66 ;;
  67 ;; Comment = "/*" "any character, but the sequence \"*/\"" "*/"
  68 ;;         | "//" "any character" "\\n".
  69 ;;
  70 ;;
  71 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  72
  73 ;;; Code:
  74
  75
  76 (require 'ebnf-otz)
  77
  78
  79 (defvar ebnf-yac-lex nil
  80   "Value returned by `ebnf-yac-lex' function.")
  81
  82
  83 (defvar ebnf-yac-token-list nil
  84   "List of `%TOKEN' names.")
  85
  86
  87 (defvar ebnf-yac-skip-char nil
  88   "Non-nil means skip printable characters with no grammatical meaning.")
  89
  90
  91 (defvar ebnf-yac-error nil
  92   "Non-nil means \"error\" occured.")
  93
  94 \f
  95 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  96 ;; Syntatic analyzer
  97
  98
  99 ;;; YACC = { YACC-Definitions }* "%%" { YACC-Rule }* [ "%%" [ YACC-Code ] ].
 100 ;;;
 101 ;;; YACC-Code = "any C definition".
 102
 103 (defun ebnf-yac-parser (start)
 104   "yacc/Bison parser."
 105   (let ((total (+ (- ebnf-limit start) 1))
 106         (bias (1- start))
 107         (origin (point))
 108         syntax-list token rule)
 109     (goto-char start)
 110     (setq token (ebnf-yac-lex))
 111     (and (eq token 'end-of-input)
 112          (error "Invalid Yacc/Bison file format"))
 113     (or (eq (ebnf-yac-definitions token) 'yac-separator)
 114         (error "Missing `%%%%'"))
 115     (setq token (ebnf-yac-lex))
 116     (while (not (memq token '(end-of-input yac-separator)))
 117       (ebnf-message-float
 118        "Parsing...%s%%"
 119        (/ (* (- (point) bias) 100.0) total))
 120       (setq token (ebnf-yac-rule token)
 121             rule  (cdr token)
 122             token (car token))
 123       (or (ebnf-add-empty-rule-list rule)
 124           (setq syntax-list (cons rule syntax-list))))
 125     (goto-char origin)
 126     syntax-list))
 127
 128
 129 ;;; YACC-Definitions = "%token" [ "<" Name ">" ] Name-List
 130 ;;;                  | "any other Yacc definition"
 131 ;;;                  .
 132
 133 (defun ebnf-yac-definitions (token)
 134   (let ((ebnf-yac-skip-char t))
 135     (while (not (memq token '(yac-separator end-of-input)))
 136       (setq token
 137             (cond
 138              ;; "%token" [ "<" Name ">" ] Name-List
 139              ((eq token 'yac-token)
 140               (setq token (ebnf-yac-lex))
 141               (when (eq token 'open-angle)
 142                 (or (eq (ebnf-yac-lex) 'non-terminal)
 143                     (error "Missing type name"))
 144                 (or (eq (ebnf-yac-lex) 'close-angle)
 145                     (error "Missing `>'"))
 146                 (setq token (ebnf-yac-lex)))
 147               (setq token               (ebnf-yac-name-list token)
 148                     ebnf-yac-token-list (nconc (cdr token)
 149                                                ebnf-yac-token-list))
 150               (car token))
 151              ;; "any other Yacc definition"
 152              (t
 153               (ebnf-yac-lex))
 154              )))
 155     token))
 156
 157
 158 ;;; YACC-Rule = Name ":" Alternative ";".
 159
 160 (defun ebnf-yac-rule (token)
 161   (let ((header ebnf-yac-lex)
 162         (action ebnf-action)
 163         body)
 164     (setq ebnf-action nil)
 165     (or (eq token 'non-terminal)
 166         (error "Invalid rule name"))
 167     (or (eq (ebnf-yac-lex) 'colon)
 168         (error "Invalid rule: missing `:'"))
 169     (setq body (ebnf-yac-alternative))
 170     (or (eq (car body) 'period)
 171         (error "Invalid rule: missing `;'"))
 172     (setq body (cdr body))
 173     (ebnf-eps-add-production header)
 174     (cons (ebnf-yac-lex)
 175           (ebnf-make-production header body action))))
 176
 177
 178 ;;; Alternative = { Sequence || "|" }*.
 179
 180 (defun ebnf-yac-alternative ()
 181   (let (body sequence)
 182     (while (eq (car (setq sequence (ebnf-yac-sequence)))
 183                'alternative)
 184       (and (setq sequence (cdr sequence))
 185            (setq body     (cons sequence body))))
 186     (ebnf-token-alternative body sequence)))
 187
 188
 189 ;;; Sequence = { Factor }*.
 190
 191 (defun ebnf-yac-sequence ()
 192   (let (ebnf-yac-error token seq factor)
 193     (while (setq token  (ebnf-yac-lex)
 194                  factor (ebnf-yac-factor token))
 195       (setq seq (cons factor seq)))
 196     (cons token
 197           (cond
 198            ;; ignore error recovery
 199            ((and ebnf-yac-ignore-error-recovery ebnf-yac-error)
 200             nil)
 201            ;; null sequence
 202            ((null seq)
 203             (ebnf-make-empty))
 204            ;; sequence with only one element
 205            ((= (length seq) 1)
 206             (car seq))
 207            ;; a real sequence
 208            (t
 209             (ebnf-make-sequence (nreverse seq)))
 210            ))))
 211
 212
 213 ;;; Factor = Name
 214 ;;;        | "'" "character" "'"
 215 ;;;        | "error"
 216 ;;;        | "{" "C like commands" "}"
 217 ;;;        .
 218
 219 (defun ebnf-yac-factor (token)
 220   (cond
 221    ;; 'character'
 222    ((eq token 'terminal)
 223     (ebnf-make-terminal ebnf-yac-lex))
 224    ;; Name
 225    ((eq token 'non-terminal)
 226     (ebnf-make-non-terminal ebnf-yac-lex))
 227    ;; "error"
 228    ((eq token 'yac-error)
 229     (ebnf-make-special ebnf-yac-lex))
 230    ;; not a factor
 231    (t
 232     nil)
 233    ))
 234
 235
 236 ;;; Name-List = { Name || "," }*.
 237
 238 (defun ebnf-yac-name-list (token)
 239   (let (names)
 240     (when (eq token 'non-terminal)
 241       (while (progn
 242                (setq names (cons ebnf-yac-lex names)
 243                      token (ebnf-yac-lex))
 244                (eq token 'comma))
 245         (or (eq (ebnf-yac-lex) 'non-terminal)
 246             (error "Missing token name"))))
 247     (cons token names)))
 248
 249 \f
 250 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 251 ;; Lexical analyzer
 252
 253
 254 ;;; Name = "[A-Za-z][A-Za-z0-9_.]*".
 255 ;;;
 256 ;;; Comment = "/*" "any character, but the sequence \"*/\"" "*/"
 257 ;;;         | "//" "any character" "\\n".
 258
 259 (defconst ebnf-yac-token-table
 260   ;; control character & 8-bit character are set to `error'
 261   (let ((table (make-vector 256 'error)))
 262     ;; upper & lower case letters:
 263     (mapcar
 264      #'(lambda (char)
 265          (aset table char 'non-terminal))
 266      "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
 267     ;; printable characters:
 268     (mapcar
 269      #'(lambda (char)
 270          (aset table char 'character))
 271      "!#$&()*+-.0123456789=?@[\\]^_`~")
 272     ;; Override space characters:
 273     (aset table ?\n 'space)             ; [NL] linefeed
 274     (aset table ?\r 'space)             ; [CR] carriage return
 275     (aset table ?\t 'space)             ; [HT] horizontal tab
 276     (aset table ?\  'space)             ; [SP] space
 277     ;; Override form feed character:
 278     (aset table ?\f 'form-feed)         ; [FF] form feed
 279     ;; Override other lexical characters:
 280     (aset table ?<  'open-angle)
 281     (aset table ?>  'close-angle)
 282     (aset table ?,  'comma)
 283     (aset table ?%  'yac-pragma)
 284     (aset table ?/  'slash)
 285     (aset table ?\{ 'yac-code)
 286     (aset table ?\" 'string)
 287     (aset table ?\' 'terminal)
 288     (aset table ?:  'colon)
 289     (aset table ?|  'alternative)
 290     (aset table ?\; 'period)
 291     table)
 292   "Vector used to map characters to a lexical token.")
 293
 294
 295 (defun ebnf-yac-initialize ()
 296   "Initializations for Yacc/Bison parser."
 297   (setq ebnf-yac-token-list nil))
 298
 299
 300 (defun ebnf-yac-lex ()
 301   "Lexical analyser for Yacc/Bison.
 302
 303 Return a lexical token.
 304
 305 See documentation for variable `ebnf-yac-lex'."
 306   (if (>= (point) ebnf-limit)
 307       'end-of-input
 308     (let (token)
 309       ;; skip spaces, code blocks and comments
 310       (while (if (> (following-char) 255)
 311                  (progn
 312                    (setq token 'error)
 313                    nil)
 314                (setq token (aref ebnf-yac-token-table (following-char)))
 315                (cond
 316                 ((or (eq token 'space)
 317                      (and ebnf-yac-skip-char
 318                           (eq token 'character)))
 319                  (ebnf-yac-skip-spaces))
 320                 ((eq token 'yac-code)
 321                  (ebnf-yac-skip-code))
 322                 ((eq token 'slash)
 323                  (ebnf-yac-handle-comment))
 324                 ((eq token 'form-feed)
 325                  (forward-char)
 326                  (setq ebnf-action 'form-feed))
 327                 (t nil)
 328                 )))
 329       (cond
 330        ;; end of input
 331        ((>= (point) ebnf-limit)
 332         'end-of-input)
 333        ;; error
 334        ((eq token 'error)
 335         (error "Illegal character"))
 336        ;; "string"
 337        ((eq token 'string)
 338         (setq ebnf-yac-lex (ebnf-get-string))
 339         'string)
 340        ;; terminal: 'char'
 341        ((eq token 'terminal)
 342         (setq ebnf-yac-lex (ebnf-string " -&(-~" ?\' "terminal"))
 343         'terminal)
 344        ;; non-terminal, terminal or "error"
 345        ((eq token 'non-terminal)
 346         (setq ebnf-yac-lex (ebnf-buffer-substring "0-9A-Za-z_."))
 347         (cond ((member ebnf-yac-lex ebnf-yac-token-list)
 348                'terminal)
 349               ((string= ebnf-yac-lex "error")
 350                (setq ebnf-yac-error t)
 351                'yac-error)
 352               (t
 353                'non-terminal)
 354               ))
 355        ;; %% and Yacc pragmas (%TOKEN, %START, etc).
 356        ((eq token 'yac-pragma)
 357         (forward-char)
 358         (cond
 359          ;; Yacc separator
 360          ((eq (following-char) ?%)
 361           (forward-char)
 362           'yac-separator)
 363          ;; %TOKEN
 364          ((string= (upcase (ebnf-buffer-substring "0-9A-Za-z_")) "TOKEN")
 365           'yac-token)
 366          ;; other Yacc pragmas
 367          (t
 368           'yac-pragma)
 369          ))
 370        ;; miscellaneous
 371        (t
 372         (forward-char)
 373         token)
 374        ))))
 375
 376
 377 (defun ebnf-yac-skip-spaces ()
 378   (skip-chars-forward
 379    (if ebnf-yac-skip-char
 380        "\n\r\t !#$&()*+-.0123456789=?@[\\\\]^_`~"
 381      "\n\r\t ")
 382    ebnf-limit)
 383   (< (point) ebnf-limit))
 384
 385
 386 (defun ebnf-yac-skip-code ()
 387   (forward-char)
 388   (let ((pair 1))
 389     (while (> pair 0)
 390       ;; replace the range "\177-\377" (see `ebnf-range-regexp').
 391       (skip-chars-forward (ebnf-range-regexp "^{}/'\"\000-\010\013\016-\037"
 392                                              ?\177 ?\377)
 393                           ebnf-limit)
 394       (cond
 395        ((= (following-char) ?{)
 396         (forward-char)
 397         (setq pair (1+ pair)))
 398        ((= (following-char) ?})
 399         (forward-char)
 400         (setq pair (1- pair)))
 401        ((= (following-char) ?/)
 402         (ebnf-yac-handle-comment))
 403        ((= (following-char) ?\")
 404         (ebnf-get-string))
 405        ((= (following-char) ?\')
 406         (ebnf-string " -&(-~" ?\' "character"))
 407        (t
 408         (error "Illegal character"))
 409        )))
 410   (ebnf-yac-skip-spaces))
 411
 412
 413 (defun ebnf-yac-handle-comment ()
 414   (forward-char)
 415   (cond
 416    ;; begin comment
 417    ((= (following-char) ?*)
 418     (ebnf-yac-skip-comment)
 419     (ebnf-yac-skip-spaces))
 420    ;; line comment
 421    ((= (following-char) ?/)
 422     (end-of-line)
 423     (ebnf-yac-skip-spaces))
 424    ;; no comment
 425    (t nil)
 426    ))
 427
 428
 429 ;; replace the range "\177-\237" (see `ebnf-range-regexp').
 430 (defconst ebnf-yac-comment-chars
 431   (ebnf-range-regexp "^*\000-\010\013\016-\037" ?\177 ?\237))
 432
 433
 434 (defun ebnf-yac-skip-comment ()
 435   (forward-char)
 436   (cond
 437    ;; open EPS file
 438    ((and ebnf-eps-executing (= (following-char) ?\[))
 439     (ebnf-eps-add-context (ebnf-yac-eps-filename)))
 440    ;; close EPS file
 441    ((and ebnf-eps-executing (= (following-char) ?\]))
 442     (ebnf-eps-remove-context (ebnf-yac-eps-filename)))
 443    ;; any other action in comment
 444    (t
 445     (setq ebnf-action (aref ebnf-comment-table (following-char))))
 446    )
 447   (let ((not-end t))
 448     (while not-end
 449       (skip-chars-forward ebnf-yac-comment-chars ebnf-limit)
 450       (cond ((>= (point) ebnf-limit)
 451              (error "Missing end of comment: `*/'"))
 452             ((= (following-char) ?*)
 453              (skip-chars-forward "*" ebnf-limit)
 454              (when (= (following-char) ?/)
 455                ;; end of comment
 456                (forward-char)
 457                (setq not-end nil)))
 458             (t
 459              (error "Illegal character"))
 460             ))))
 461
 462
 463 (defun ebnf-yac-eps-filename ()
 464   (forward-char)
 465   (buffer-substring-no-properties
 466    (point)
 467    (let ((chars (concat ebnf-yac-comment-chars "\n"))
 468          found)
 469      (while (not found)
 470        (skip-chars-forward chars ebnf-limit)
 471        (setq found
 472              (cond ((>= (point) ebnf-limit)
 473                     (point))
 474                    ((= (following-char) ?*)
 475                     (skip-chars-forward "*" ebnf-limit)
 476                     (if (/= (following-char) ?\/)
 477                         nil
 478                       (backward-char)
 479                       (point)))
 480                    (t
 481                     (point))
 482                    )))
 483      found)))
 484
 485 \f
 486 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 487
 488
 489 (provide 'ebnf-yac)
 490
 491
 492 ;;; ebnf-yac.el ends here