Commit fe9f9ff2ecb7d9e19f073d5b8db4a50818c9f4c6

  • avatar
  • Plato Wu <standin-000 @tia…ya.cn>
  • Sun Dec 06 03:45:00 CET 2009
implement define-ebnf-parser
add a simple EBNF example
src/ebnf-example.lisp
(52 / 0)
  
1(defpackage #:yacc-ebnf-example
2 (:export #:ebnf-example)
3 (:use #:cl #:yacc #:yacc-ebnf))
4
5(in-package #:yacc-ebnf-example)
6
7;;; The lexer
8
9(define-condition lexer-error (yacc-runtime-error)
10 ((character :initarg :character :reader lexer-error-character))
11 (:report (lambda (e stream)
12 (format stream "Lexing failed~@[: unexpected character ~S~]"
13 (lexer-error-character e)))))
14
15(defun lexer-error (char)
16 (error (make-condition 'lexer-error :character char)))
17
18(defun lexer (&optional (stream *standard-input*))
19 (loop
20 (let ((c (read-char stream nil nil)))
21 (cond
22 ((member c '(nil #\Newline)) (return-from lexer (values nil nil)))
23 ((member c '(#\- #\.))
24 (let ((symbol (intern (string c) '#.*package*)))
25 (return-from lexer (values symbol symbol))))
26 ((digit-char-p c)
27 (return-from lexer (values 'digit c)))
28 (t
29 (lexer-error c))))))
30
31;;; The parser
32
33(define-ebnf-parser *expression-ebnf-parser*
34 (:start-symbol S)
35 (:terminals (|.| - digit))
36 (:precedence nil)
37 (S ((:option -) (:plus D) (:option |.| (:plus D))) ())
38 (D digit))
39
40;;; The toplevel loop
41
42(defun ebnf-example ()
43 (format t "A EBNF example:
44 S := '-'? D+ ('.' D+)?
45 D := '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9'~%")
46 (loop
47 (with-simple-restart (abort "Return to ebnf-example toplevel.")
48 (format t "? ")
49 (let ((e (parse-with-lexer #'lexer *expression-ebnf-parser*)))
50 (when (null e)
51 (return-from ebnf-example))
52 (format t " => ~A~%" (print e))))))
src/package.lisp
(1 / 0)
  
2323;;; THE SOFTWARE.
2424
2525(defpackage #:yacc-ebnf
26 (:export #:define-ebnf-parser)
2627 (:use #:cl #:yacc #:alexandria))
src/yacc-ebnf.lisp
(91 / 3)
  
2626
2727(defstruct ebnf-prod symbol derives)
2828
29
30;; (defun make-repeat (symbol derives)
31;; (append
32;; (expand-ebnf symbol derives :operation :option)
33;; (list (make-ebnf-prod :symbol symbol :derives (list symbol)))))
34
2935(defun make-repeat (symbol derives)
30 (append
31 (expand-ebnf symbol derives :operation :option)
32 (list (make-ebnf-prod :symbol symbol :derives (list symbol)))))
36 (append (list (make-ebnf-prod :symbol symbol :derives '()))
37 (list (make-ebnf-prod :symbol symbol :derives (append derives (list symbol))))))
3338
39
3440(defun make-option (symbol derives)
3541 (append
3642 (expand-ebnf symbol derives)
3743 (list (make-ebnf-prod :symbol symbol :derives '()))))
3844
45(defun make-plus (symbol derives)
46 (append
47 (expand-ebnf symbol derives)
48 (list (make-ebnf-prod :symbol symbol :derives (append derives (list symbol))))))
49
50
3951(defun expand-ebnf (symbol derives &key (operation '()))
4052 (let ((add-prods '()))
4153 (append
……
5656 (make-repeat symbol derives))
5757 (:option
5858 (make-option symbol derives))
59 (:plus
60 (make-plus symbol derives))
5961 (otherwise
6062 (list
6163 (make-ebnf-prod
……
8181 :action action
8282 :action-form action-form))
8383 (expand-ebnf symbol derives)))
84
85(defun make-ebnf-grammar(&key name (start-symbol (required-argument))
86 terminals precedence productions)
87 (declare (symbol name start-symbol) (list terminals productions))
88 (setq productions
89 ;; Plato Wu,2009/12/05: yacc package need its own s-prime
90 (append (make-ebnf-production 'yacc::s-prime (list start-symbol)
91 :action #'identity :action-form '#'identity)
92 productions))
93 (do* ((i 0 (+ i 1)) (ps productions (cdr ps)) (p (car ps) (car ps)))
94 ((null ps))
95 (setf (yacc::production-id p) i))
96 (yacc::%make-grammar :name name :terminals terminals :precedence precedence
97 :productions productions))
98
99(defun parse-ebnf-production (form)
100 (let ((symbol (car form))
101 (productions '()))
102 (dolist (stuff (cdr form))
103 (cond
104 ((and (symbolp stuff) (not (null stuff)))
105
106 (appendf productions (make-ebnf-production symbol (list stuff)
107 :action #'identity :action-form '#'identity)
108 ))
109 ((listp stuff)
110 (let ((l (car (last stuff))))
111 ;; Plato Wu,2009/12/05: function in other package is list
112 (let ((rhs (if (or (symbolp l) (not (eq (car l) 'function))) stuff (butlast stuff)))
113 (action (if (or (symbolp l) (not (eq (car l) 'function))) '#'list l)))
114 (appendf productions (make-ebnf-production symbol rhs
115 :action (eval action)
116 :action-form action)))))
117 (t (error "Unexpected production ~S" stuff))))
118 productions))
119
120(defun parse-ebnf-grammar (forms)
121 (let ((options '()) (make-options '()) (productions '()))
122 (dolist (form forms)
123 (cond
124 ((member (car form)
125 '(:muffle-conflicts
126 :print-derives-epsilon :print-first-terminals
127 :print-states :print-goto-graph :print-lookaheads))
128 (unless (null (cddr form))
129 (error "Malformed option ~S" form))
130 (push (car form) make-options)
131 (push (cadr form) make-options))
132 ((keywordp (car form))
133 (unless (null (cddr form))
134 (error "Malformed option ~S" form))
135 (push (car form) options)
136 (push (cadr form) options))
137 ((symbolp (car form))
138 (setq productions (nconc (parse-ebnf-production form) productions)))
139 (t
140 (error "Unexpected grammar production ~S" form))))
141 (values (nreverse options) (nreverse make-options)
142 (nreverse productions))))
143
144(defmacro define-ebnf-parser (name &body body)
145 "DEFINE-GRAMMAR NAME OPTION... PRODUCTION...
146PRODUCTION ::= (SYMBOL RHS...)
147RHS ::= SYMBOL | (SYMBOL... [ACTION])
148Defines the special variable NAME to be a parser. Options are as in
149MAKE-GRAMMAR and MAKE-PARSER."
150 (multiple-value-bind (options make-options productions) (parse-ebnf-grammar body)
151 `(defparameter ,name
152 ',(apply #'make-parser
153 (apply #'make-ebnf-grammar
154 :name name
155 :productions productions
156 options)
157 make-options))))