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 ;;
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. ;;
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. ;;
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 ;; ---------------------------------------------------------------------- ;;
26 ;; 1998/08/16: Tanaka Akira <akr@jaist.ac.jp> transplants from Scheme to Emacs-Lisp.
30 (defconst lr-max-stack-size 500)
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))))
36 (if (>= new-sp lr-max-stack-size)
37 (error "PARSE ERROR : stack overflow")
39 (aset stack new-sp new-state)
40 (aset stack (- new-sp 1) lval)
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)))
47 (let* ((state (aref stack sp))
49 (act (let* ((l (aref action-table state)) (y (assq i l))) (if y (cdr y) (cdar l)))))
53 ;; Input succesfully parsed
55 (throw 'parser (aref stack 1)))
57 ;; Syntax error in input
60 (funcall errorp "PARSE ERROR : unexpected token : "
61 (cdr (assq i token-defs)))))
63 ;; Shift current token on top of the stack
65 (aset stack (+ sp 1) (cdr input))
66 (aset stack (+ sp 2) act)
68 (setq input (funcall lexerp)))
70 ;; Reduce by rule (- act)
72 (setq sp (funcall (aref reduction-table (- act)) stack sp goto-table (cdr input))))))))))