1 files changed, 49 insertions, 0 deletions
diff --git a/module/scripts/peg-to-graph.scm b/module/scripts/peg-to-graph.scm
new file mode 100755
index 00000000..0472fd02
--- /dev/null
+++ b/module/scripts/peg-to-graph.scm
@@ -0,0 +1,49 @@
+(define-module (scripts peg-to-graph)
+  :use-module ((graphviz) :prefix #{gv:}#)
+  :use-module ((hnh module-introspection) :select (unique-symbols))
+  :use-module ((hnh module-introspection static-util) :select (get-forms))
+  :use-module (srfi srfi-1)
+  :use-module (ice-9 match)
+  :export (main))
+
+(define %summary "Output peg-pattern relations as a graphviz graph.")
+(define %include-in-list #t)
+
+(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)
+  (when (< 1 (length args))
+    (format #t "Usage: guild peg-to-graph <filename>~%")
+    (exit 1))
+
+  (let ((graph (gv:digraph "G")))
+    (let ((input-file (car args)))
+      (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 "dot")
+    (gv:render graph "pdf" "lex2.pdf")
+
+    (display "done\n")))