aboutsummaryrefslogtreecommitdiff
path: root/scripts/peg-to-graph.scm
blob: 7edcd556235e83be47f887424bf7bbbc613ba13d (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
#!/usr/bin/env bash
GUILE=${GUILE:-guile}
set -x
exec $GUILE -e main -s "$0" "$@"
!#

(add-to-load-path (dirname (current-filename)))
(add-to-load-path (string-append (dirname (current-filename)) "/use2dot"))


(use-modules ((graphviz) :prefix #{gv:}#)
             ((module-introspection) :select (get-forms unique-symbols))
             (srfi srfi-1)
             (ice-9 match))

(define peg-primitives
  '(and or * + ? followed-by not-followed-by peg-any range
        ignore capture peg))

(define graph (gv:digraph "G"))

(define (handle-peg-form 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)
  (when (< 2 (length args))
    (format #t "Usage: ~a <filename>~%" (car args))
    (exit 1))

  (let ((input-file (cadr args)))
    (for-each handle-peg-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 "dot")
  (gv:render graph "pdf" "lex2.pdf")

  (display "done\n"))