auto-install/wisent.el

   1 ;;; wisent.el --- GNU Bison for Emacs - Runtime
   2
   3 ;; Copyright (C) 2009, 2010 Eric M. Ludlam
   4 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 David Ponce
   5
   6 ;; Author: David Ponce <david@dponce.com>
   7 ;; Maintainer: David Ponce <david@dponce.com>
   8 ;; Created: 30 January 2002
   9 ;; Keywords: syntax
  10 ;; X-RCS: $Id: wisent.el,v 1.43 2010-04-09 02:07:37 zappo Exp $
  11
  12 ;; This file is not part of GNU Emacs.
  13
  14 ;; This program is free software; you can redistribute it and/or
  15 ;; modify it under the terms of the GNU General Public License as
  16 ;; published by the Free Software Foundation; either version 2, or (at
  17 ;; your option) any later version.
  18
  19 ;; This program is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with this program; see the file COPYING.  If not, write to
  26 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  27 ;; Boston, MA 02110-1301, USA.
  28
  29 ;;; Commentary:
  30 ;;
  31 ;; Parser engine and runtime of Wisent.
  32 ;;
  33 ;; Wisent (the European Bison ;-) is an Elisp implementation of the
  34 ;; GNU Compiler Compiler Bison.  The Elisp code is a port of the C
  35 ;; code of GNU Bison 1.28 & 1.31.
  36 ;;
  37 ;; For more details on the basic concepts for understanding Wisent,
  38 ;; read the Bison manual ;)
  39 ;;
  40 ;; For more details on Wisent itself read the Wisent manual.
  41
  42 ;;; History:
  43 ;;
  44
  45 ;;; Code:
  46 (provide 'wisent)
  47
  48 (defgroup wisent nil
  49   "
  50            /\\_.-^^^-._/\\     The GNU
  51            \\_         _/
  52             (     `o  `      (European ;-) Bison
  53              \\      ` /
  54              (   D  ,¨       for Emacs!
  55               ` ~ ,¨
  56                `\"\""
  57   :group 'semantic)
  58
  59 \f
  60 ;;;; -------------
  61 ;;;; Runtime stuff
  62 ;;;; -------------
  63
  64 ;;; Compatibility
  65 (eval-and-compile
  66   (if (fboundp 'char-valid-p)
  67       (defalias 'wisent-char-p 'char-valid-p)
  68     (defalias 'wisent-char-p 'char-or-char-int-p)))
  69
  70 ;;; Printed representation of terminals and nonterminals
  71 (defconst wisent-escape-sequence-strings
  72   '(
  73     (?\a . "'\\a'")                     ; C-g
  74     (?\b . "'\\b'")                     ; backspace, BS, C-h
  75     (?\t . "'\\t'")                     ; tab, TAB, C-i
  76     (?\n  . "'\\n'")                    ; newline, C-j
  77     (?\v . "'\\v'")                     ; vertical tab, C-k
  78     (?\f . "'\\f'")                     ; formfeed character, C-l
  79     (?\r . "'\\r'")                     ; carriage return, RET, C-m
  80     (?\e . "'\\e'")                     ; escape character, ESC, C-[
  81     (?\\ . "'\\'")                      ; backslash character, \
  82     (?\d . "'\\d'")                     ; delete character, DEL
  83     )
  84   "Printed representation of usual escape sequences.")
  85
  86 (defsubst wisent-item-to-string (item)
  87   "Return a printed representation of ITEM.
  88 ITEM can be a nonterminal or terminal symbol, or a character literal."
  89   (if (wisent-char-p item)
  90         (or (cdr (assq item wisent-escape-sequence-strings))
  91             (format "'%c'" item))
  92     (symbol-name item)))
  93
  94 (defsubst wisent-token-to-string (token)
  95   "Return a printed representation of lexical token TOKEN."
  96   (format "%s%s(%S)" (wisent-item-to-string (car token))
  97           (if (nth 2 token) (format "@%s" (nth 2 token)) "")
  98           (nth 1 token)))
  99
 100 ;;; Special symbols
 101 (defconst wisent-eoi-term '$EOI
 102   "End Of Input token.")
 103
 104 (defconst wisent-error-term 'error
 105   "Error recovery token.")
 106
 107 (defconst wisent-accept-tag 'accept
 108   "Accept result after input successfully parsed.")
 109
 110 (defconst wisent-error-tag 'error
 111   "Process a syntax error.")
 112
 113 ;;; Special functions
 114 (defun wisent-automaton-p (obj)
 115   "Return non-nil if OBJ is a LALR automaton.
 116 If OBJ is a symbol check its value."
 117   (and obj (symbolp obj) (boundp obj)
 118        (setq obj (symbol-value obj)))
 119   (and (vectorp obj) (= 4 (length obj))
 120        (vectorp (aref obj 0)) (vectorp (aref obj 1))
 121        (= (length (aref obj 0)) (length (aref obj 1)))
 122        (listp (aref obj 2)) (vectorp (aref obj 3))))
 123
 124 (defsubst wisent-region (&rest positions)
 125   "Return the start/end positions of the region including POSITIONS.
 126 Each element of POSITIONS is a pair (START-POS . END-POS) or nil.  The
 127 returned value is the pair (MIN-START-POS . MAX-END-POS) or nil if no
 128 POSITIONS are available."
 129   (let ((pl (delq nil positions)))
 130     (if pl
 131         (cons (apply #'min (mapcar #'car pl))
 132               (apply #'max (mapcar #'cdr pl))))))
 133
 134 ;;; Reporting
 135 ;;;###autoload
 136 (defvar wisent-parse-verbose-flag nil
 137   "*Non-nil means to issue more messages while parsing.")
 138
 139 ;;;###autoload
 140 (defun wisent-parse-toggle-verbose-flag ()
 141   "Toggle whether to issue more messages while parsing."
 142   (interactive)
 143   (setq wisent-parse-verbose-flag (not wisent-parse-verbose-flag))
 144   (when (cedet-called-interactively-p 'interactive)
 145     (message "More messages while parsing %sabled"
 146              (if wisent-parse-verbose-flag "en" "dis"))))
 147
 148 (defsubst wisent-message (string &rest args)
 149   "Print a one-line message if `wisent-parse-verbose-flag' is set.
 150 Pass STRING and ARGS arguments to `message'."
 151   (and wisent-parse-verbose-flag
 152        (apply 'message string args)))
 153 \f
 154 ;;;; --------------------
 155 ;;;; The LR parser engine
 156 ;;;; --------------------
 157
 158 (defcustom wisent-parse-max-stack-size 500
 159   "The parser stack size."
 160   :type 'integer
 161   :group 'wisent)
 162
 163 (defcustom wisent-parse-max-recover 3
 164   "Number of tokens to shift before turning off error status."
 165   :type 'integer
 166   :group 'wisent)
 167
 168 (defvar wisent-discarding-token-functions nil
 169   "List of functions to be called when discarding a lexical token.
 170 These functions receive the lexical token discarded.
 171 When the parser encounters unexpected tokens, it can discards them,
 172 based on what directed by error recovery rules.  Either when the
 173 parser reads tokens until one is found that can be shifted, or when an
 174 semantic action calls the function `wisent-skip-token' or
 175 `wisent-skip-block'.
 176 For language specific hooks, make sure you define this as a local
 177 hook.")
 178
 179 (defvar wisent-pre-parse-hook nil
 180   "Normal hook run just before entering the LR parser engine.")
 181
 182 (defvar wisent-post-parse-hook nil
 183   "Normal hook run just after the LR parser engine terminated.")
 184
 185 (defvar wisent-loop nil
 186   "The current parser action.
 187 Stop parsing when set to nil.
 188 This variable only has meaning in the scope of `wisent-parse'.")
 189
 190 (defvar wisent-nerrs nil
 191   "The number of parse errors encountered so far.")
 192
 193 (defvar wisent-lookahead nil
 194   "The lookahead lexical token.
 195 This value is non-nil if the parser terminated because of an
 196 unrecoverable error.")
 197
 198 ;; Variables and macros that are useful in semantic actions.
 199 (defvar wisent-parse-lexer-function nil
 200   "The user supplied lexer function.
 201 This function don't have arguments.
 202 This variable only has meaning in the scope of `wisent-parse'.")
 203
 204 (defvar wisent-parse-error-function nil
 205   "The user supplied error function.
 206 This function must accept one argument, a message string.
 207 This variable only has meaning in the scope of `wisent-parse'.")
 208
 209 (defvar wisent-input nil
 210   "The last token read.
 211 This variable only has meaning in the scope of `wisent-parse'.")
 212
 213 (defvar wisent-recovering nil
 214   "Non-nil means that the parser is recovering.
 215 This variable only has meaning in the scope of `wisent-parse'.")
 216
 217 ;; Variables that only have meaning in the scope of a semantic action.
 218 ;; These global definitions avoid byte-compiler warnings.
 219 (defvar $region nil)
 220 (defvar $nterm  nil)
 221 (defvar $action nil)
 222
 223 (defmacro wisent-lexer ()
 224   "Obtain the next terminal in input."
 225   '(funcall wisent-parse-lexer-function))
 226
 227 (defmacro wisent-error (msg)
 228   "Call the user supplied error reporting function with message MSG."
 229   `(funcall wisent-parse-error-function ,msg))
 230
 231 (defmacro wisent-errok ()
 232   "Resume generating error messages immediately for subsequent syntax errors.
 233 This is useful primarily in error recovery semantic actions."
 234   '(setq wisent-recovering nil))
 235
 236 (defmacro wisent-clearin ()
 237   "Discard the current lookahead token.
 238 This will cause a new lexical token to be read.
 239 This is useful primarily in error recovery semantic actions."
 240   '(setq wisent-input nil))
 241
 242 (defmacro wisent-abort ()
 243   "Abort parsing and save the lookahead token.
 244 This is useful primarily in error recovery semantic actions."
 245   '(setq wisent-lookahead wisent-input
 246          wisent-loop nil))
 247
 248 (defmacro wisent-set-region (start end)
 249   "Change the region of text matched by the current nonterminal.
 250 START and END are respectively the beginning and end positions of the
 251 region.  If START or END values are not a valid positions the region
 252 is set to nil."
 253   `(setq $region (and (number-or-marker-p ,start)
 254                       (number-or-marker-p ,end)
 255                       (cons ,start ,end))))
 256
 257 (defun wisent-skip-token ()
 258   "Skip the lookahead token in order to resume parsing.
 259 Return nil.
 260 Must be used in error recovery semantic actions."
 261   (if (eq (car wisent-input) wisent-eoi-term)
 262       ;; Does nothing at EOI to avoid infinite recovery loop.
 263       nil
 264     (wisent-message "%s: skip %s" $action
 265                     (wisent-token-to-string wisent-input))
 266     (run-hook-with-args
 267      'wisent-discarding-token-functions wisent-input)
 268     (wisent-clearin)
 269     (wisent-errok)))
 270
 271 (defun wisent-skip-block (&optional bounds)
 272   "Safely skip a parenthesized block in order to resume parsing.
 273 Return nil.
 274 Must be used in error recovery semantic actions.
 275 Optional argument BOUNDS is a pair (START . END) which indicates where
 276 the parenthesized block starts.  Typically the value of a `$regionN'
 277 variable, where `N' is the Nth element of the current rule components
 278 that match the block beginning.  It defaults to the value of the
 279 `$region' variable."
 280   (let ((start (car (or bounds $region)))
 281         end input)
 282     (if (not (number-or-marker-p start))
 283         ;; No nonterminal region available, skip the lookahead token.
 284         (wisent-skip-token)
 285       ;; Try to skip a block.
 286       (if (not (setq end (save-excursion
 287                            (goto-char start)
 288                            (and (looking-at "\\s(")
 289                                 (condition-case nil
 290                                     (1- (scan-lists (point) 1 0))
 291                                   (error nil))))))
 292           ;; Not actually a block, skip the lookahead token.
 293           (wisent-skip-token)
 294         ;; OK to safely skip the block, so read input until a matching
 295         ;; close paren or EOI is encountered.
 296         (setq input wisent-input)
 297         (while (and (not (eq (car input) wisent-eoi-term))
 298                     (< (nth 2 input) end))
 299           (run-hook-with-args
 300            'wisent-discarding-token-functions input)
 301           (setq input (wisent-lexer)))
 302         (wisent-message "%s: in enclosing block, skip from %s to %s"
 303                         $action
 304                         (wisent-token-to-string wisent-input)
 305                         (wisent-token-to-string input))
 306         (if (eq (car wisent-input) wisent-eoi-term)
 307             ;; Does nothing at EOI to avoid infinite recovery loop.
 308             nil
 309           (wisent-clearin)
 310           (wisent-errok))
 311         ;; Set end of $region to end of block.
 312         (wisent-set-region (car $region) (1+ end))
 313         nil))))
 314
 315 ;;; Core parser engine
 316 (defsubst wisent-production-bounds (stack i j)
 317   "Determine the start and end locations of a production value.
 318 Return a pair (START . END), where START is the first available start
 319 location, and END the last available end location, in components
 320 values of the rule currently reduced.
 321 Return nil when no component location is available.
 322 STACK is the parser stack.
 323 I and J are the indices in STACK of respectively the value of the
 324 first and last components of the current rule.
 325 This function is for internal use by semantic actions' generated
 326 lambda-expression."
 327   (let ((f (cadr (aref stack i)))
 328         (l (cddr (aref stack j))))
 329     (while (/= i j)
 330       (cond
 331        ((not f) (setq f (cadr (aref stack (setq i (+ i 2))))))
 332        ((not l) (setq l (cddr (aref stack (setq j (- j 2))))))
 333        ((setq i j))))
 334     (and f l (cons f l))))
 335
 336 (defmacro wisent-parse-action (i al)
 337   "Return the next parser action.
 338 I is a token item number and AL is the list of (item . action)
 339 available at current state.  The first element of AL contains the
 340 default action for this state."
 341   `(cdr (or (assq ,i ,al) (car ,al))))
 342
 343 (defsubst wisent-parse-start (start starts)
 344   "Return the first lexical token to shift for START symbol.
 345 STARTS is the table of allowed start symbols or nil if the LALR
 346 automaton has only one entry point."
 347   (if (null starts)
 348       ;; Only one entry point, return the first lexical token
 349       ;; available in input.
 350       (wisent-lexer)
 351     ;; Multiple start symbols defined, return the internal lexical
 352     ;; token associated to START.  By default START is the first
 353     ;; nonterminal defined in STARTS.
 354     (let ((token (cdr (if start (assq start starts) (car starts)))))
 355       (if token
 356           (list token (symbol-name token))
 357         (error "Invalid start symbol %s" start)))))
 358
 359 (defun wisent-parse (automaton lexer &optional error start)
 360   "Parse input using the automaton specified in AUTOMATON.
 361
 362 - AUTOMATON is an LALR(1) automaton generated by
 363   `wisent-compile-grammar'.
 364
 365 - LEXER is a function with no argument called by the parser to obtain
 366   the next terminal (token) in input.
 367
 368 - ERROR is an optional reporting function called when a parse error
 369   occurs.  It receives a message string to report.  It defaults to the
 370   function `wisent-message'.
 371
 372 - START specify the start symbol (nonterminal) used by the parser as
 373   its goal.  It defaults to the start symbol defined in the grammar
 374   \(see also `wisent-compile-grammar')."
 375   (run-hooks 'wisent-pre-parse-hook)
 376   (let* ((actions (aref automaton 0))
 377          (gotos   (aref automaton 1))
 378          (starts  (aref automaton 2))
 379          (stack (make-vector wisent-parse-max-stack-size nil))
 380          (sp 0)
 381          (wisent-loop t)
 382          (wisent-parse-error-function (or error 'wisent-message))
 383          (wisent-parse-lexer-function lexer)
 384          (wisent-recovering nil)
 385          (wisent-input (wisent-parse-start start starts))
 386          state tokid choices choice)
 387     (setq wisent-nerrs     0 ;; Reset parse error counter
 388           wisent-lookahead nil) ;; and lookahead token
 389     (aset stack 0 0) ;; Initial state
 390     (while wisent-loop
 391       (setq state (aref stack sp)
 392             tokid (car wisent-input)
 393             wisent-loop (wisent-parse-action tokid (aref actions state)))
 394       (cond
 395
 396        ;; Input successfully parsed
 397        ;; -------------------------
 398        ((eq wisent-loop wisent-accept-tag)
 399         (setq wisent-loop nil))
 400
 401        ;; Syntax error in input
 402        ;; ---------------------
 403        ((eq wisent-loop wisent-error-tag)
 404         ;; Report this error if not already recovering from an error.
 405         (setq choices (aref actions state))
 406         (or wisent-recovering
 407             (wisent-error
 408              (format "Syntax error, unexpected %s, expecting %s"
 409                      (wisent-token-to-string wisent-input)
 410                      (mapconcat 'wisent-item-to-string
 411                                 (delq wisent-error-term
 412                                       (mapcar 'car (cdr choices)))
 413                                 ", "))))
 414         ;; Increment the error counter
 415         (setq wisent-nerrs (1+ wisent-nerrs))
 416         ;; If just tried and failed to reuse lookahead token after an
 417         ;; error, discard it.
 418         (if (eq wisent-recovering wisent-parse-max-recover)
 419             (if (eq tokid wisent-eoi-term)
 420                 (wisent-abort) ;; Terminate if at end of input.
 421               (wisent-message "Error recovery: skip %s"
 422                               (wisent-token-to-string wisent-input))
 423               (run-hook-with-args
 424                'wisent-discarding-token-functions wisent-input)
 425               (setq wisent-input (wisent-lexer)))
 426
 427           ;; Else will try to reuse lookahead token after shifting the
 428           ;; error token.
 429
 430           ;; Each real token shifted decrements this.
 431           (setq wisent-recovering wisent-parse-max-recover)
 432           ;; Pop the value/state stack to see if an action associated
 433           ;; to special terminal symbol 'error exists.
 434           (while (and (>= sp 0)
 435                       (not (and (setq state   (aref stack sp)
 436                                       choices (aref actions state)
 437                                       choice  (assq wisent-error-term choices))
 438                                 (natnump (cdr choice)))))
 439             (setq sp (- sp 2)))
 440
 441           (if (not choice)
 442               ;; No 'error terminal was found.  Just terminate.
 443               (wisent-abort)
 444             ;; Try to recover and continue parsing.
 445             ;; Shift the error terminal.
 446             (setq state (cdr choice)    ; new state
 447                   sp    (+ sp 2))
 448             (aset stack (1- sp) nil)    ; push value
 449             (aset stack sp state)       ; push new state
 450             ;; Adjust input to error recovery state.  Unless 'error
 451             ;; triggers a reduction, eat the input stream until an
 452             ;; expected terminal symbol is found, or EOI is reached.
 453             (if (cdr (setq choices (aref actions state)))
 454                 (while (not (or (eq (car wisent-input) wisent-eoi-term)
 455                                 (assq (car wisent-input) choices)))
 456                   (wisent-message "Error recovery: skip %s"
 457                                   (wisent-token-to-string wisent-input))
 458                   (run-hook-with-args
 459                    'wisent-discarding-token-functions wisent-input)
 460                   (setq wisent-input (wisent-lexer)))))))
 461
 462        ;; Shift current token on top of the stack
 463        ;; ---------------------------------------
 464        ((natnump wisent-loop)
 465         ;; Count tokens shifted since error; after
 466         ;; `wisent-parse-max-recover', turn off error status.
 467         (setq wisent-recovering (and (natnump wisent-recovering)
 468                                      (> wisent-recovering 1)
 469                                      (1- wisent-recovering)))
 470         (setq sp (+ sp 2))
 471         (aset stack (1- sp) (cdr wisent-input))
 472         (aset stack sp wisent-loop)
 473         (setq wisent-input (wisent-lexer)))
 474
 475        ;; Reduce by rule (call semantic action)
 476        ;; -------------------------------------
 477        (t
 478         (setq sp (funcall wisent-loop stack sp gotos))
 479         (or wisent-input (setq wisent-input (wisent-lexer))))))
 480     (run-hooks 'wisent-post-parse-hook)
 481     (car (aref stack 1))))
 482
 483 ;;; wisent.el ends here