improvements to graphing support

(cherry picked from 9dd7454e8ea0bfe855b838dee0fcaf4348b475cc commit)

diff --git a/lily/main.cc b/lily/main.cc
index 728cd89508570f2fff306e3dd3a9ddc679c9c5bb..68fc2a03cb4a4381f4f14f019d88d4e6241194b6 100644 (file)
--- a/lily/main.cc
+++ b/lily/main.cc
@@ -649,3 +649,25 @@ main (int argc, char **argv)
   /* Only reachable if GUILE exits.  That is an error.  */
   return 1;
 }
+
+SCM atexit_list = SCM_EOL;
+
+LY_DEFINE (ly_atexit, "ly:atexit",
+          2, 0, 0, (SCM proc, SCM args),
+          "Just before exiting, call the procedure given. "
+"If this is called multiple times, the procedures are called "
+"in LIFO order.")
+{
+  atexit_list = scm_cons (scm_cons (proc, args), atexit_list);
+  scm_gc_protect_object (atexit_list);
+  return SCM_UNSPECIFIED;
+}
+
+LY_DEFINE (ly_do_atexit, "ly:do-atexit",
+          0, 0, 0, (),
+          "Call the atexit procedures.")
+{
+  for (SCM s = atexit_list; scm_is_pair (s); s = scm_cdr (s))
+    scm_apply_0 (scm_caar (s), scm_cdar (s));
+  return SCM_UNSPECIFIED;
+}

diff --git a/scm/graphviz.scm b/scm/graphviz.scm
new file mode 100644 (file)
index 0000000..d3a858f
--- /dev/null
+++ b/scm/graphviz.scm
@@ -0,0 +1,35 @@
+(define-module (scm graphviz)
+  #:use-module (lily)
+  #:export (make-graph add-node add-edge))
+
+(define (make-graph filename)
+  (let ((empty-graph (list->vector (list filename '() '() '()))))
+    (ly:atexit write-graph (list empty-graph))
+    empty-graph))
+
+(define (filename g) (vector-ref g 0))
+(define (nodes g) (vector-ref g 1))
+(define (edges g) (vector-ref g 2))
+(define (clusters g) (vector-ref g 3))
+
+(define (add-node graph label)
+  (let ((ns (nodes graph)))
+    (vector-set! graph 1 (cons `(,(length ns) . ,label) ns))
+    (length ns)))
+
+(define (add-edge graph node1 node2)
+  (vector-set! graph 2 (cons `(,node1 . ,node2) (edges graph))))
+
+(define (write-graph graph)
+  (let ((out (open-file (filename graph) "w"))
+       (ns (nodes graph))
+       (es (edges graph))
+       (cc (clusters graph)))
+    (ly:message (format "writing graph ~s..." (filename graph)))
+    (display "digraph G {\nrankdir=\"LR\"\nnode [shape=rectangle]\n" out)
+    (map (lambda (n) (display (format "~a [label=\"~a\"]\n" (car n) (cdr n)) out))
+        ns)
+    (map (lambda (e) (display (format "~a -> ~a\n" (car e) (cdr e)) out))
+        es)
+    (display "}" out)))
+  
\ No newline at end of file

diff --git a/scm/lily.scm b/scm/lily.scm
index e71d400859488587b8d86f440064b6237ac3357b..a016901bcb4754c54c8eb99b7afeb011efbece35 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -525,6 +525,7 @@ The syntax is the same as `define*-public'."
          (ly:error (_ "failed files: ~S") (string-join failed))
          (exit 1))
        (begin
+         (ly:do-atexit)
          ;; HACK: be sure to exit with single newline
          (ly:message "")
          (exit 0)))))