1 ;;; recdesc.el --- Generator for recursive-descent parsers
3 ;; Copyright (C) 2000,2007 Stefan Bund
5 ;; recdesc.el is free software; you can redistribute it and/or
6 ;; modify it under the terms of the GNU General Public License as
7 ;; published by the Free Software Foundation; either version 2, or (at
8 ;; your option) any later version.
10 ;; recdesc.el is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; General Public License for more details.
17 ;; Der Syntax einer term deklaration ist:
19 ;; <term-declaration> := (term <symbol> <arglist> <command>...)
21 ;; <command> := <directive>
22 ;; | (collect <directive-or-form>)
25 ;; <directive-or-form> := <directive> | <form>
27 ;; <diretive> := (match <term> [<form>...])
28 ;; | (or <command>...)
29 ;; | (and <command>...)
30 ;; | (maybe <command>...)
31 ;; | (repeat <command>...)
34 ;; | (progn <lisp-code>...)
36 ;; <term> := <symbol> | <form>
43 ;; $Log: recdesc.el,v $
44 ;; Revision 1.3 2000/02/13 21:19:56 bund
45 ;; Erste vollständige version von SqIV2
47 ;; Revision 1.2 2000/02/03 10:15:19 bund
48 ;; *** empty log message ***
50 ;; Revision 1.1 2000/02/01 13:26:03 bund
51 ;; *** empty log message ***
61 (declaim (special position))
62 (declaim (special string))
63 (declaim (special commit-flag))
64 (declaim (special saved-position))
65 (declaim (special saved-elements))
66 (declaim (special elements))
67 (declaim (special return-form))
69 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
71 ;; Zunächst der Parser/Scanner zur deklaration von Termen
73 (defmacro recdesc-deferror (name message &rest classes)
75 (put ',name 'error-conditions '(error sqi-error ,@classes ,name))
76 (put ',name 'error-message ,message)))
78 (defmacro recdesc-declare (&rest forms)
80 (loop for form in forms
81 collect (if (and (consp form)
87 (recdesc-declare-term (cadr form)
90 (signal 'recdesc-invalid-decl-component
93 (recdesc-deferror recdesc-invalid-decl-component
94 "Invalid component in recdesc-declare" recdesc-error)
96 (defun recdesc-declare-term (name arglist body)
98 `(defun ,(intern (concat "recdesc@@" (symbol-name name))) ,arglist
100 (or (and ,(recdesc-parse-directive/and body)
103 '(or elements t))))))))
105 (defun recdesc-parse-command (command)
106 (if (not (consp command))
107 (signal 'recdesc-invalid-command
109 (cond ((eq (car command) 'return)
110 (if (not (consp (cdr command)))
111 (signal 'recdesc-invalid-command
113 (setq return-form (cadr command))
115 ((eq (car command) 'collect)
116 (if (not (consp (cdr command)))
117 (signal 'recdesc-invalid-command (list command)))
118 `(recdesc-collect ,(recdesc-parse-directive-or-form (cadr command))))
119 (t (recdesc-parse-directive command))))
121 (recdesc-deferror recdesc-invalid-command
122 "Invalid scanner command" recdesc-error)
124 (defun recdesc-parse-directive-or-form (directive-or-form)
125 (or (recdesc-parse-directive directive-or-form t)
128 (defun recdesc-parse-directive (directive &optional nosignal)
129 (if (not (consp directive))
131 (signal 'recdesc-invalid-directive
133 (cond ((eq (car directive) 'match) (recdesc-parse-directive/match (cdr directive)))
134 ((eq (car directive) 'or) (recdesc-parse-directive/or (cdr directive)))
135 ((eq (car directive) 'and) (recdesc-parse-directive/and (cdr directive)))
136 ((eq (car directive) 'maybe) (recdesc-parse-directive/maybe (cdr directive)))
137 ((eq (car directive) 'repeat) (recdesc-parse-directive/repeat (cdr directive)))
138 ((eq (car directive) 'commit) (recdesc-parse-directive/commit (cdr directive)))
139 ((eq (car directive) 'fail) (recdesc-parse-directive/fail (cdr directive)))
140 ((eq (car directive) 'progn) (recdesc-parse-directive/progn (cdr directive)))
141 (t (if (not nosignal)
142 (signal 'recdesc-invalid-directive
143 (list directive)))))))
145 (recdesc-deferror recdesc-invalid-directive
146 "Invalid scanner directive" recdesc-error)
148 (defun recdesc-parse-directive/match (args)
149 (if (not (consp args))
150 (signal 'recdesc-invalid-match-arguments
152 (if (symbolp (car args))
153 (cons (intern (concat "recdesc@@" (symbol-name (car args))))
155 (if (not (null (cdr args)))
156 (signal 'recdesc-invalid-match-arguments
158 (list 'recdesc-match-regexp (car args))))
160 (recdesc-deferror recdesc-invalid-match-arguments
161 "Invalid arguments to match directive" recdesc-error)
163 (defun recdesc-parse-directive/or (args)
164 (if (not (consp args))
165 (signal 'recdesc-invalid-or-arguments
168 (loop for command in args
169 collect (recdesc-parse-directive/and (list command)))))
171 (recdesc-deferror recdesc-invalid-or-arguments
172 "Invalid arguments to or directive" recdesc-error)
174 (defun recdesc-parse-directive/and (args)
175 (if (not (consp args))
176 (signal 'recdesc-invalid-and-arguments
178 `(let ((saved-position position)
179 (saved-elements elements)
181 (or (and ,@(loop for command in args
182 collect (recdesc-parse-command command)))
183 (recdesc-backtrack))))
185 (recdesc-deferror recdesc-invalid-and-arguments
186 "Invalid arguments to and directive" recdesc-error)
188 (defun recdesc-parse-directive/maybe (args)
189 (if (not (consp args))
190 (signal 'recdesc-invalid-maybe-arguments
192 `(or ,(recdesc-parse-directive/and args) t))
194 (defun recdesc-parse-directive/repeat (args)
195 `(loop for repeat-item = ,(recdesc-parse-directive/and args)
197 collect repeat-item))
199 (defun recdesc-parse-directive/commit (args)
201 (signal 'recdesc-invalid-commit-arguments
203 `(setq commit-flag t))
205 (recdesc-deferror recdesc-invalid-commit-arguments
206 "Invalid arguments to commit directive" recdesc-error)
208 (defun recdesc-parse-directive/fail (args)
210 (signal 'recdesc-invalid-fail-arguments
212 '(throw 'recdesc-failed nil))
214 (recdesc-deferror recdesc-invalid-fail-arguments
215 "Invalid arguments to fail directive" recdesc-error)
217 (defun recdesc-parse-directive/progn (args)
220 (put 'term 'lisp-indent-function 'defun)
222 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
224 ;; Die folgenden Funktionen werden von den durch recdesc-declare
225 ;; erzeugten termen benötigt
227 (defun recdesc-backtrack ()
230 (throw 'recdesc-failed nil))
231 (setq position saved-position
232 elements saved-elements)
235 (defun recdesc-collect (value)
238 (setq elements (nconc elements
242 (defun recdesc-match-regexp (regexp)
243 (if (string-match (concat "^" regexp) (substring string position))
244 (let ((start position))
245 (setq position (+ position (match-end 0)))
246 (substring string start position))))
248 (defun recdesc-match (term &rest args)
249 (apply (intern (concat "recdesc@@" (symbol-name term))) args))
251 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
253 ;; Toplevel calls to generated scanners
255 (defun recdesc-scan-string (term string &rest args)
256 (let ((scanner (intern (concat "recdesc@@"
257 (symbol-name term))))
260 (setq rv (catch 'recdesc-failed
261 (apply scanner args)))
262 (if (not (string-match "^[ \t\n\r]*$" (substring string position)))
270 ;;; elisp-project-autoload-file-name: "sqi-autoload.el"