aboutsummaryrefslogtreecommitdiff
path: root/module/util/graph.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/util/graph.scm')
-rw-r--r--module/util/graph.scm93
1 files changed, 0 insertions, 93 deletions
diff --git a/module/util/graph.scm b/module/util/graph.scm
deleted file mode 100644
index 999da743..00000000
--- a/module/util/graph.scm
+++ /dev/null
@@ -1,93 +0,0 @@
-;;; Commentary:
-;; An immutable directed graph.
-;; Most operations are O(n), since there is no total
-;; order on symbols in scheme.
-;;; Code:
-
-(define-module (util graph)
- :use-module (util)
- :use-module (srfi srfi-1)
- :use-module (srfi srfi-9 gnu))
-
-;; Immutable directed graph
-(define-immutable-record-type <graph>
- (make-graph% nodes edges node-key-proc node-equal?)
- graph?
- (nodes graph-nodes)
- (edges graph-edges) ; (list (symb . symb))
- (node-key-proc node-key-proc) ; node → symb
- (node-equal? node-equal?) ; node, node -> symb
- )
-
-(define*-public (make-graph optional:
- (node-key-proc identity)
- (node-equal? eq?))
- (make-graph% '() '() node-key-proc node-equal?))
-
-(define*-public (rebuild-graph optional: old-graph
- (nodes '()) (edges '()))
- (make-graph% nodes edges
- (if old-graph (node-key-proc old-graph) identity)
- (if old-graph (node-equal? old-graph) eq?)))
-
-(define-public (graph-empty? graph)
- (null? (graph-nodes graph)))
-
-;; Add node to graph. Adds directed edges from node to neighbours
-;; graph, node, (list node-key) → graph
-(define-public (add-node graph node edge-neighbours)
- (rebuild-graph
- graph
- (lset-adjoin (node-equal? graph) (graph-nodes graph)
- node)
- (lset-union equal? (graph-edges graph)
- (map (lambda (o) (cons ((node-key-proc graph) node) o))
- edge-neighbours))))
-
-;; get node by key
-(define-public (get-node graph key)
- (find (lambda (node) (eq? key ((node-key-proc graph) node)))
- (graph-nodes graph)))
-
-;; Remove node by @var{node-equal?}
-(define-public (remove-node graph node)
- (rebuild-graph
- graph
- (remove (lambda (other) ((node-equal? graph) node other))
- (graph-nodes graph))
- (let ((key ((node-key-proc graph) node)))
- (remove (lambda (edge) (or (eq? key (car edge))
- (eq? key (cdr edge))))
- (graph-edges graph)))))
-
-;; NOTE this is O(n^2) (maybe, sort of?)
-;; Getting it faster would require building an index, which
-;; is hard since there isn't a total order on symbols.
-(define-public (find-node-without-dependencies graph)
- (find (lambda (node)
- (let ((key ((node-key-proc graph) node)))
- (not (find (lambda (edge) (eq? key (car edge))) (graph-edges graph)))))
- (graph-nodes graph)))
-
-;; graph → node x graph
-(define-public (find-and-remove-node-without-dependencies graph)
- (let ((node (find-node-without-dependencies graph)))
- (unless node
- (throw 'graph-error 'find-and-remove-node-without-dependencies
- "No node without dependencies in graph" '() graph))
- (values node (remove-node graph node))))
-
-;; Assumes that the edges of the graph are dependencies.
-;; Returns a list of all nodes so that each node is before its dependants.
-;; A missing dependency (and probably a loop) is an error, and currently
-;; leads to some weird error messages.
-(define-public (resolve-dependency-graph graph)
- (catch 'graph-error
- (lambda ()
- (let loop ((graph graph))
- (if (graph-empty? graph)
- '()
- (let* ((node graph* (find-and-remove-node-without-dependencies graph)))
- (cons node (loop graph*))))))
- (lambda (err caller fmt args graph . data)
- graph)))