lr-driver.el

   1 ;; ---------------------------------------------------------------------- ;;
   2 ;; FICHIER               : lr-dvr.scm                                     ;;
   3 ;; DATE DE CREATION      : Fri May 31 15:47:05 1996                       ;;
   4 ;; DERNIERE MODIFICATION : Fri May 31 15:51:13 1996                       ;;
   5 ;; ---------------------------------------------------------------------- ;;
   6 ;; Copyright (c) 1996 Dominique Boucher                                   ;;
   7 ;; ---------------------------------------------------------------------- ;;
   8 ;; The LR parser driver                                                   ;;
   9 ;;                                                                        ;;
  10 ;; lr-dvr.scm is part of the lalr.scm distribution which is free          ;;
  11 ;; software; you can redistribute it and/or modify                        ;;
  12 ;; it under the terms of the GNU General Public License as published by   ;;
  13 ;; the Free Software Foundation; either version 2, or (at your option)    ;;
  14 ;; any later version.                                                     ;;
  15 ;;                                                                        ;;
  16 ;; lalr.scm is distributed in the hope that it will be useful,            ;;
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of         ;;
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          ;;
  19 ;; GNU General Public License for more details.                           ;;
  20 ;;                                                                        ;;
  21 ;; You should have received a copy of the GNU General Public License      ;;
  22 ;; along with lalr.scm; see the file COPYING.  If not, write to           ;;
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  ;;
  24 ;; ---------------------------------------------------------------------- ;;
  25
  26 ;; 1998/08/16: Tanaka Akira <akr@jaist.ac.jp> transplants from Scheme to Emacs-Lisp.
  27
  28 (provide 'lr-driver)
  29
  30 (defconst lr-max-stack-size 500)
  31
  32 (defsubst lr-push (stack sp new-cat goto-table lval)
  33   (let* ((state     (aref stack sp))
  34          (new-state (cdr (assq new-cat (aref goto-table state))))
  35          (new-sp    (+ sp 2)))
  36     (if (>= new-sp lr-max-stack-size)
  37         (error "PARSE ERROR : stack overflow")
  38         (progn
  39           (aset stack new-sp new-state)
  40           (aset stack (- new-sp 1) lval)
  41           new-sp))))
  42
  43 (defun lr-parse (lexerp errorp action-table goto-table reduction-table token-defs)
  44   (let ((stack (make-vector lr-max-stack-size 0)) (sp 0) (input (funcall lexerp)))
  45     (catch 'parser
  46       (while t
  47         (let* ((state (aref stack sp))
  48                (i     (car input))
  49                (act   (let* ((l (aref action-table state)) (y (assq i l))) (if y (cdr y) (cdar l)))))
  50
  51           (cond
  52
  53            ;; Input succesfully parsed
  54            ((eq act 'accept)
  55             (throw 'parser (aref stack 1)))
  56
  57            ;; Syntax error in input
  58            ((eq act '*error*)
  59             (throw 'parser
  60               (funcall errorp "PARSE ERROR : unexpected token : "
  61                        (cdr (assq i token-defs)))))
  62
  63            ;; Shift current token on top of the stack
  64            ((>= act 0)
  65             (aset stack (+ sp 1) (cdr input))
  66             (aset stack (+ sp 2) act)
  67             (setq sp (+ sp 2))
  68             (setq input (funcall lexerp)))
  69
  70            ;; Reduce by rule (- act)
  71            (t
  72             (setq sp (funcall (aref reduction-table (- act)) stack sp goto-table (cdr input))))))))))