blob: 829740423d62b1117627d23f0bac0c59a27b06ae (
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
|
(define-module (scripts peg-to-graph)
:use-module ((graphviz) :prefix #{gv:}#)
:use-module ((hnh module-introspection)
:select (unique-symbols get-forms))
:use-module (srfi srfi-1)
:use-module (ice-9 match)
:use-module (hnh util options)
:use-module (ice-9 getopt-long)
:export (main))
(define option-spec
`((engine (value #t)
(description "Graphviz rendering engine to use. Defaults to DOT"))
(output (single-char #\o)
(value #t)
(description "Name of output pdf"))))
(define %summary "Output peg-pattern relations as a graphviz graph.")
(define %synopsis "peg-to-graph [options] <filename>")
(define %help (format-arg-help option-spec))
(define peg-primitives
'(and or * + ? followed-by not-followed-by peg-any range
ignore capture peg))
(define (handle-peg-form! graph form)
(match form
(`(define-peg-pattern ,name ,capture ,body)
(let ((node (gv:node graph (format #f "~a" name))))
(gv:setv node "style"
(case capture
((all) "solid")
((body) "dashed")
((none) "dotted"))))
(for-each (lambda (symbol)
(gv:edge graph
(format #f "~a" name)
(format #f "~a" symbol)))
(remove (lambda (x) (memv x peg-primitives))
(unique-symbols (list body)))))))
(define (main . args)
(define options (getopt-long (cons "peg-to-graph" args)
(getopt-opt option-spec)))
(define engine (option-ref options 'engine "dot"))
(define output-file (option-ref options 'output "lex2.pdf"))
(define input-file (let ((filenames (option-ref options '() '())))
(when (null? filenames)
(format #t "Usage: ~a~%" %summary)
(exit 1))
(car filenames)))
(let ((graph (gv:digraph "G")))
(for-each (lambda (form) handle-peg-form! graph form)
(filter (lambda (x)
(and (list? x)
(not (null? x))
(eq? 'define-peg-pattern (car x))))
(call-with-input-file input-file get-forms)))
(gv:layout graph engine)
(gv:render graph "pdf" output-file)))
|