code.delx.au - gnu-emacs-elpa/blob - packages/wisi/wisi-compile.el

   1 ;;; Grammar compiler for the wisent LALR parser, integrating Wisi OpenToken output.
   2 ;;
   3 ;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
   6 ;;
   7 ;; This file is part of GNU Emacs.
   8 ;;
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13 ;;
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18 ;;
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21 ;;
  22 ;;; History: first experimental version Jan 2013
  23 ;;
  24 ;;; Context
  25 ;;
  26 ;; Semantic (info "(semantic)Top") provides an LALR(1) parser
  27 ;; wisent-parse. The grammar used is defined by the functions
  28 ;; semantic-grammar-create-package, which reads a bison-like source
  29 ;; file and produces corresponding elisp source, and
  30 ;; wisent-compile-grammar, which generates a parser table.
  31 ;;
  32 ;; However, the algorithm used in wisent-compile-grammar cannot cope
  33 ;; with the grammar for the Ada language, because it is not
  34 ;; LALR(1). So we provide a generalized LALR parser, which spawns
  35 ;; parallel LALR parsers at each conflict. Instead of also rewriting
  36 ;; the entire semantic grammar compiler, we use the OpenToken LALR
  37 ;; parser generator, which is easier to modify (it is written in Ada,
  38 ;; not Lisp).
  39 ;;
  40 ;; The Ada function Wisi.Generate reads the bison-like input and
  41 ;; produces corresponding elisp source code, similar to that
  42 ;; produced by semantic-grammar-create-package.
  43 ;;
  44 ;; wisi-compile-grammar (provided here) generate the automaton
  45 ;; structure required by wisi-parse, using functions from
  46 ;; wisent/comp.el
  47 ;;
  48 ;;;;
  49
  50 (eval-when-compile
  51   ;; can't just 'require'; `wisent-with-context' doesn't work.
  52   ;; also can't load .elc; must load .el or .el.gz
  53   (let ((file (locate-library "semantic/wisent/comp.el")))
  54     (if file
  55         (load file)
  56       (error "source library semantic/wisent/comp.el not installed; install emacs lisp sources"))))
  57
  58 (eval-and-compile
  59   (require 'semantic/wisent/comp))
  60
  61 (defun wisi-compose-action (value symbol-array nonterms)
  62   (let ((symbol (intern-soft (format "%s:%d" (car value) (cdr value)) symbol-array))
  63         (prod (car (nth (cdr value) (cdr (assoc (car value) nonterms))))))
  64     (if symbol
  65         (list (car value) symbol (length prod))
  66       (error "%s not in symbol-array" symbol))))
  67
  68 (defun wisi-replace-actions (action symbol-array nonterms)
  69   "Replace semantic action symbol names in ACTION with list as defined in `wisi-compile-grammar'.
  70 ACTION is the alist for one state from the grammar; NONTERMS is from the grammar.
  71 Return the new alist."
  72   ;; result is (nonterm index action-symbol token-count)
  73   (let (result item)
  74     (while action
  75      (setq item (pop action))
  76      (cond
  77       ((or
  78         (memq (cdr item) '(error accept))
  79         (numberp (cdr item)))
  80        (push item result))
  81
  82       ((listp (cdr item))
  83        (let ((value (cdr item)))
  84          (cond
  85           ((symbolp (car value))
  86            ;; reduction
  87            (push (cons (car item)
  88                        (wisi-compose-action value symbol-array nonterms))
  89                  result))
  90
  91           ((integerp (car value))
  92            ;; shift/reduce conflict
  93            (push (cons (car item)
  94                        (list (car value)
  95                              (wisi-compose-action (cadr value) symbol-array nonterms)))
  96                  result))
  97
  98           ((integerp (cadr value))
  99            ;; reduce/shift conflict
 100            (push (cons (car item)
 101                        (list (wisi-compose-action (car value) symbol-array nonterms)
 102                              (cadr value)))
 103                  result))
 104
 105           (t ;; reduce/reduce conflict
 106            (push (cons (car item)
 107                        (list (wisi-compose-action (car value) symbol-array nonterms)
 108                              (wisi-compose-action (cadr value) symbol-array nonterms)))
 109                  result))
 110           )))
 111
 112       (t
 113        (error "unexpected '%s'; expected 'error, 'accept, numberp, stringp, listp" (cdr item)))
 114       ));; while/cond
 115
 116    (reverse result)))
 117
 118 (defun wisi-semantic-action (r rcode tags rlhs)
 119   "Define an Elisp function for semantic action at rule R.
 120 On entry RCODE[R] contains a vector [BODY N (NTERM I)] where BODY
 121 is the body of the semantic action, N is the number of tokens in
 122 the production, NTERM is the nonterminal the semantic action
 123 belongs to, and I is the index of the production and associated
 124 semantic action in the NTERM rule.  Returns the semantic action
 125 symbol, which is interned in RCODE[0].
 126
 127 The semantic action function accepts one argument, the list of
 128 tokens to be reduced. It returns nil; it is called for the user
 129 side-effects only."
 130   ;; based on comp.el wisent-semantic-action
 131   (let* ((actn (aref rcode r))
 132          (n    (aref actn 1))         ; number of tokens in production
 133          (name (apply 'format "%s:%d" (aref actn 2)))
 134          (form (aref actn 0))
 135          (action-symbol (intern name (aref rcode 0))))
 136
 137     (fset action-symbol
 138           `(lambda (wisi-tokens)
 139              (let* (($nterm ',(aref tags (aref rlhs r)))
 140                     ($1 nil));; wisent-parse-nonterminals defines a default body of $1 for empty actions
 141                ,form
 142                nil)))
 143
 144     (list (car (aref actn 2)) action-symbol n)))
 145
 146 (defun wisi-compile-grammar (grammar)
 147   "Compile the LALR(1) GRAMMAR; return the automaton for wisi-parse.
 148 GRAMMAR is a list TERMINALS NONTERMS ACTIONS GOTOS, where:
 149
 150 TERMINALS is a list of terminal token symbols.
 151
 152 NONTERMS is a list of productions; each production is a
 153 list (nonterm (tokens action) ...) where `action' is any lisp form.
 154
 155 ACTIONS is an array indexed by parser state, of alists indexed by
 156 terminal tokens. The value of each item in the alists is one of:
 157
 158 'error
 159
 160 'accept
 161
 162 integer - shift; gives new state
 163
 164 '(nonterm . index) - reduce by nonterm production index.
 165
 166 '(integer (nonterm . index)) - a shift/reduce conflict
 167 '((nonterm . index) integer) - a reduce/shift conflict
 168 '((nonterm . index) (nonterm . index)) - a reduce/reduce conflict
 169
 170 The first item in the alist must have the key 'default (not a
 171 terminal token); it is used when no other item matches the
 172 current token.
 173
 174 GOTOS is an array indexed by parser state, of alists giving the
 175 new state after a reduce for each nonterminal legal in that
 176 state.
 177
 178 The automaton is an array with 3 elements:
 179
 180 parser-actions is a copy of the input ACTIONS, with reduction
 181 actions replaced by a list (nonterm action-symbol token-count),
 182 where `nonterm' is a symbol from NONTERMS, and is the
 183 non-terminal to reduce to, token-count is the number of tokens in
 184 the reduction, action-symbol is nil if there is no user action,
 185 or a symbol from semantic-actions (below).
 186
 187 gotos is a copy of GOTOS.
 188
 189 semantic-actions is an obarray containing functions that
 190 implement the user action for each nonterminal; the function
 191 names have the format nonterm:index."
 192   (wisent-with-context compile-grammar
 193     (wisent-parse-grammar;; set global vars used by wisent-semantic-action
 194      (cons
 195       (nth 0 grammar);; TOKENS
 196       (cons nil ;; ASSOCS
 197             (nth 1 grammar));; NONTERMS
 198       ))
 199
 200     (aset rcode 0 (make-vector 13 0));; obarray for semantic actions
 201
 202     ;; create semantic action functions, interned in rcode[0]
 203     (let* ((i 1))
 204       (while (<= i nrules)
 205         (wisi-semantic-action i rcode tags rlhs)
 206         (setq i (1+ i)))
 207       )
 208
 209     ;; replace semantic actions in ACTIONS with symbols from symbol-array
 210     (let ((nactions (length (nth 2 grammar)))
 211           (actions (nth 2 grammar))
 212           (symbol-array (aref rcode 0))
 213           (i 0))
 214       (while (< i nactions)
 215         (aset actions i
 216               (wisi-replace-actions (aref actions i) symbol-array (nth 1 grammar)))
 217         (setq i (1+ i)))
 218       (vector
 219        actions
 220        (nth 3 grammar)
 221        symbol-array)
 222       )))
 223
 224 (provide 'wisi-compile)
 225
 226 ;;;; end of file