blob: 49b0d34b6b0b8b5e336f58480b482744a58f719b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
;;;; docgen.lisp -- generate a docstring from a grammar
(in-package #:argot)
(defun write-rule-doc (lhs pattern)
(format *standard-output* "~15s ::= " lhs)
(write-pattern-doc pattern))
(defun write-sequence-doc (args )
(loop :for (a . more) :on args
:do (write-pattern-doc a )
(when more
(princ " " ))))
(defun write-optional-doc (arg)
(princ "[")
(write-pattern-doc arg)
(princ "]"))
(defun write-kleene-doc (arg)
(write-pattern-doc arg)
(princ "*"))
(defun write-one-or-more-doc (arg)
(write-pattern-doc arg)
(princ "+"))
(defun write-alternatives-doc (args)
(princ "(")
(loop :for (a . more) :on args
:do (write-pattern-doc a)
(when more
(princ " | ")))
(princ ")"))
(defun write-grammar-pattern-doc (grammar-name)
(princ "{") (princ grammar-name) (princ "}"))
(defun write-pattern-doc (pattern)
(cond ((nonterminal? pattern)
(princ pattern))
((atom pattern)
(princ "'") (princ pattern) (princ "'"))
(t
(destructuring-bind (op . args) pattern
(case op
((:seq :seq=) (write-sequence-doc args ))
((:? :?=) (write-optional-doc (first args)))
((:* :*=) (write-kleene-doc (first args)))
((:+ :+=) (write-one-or-more-doc (first args)))
((:or :or=) (write-alternatives-doc args))
(:= (princ (first args)))
(:@ (write-pattern-doc (second args)))
(:{} (write-grammar-pattern-doc (first args)))
(:item (princ "::TOKEN::"))
(:eof (princ "::EOF::")))))))
|
