blob: 4475576e83fbcaff2dd8d14dc19df5552a13aaaa (
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
62
63
64
65
66
67
68
69
70
71
|
;;;; docgen.lisp -- generate a docstring from a grammar
(in-package #:argot)
(defun rule-name-string (rulename)
(let ((str (symbol-name rulename)))
(nstring-downcase (subseq str 1 (1- (length str))))))
(defun write-rule-doc (lhs pattern)
(format *standard-output* "~15a ::= " (rule-name-string 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-literal (object)
(format *standard-output* "'~a'" (write-to-string object)))
(defun write-pattern-doc (pattern)
(cond ((nonterminal? pattern)
(format *standard-output* "~a" (rule-name-string pattern)))
((atom pattern)
(write-literal pattern))
(t
(destructuring-bind (op . args) pattern
(case op
(:seq (write-sequence-doc args))
(:seq= (write-sequence-doc args ))
(:? (write-optional-doc (first args)))
(:?= (write-optional-doc (first args) ))
(:* (write-kleene-doc (first args)))
(:*= (write-kleene-doc (first args) ))
(:+ (write-one-or-more-doc (first args)))
(:+= (write-one-or-more-doc (first args) ))
(:or (write-alternatives-doc args))
(:or= (write-alternatives-doc args ))
(:= (write-literal (first args)))
(:@ (write-pattern-doc (second args)))
(:{} (write-grammar-pattern-doc (first args)))
(:item (princ "token"))
(:eof (princ "eof")))))))
|
