cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/wisent/semantic-wisent.el

   1 ;;; semantic-wisent.el --- Wisent - Semantic gateway
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 David Ponce
   4
   5 ;; Author: David Ponce <david@dponce.com>
   6 ;; Maintainer: David Ponce <david@dponce.com>
   7 ;; Created: 30 Aug 2001
   8 ;; Keywords: syntax
   9 ;; X-RCS: $Id: semantic-wisent.el,v 1.1 2007-11-26 15:12:27 michaels Exp $
  10
  11 ;; This file is not part of GNU Emacs.
  12
  13 ;; This program is free software; you can redistribute it and/or
  14 ;; modify it under the terms of the GNU General Public License as
  15 ;; published by the Free Software Foundation; either version 2, or (at
  16 ;; your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful, but
  19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 ;; General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29 ;;
  30 ;; Here are functions necessary to use the Wisent LALR parser from
  31 ;; Semantic environment.
  32
  33 ;;; History:
  34 ;;
  35
  36 ;;; Code:
  37
  38 (require 'semantic)
  39 (require 'wisent)
  40 \f
  41 ;;; Lexical analysis
  42 ;;
  43 (defvar wisent-lex-istream nil
  44   "Input stream of `semantic-lex' syntactic tokens.")
  45
  46 (defvar wisent-lex-lookahead nil
  47   "Extra lookahead token.
  48 When non-nil it is directly returned by `wisent-lex-function'.")
  49
  50 ;; Maintain this alias for compatibility until all WY grammars have
  51 ;; been translated again to Elisp code.
  52 (semantic-alias-obsolete 'wisent-lex-make-token-table
  53                          'semantic-lex-make-type-table)
  54
  55 (defmacro wisent-lex-eoi ()
  56   "Return an End-Of-Input lexical token.
  57 The EOI token is like this: ($EOI "" POINT-MAX . POINT-MAX)."
  58   `(cons ',wisent-eoi-term
  59          (cons ""
  60                (cons (point-max) (point-max)))))
  61
  62 (defmacro define-wisent-lexer (name doc &rest body)
  63   "Create a new lexical analyzer with NAME.
  64 DOC is a documentation string describing this analyzer.
  65 When a token is available in `wisent-lex-istream', eval BODY forms
  66 sequentially.  BODY must return a lexical token for the LALR parser.
  67
  68 Each token in input was produced by `semantic-lex', it is a list:
  69
  70   (TOKSYM START . END)
  71
  72 TOKSYM is a terminal symbol used in the grammar.
  73 START and END mark boundary in the current buffer of that token's
  74 value.
  75
  76 Returned tokens must have the form:
  77
  78   (TOKSYM VALUE START . END)
  79
  80 where VALUE is the buffer substring between START and END positions."
  81   `(defun
  82      ,name () ,doc
  83      (cond
  84       (wisent-lex-lookahead
  85        (prog1 wisent-lex-lookahead
  86          (setq wisent-lex-lookahead nil)))
  87       (wisent-lex-istream
  88        ,@body)
  89       ((wisent-lex-eoi)))))
  90
  91 (define-wisent-lexer wisent-lex
  92   "Return the next available lexical token in Wisent's form.
  93 The variable `wisent-lex-istream' contains the list of lexical tokens
  94 produced by `semantic-lex'.  Pop the next token available and convert
  95 it to a form suitable for the Wisent's parser."
  96   (let* ((tk (car wisent-lex-istream)))
  97     ;; Eat input stream
  98     (setq wisent-lex-istream (cdr wisent-lex-istream))
  99     (cons (semantic-lex-token-class tk)
 100           (cons (semantic-lex-token-text tk)
 101                 (semantic-lex-token-bounds tk)))))
 102 \f
 103 ;;; Syntax analysis
 104 ;;
 105 (defvar wisent-error-function nil
 106   "Function used to report parse error.
 107 By default use the function `wisent-message'.")
 108 (make-variable-buffer-local 'wisent-error-function)
 109
 110 (defvar wisent-lexer-function 'wisent-lex
 111   "Function used to obtain the next lexical token in input.
 112 Should be a lexical analyzer created with `define-wisent-lexer'.")
 113 (make-variable-buffer-local 'wisent-lexer-function)
 114
 115 ;; Tag production
 116 ;;
 117 (defsubst wisent-raw-tag (semantic-tag)
 118   "Return raw form of given Semantic tag SEMANTIC-TAG.
 119 Should be used in semantic actions, in grammars, to build a Semantic
 120 parse tree."
 121   (nconc semantic-tag
 122          (if (or $region
 123                  (setq $region (nthcdr 2 wisent-input)))
 124              (list (car $region) (cdr $region))
 125            (list (point-max) (point-max)))))
 126
 127 (defsubst wisent-cook-tag (raw-tag)
 128   "From raw form of Semantic tag RAW-TAG, return a list of cooked tags.
 129 Should be used in semantic actions, in grammars, to build a Semantic
 130 parse tree."
 131   (let* ((cooked (semantic--tag-expand raw-tag))
 132          (l cooked))
 133     (while l
 134       (semantic--tag-put-property (car l) 'reparse-symbol $nterm)
 135       (setq l (cdr l)))
 136     cooked))
 137
 138 ;; Unmatched syntax collector
 139 ;;
 140 (defun wisent-collect-unmatched-syntax (nomatch)
 141   "Add lexical token NOMATCH to the cache of unmatched tokens.
 142 See also the variable `semantic-unmatched-syntax-cache'.
 143
 144 NOMATCH is in Wisent's form: (SYMBOL VALUE START . END)
 145 and will be collected in `semantic-lex' form: (SYMBOL START . END)."
 146   (let ((region (cddr nomatch)))
 147     (and (number-or-marker-p (car region))
 148          (number-or-marker-p (cdr region))
 149          (setq semantic-unmatched-syntax-cache
 150                (cons (cons (car nomatch) region)
 151                      semantic-unmatched-syntax-cache)))))
 152
 153 ;; Parser plug-ins
 154 ;;
 155 ;; The following functions permit to plug the Wisent LALR parser in
 156 ;; Semantic toolkit.  They use the standard API provided by Semantic
 157 ;; to plug parsers in.
 158 ;;
 159 ;; Two plug-ins are available, BUT ONLY ONE MUST BE USED AT A TIME:
 160 ;;
 161 ;; - `wisent-parse-stream' designed to override the standard function
 162 ;;   `semantic-parse-stream'.
 163 ;;
 164 ;; - `wisent-parse-region' designed to override the standard function
 165 ;;   `semantic-parse-region'.
 166 ;;
 167 ;; Maybe the latter is faster because it eliminates a lot of function
 168 ;; call.
 169 ;;
 170 (defun wisent-parse-stream (stream goal)
 171   "Parse STREAM using the Wisent LALR parser.
 172 GOAL is a nonterminal symbol to start parsing at.
 173 Return the list (STREAM SEMANTIC-STREAM) where STREAM are those
 174 elements of STREAM that have not been used.  SEMANTIC-STREAM is the
 175 list of semantic tags found.
 176 The LALR parser automaton must be available in buffer local variable
 177 `semantic--parse-table'.
 178
 179 Must be installed by `semantic-install-function-overrides' to override
 180 the standard function `semantic-parse-stream'."
 181   (let (wisent-lex-istream wisent-lex-lookahead la-elt cache)
 182
 183     ;; IMPLEMENTATION NOTES:
 184     ;; `wisent-parse' returns a lookahead token when it stopped
 185     ;; parsing before encountering the end of input.  To re-enter the
 186     ;; parser it is necessary to push back in the lexical input stream
 187     ;; the last lookahead token issued.  Because the format of
 188     ;; lookahead tokens and tokens in STREAM can be different the
 189     ;; lookahead token is put in the variable `wisent-lex-lookahead'
 190     ;; before calling `wisent-parse'.  Wisent's lexers always pop the
 191     ;; next lexical token from that variable when non nil, then from
 192     ;; the lexical input stream.
 193     ;;
 194     ;; The first element of STREAM is used to keep lookahead tokens
 195     ;; across successive calls to `wisent-parse-stream'.  In fact
 196     ;; what is kept is a stack of lookaheads encountered so far.  It
 197     ;; is cleared when `wisent-parse' returns a valid semantic tag,
 198     ;; or twice the same lookahead token!  The latter indicates that
 199     ;; there is a syntax error on that token.  If so, tokens currently
 200     ;; in the lookahead stack have not been used, and are moved into
 201     ;; `semantic-unmatched-syntax-cache'.  When the parser will be
 202     ;; re-entered, a new lexical token will be read from STREAM.
 203     ;;
 204     ;; The first element of STREAM that contains the lookahead stack
 205     ;; has this format (compatible with the format of `semantic-lex'
 206     ;; tokens):
 207     ;;
 208     ;; (LOOKAHEAD-STACK START . END)
 209     ;;
 210     ;; where LOOKAHEAD-STACK is a list of lookahead tokens.  And
 211     ;; START/END are the bounds of the lookahead at top of stack.
 212
 213     ;; Retrieve lookahead token from stack
 214     (setq la-elt (car stream))
 215     (if (consp (car la-elt))
 216         ;; The first elt of STREAM contains a lookahead stack
 217         (setq wisent-lex-lookahead (caar la-elt)
 218               stream (cdr stream))
 219       (setq la-elt nil))
 220     ;; Parse
 221     (setq wisent-lex-istream stream
 222           cache (semantic-safe "wisent-parse-stream: %s"
 223                   (condition-case error-to-filter
 224                       (wisent-parse semantic--parse-table
 225                                     wisent-lexer-function
 226                                     wisent-error-function
 227                                     goal)
 228                     (args-out-of-range
 229                      (if (and (not debug-on-error)
 230                               (= wisent-parse-max-stack-size
 231                                  (nth 2 error-to-filter)))
 232                          (progn
 233                            (message "wisent-parse-stream: %s"
 234                                     (error-message-string error-to-filter))
 235                            (message "wisent-parse-max-stack-size \
 236 might need to be increased"))
 237                        (apply 'signal error-to-filter))))))
 238     ;; Manage returned lookahead token
 239     (if wisent-lookahead
 240         (if (eq (caar la-elt) wisent-lookahead)
 241             ;; It is already at top of lookahead stack
 242             (progn
 243               (setq cache nil
 244                     la-elt (car la-elt))
 245               (while la-elt
 246                 ;; Collect unmatched tokens from the stack
 247                 (run-hook-with-args
 248                  'wisent-discarding-token-functions (car la-elt))
 249                 (setq la-elt (cdr la-elt))))
 250           ;; New lookahead token
 251           (if (or (consp cache) ;; Clear the stack if parse succeeded
 252                   (null la-elt))
 253               (setq la-elt (cons nil nil)))
 254           ;; Push it into the stack
 255           (setcar la-elt (cons wisent-lookahead (car la-elt)))
 256           ;; Update START/END
 257           (setcdr la-elt (cddr wisent-lookahead))
 258           ;; Push (LOOKAHEAD-STACK START . END) in STREAM
 259           (setq wisent-lex-istream (cons la-elt wisent-lex-istream))))
 260     ;; Return (STREAM SEMANTIC-STREAM)
 261     (list wisent-lex-istream
 262           (if (consp cache) cache '(nil))
 263           )))
 264
 265 (defun wisent-parse-region (start end &optional goal depth returnonerror)
 266   "Parse the area between START and END using the Wisent LALR parser.
 267 Return the list of semantic tags found.
 268 Optional arguments GOAL is a nonterminal symbol to start parsing at,
 269 DEPTH is the lexical depth to scan, and RETURNONERROR is a flag to
 270 stop parsing on syntax error, when non-nil.
 271 The LALR parser automaton must be available in buffer local variable
 272 `semantic--parse-table'.
 273
 274 Must be installed by `semantic-install-function-overrides' to override
 275 the standard function `semantic-parse-region'."
 276   (if (or (< start (point-min)) (> end (point-max)) (< end start))
 277       (error "Invalid bounds [%s %s] passed to `wisent-parse-region'"
 278              start end))
 279   (let* ((case-fold-search semantic-case-fold)
 280          (wisent-lex-istream (semantic-lex start end depth))
 281          ptree tag cooked lstack wisent-lex-lookahead)
 282     ;; Loop while there are lexical tokens available
 283     (while wisent-lex-istream
 284       ;; Parse
 285       (setq wisent-lex-lookahead (car lstack)
 286             tag (semantic-safe "wisent-parse-region: %s"
 287                     (wisent-parse semantic--parse-table
 288                                   wisent-lexer-function
 289                                   wisent-error-function
 290                                   goal)))
 291       ;; Manage returned lookahead token
 292       (if wisent-lookahead
 293           (if (eq (car lstack) wisent-lookahead)
 294               ;; It is already at top of lookahead stack
 295               (progn
 296                 (setq tag nil)
 297                 (while lstack
 298                   ;; Collect unmatched tokens from lookahead stack
 299                   (run-hook-with-args
 300                    'wisent-discarding-token-functions (car lstack))
 301                   (setq lstack (cdr lstack))))
 302             ;; Push new lookahead token into the stack
 303             (setq lstack (cons wisent-lookahead lstack))))
 304       ;; Manage the parser result
 305       (cond
 306        ;; Parse succeeded, cook result
 307        ((consp tag)
 308         (setq lstack nil ;; Clear the lookahead stack
 309               cooked (semantic--tag-expand tag)
 310               ptree (append cooked ptree))
 311         (while cooked
 312           (setq tag    (car cooked)
 313                 cooked (cdr cooked))
 314           (or (semantic--tag-get-property tag 'reparse-symbol)
 315               (semantic--tag-put-property tag 'reparse-symbol goal)))
 316         )
 317        ;; Return on error if requested
 318        (returnonerror
 319         (setq wisent-lex-istream nil)
 320         ))
 321       ;; Work in progress...
 322       (if wisent-lex-istream
 323           (if (eq semantic-working-type 'percent)
 324               (working-status
 325                (/ (* 100 (semantic-lex-token-start
 326                           (car wisent-lex-istream)))
 327                   (point-max)))
 328             (working-dynamic-status))))
 329     ;; Return parse tree
 330     (nreverse ptree)))
 331 \f
 332 ;;; Interfacing with edebug
 333 ;;
 334 (add-hook
 335  'edebug-setup-hook
 336  #'(lambda ()
 337
 338      (def-edebug-spec define-wisent-lexer
 339        (&define name stringp def-body)
 340        )
 341
 342      ))
 343
 344 (provide 'semantic-wisent)
 345
 346 ;;; semantic-wisent.el ends here