diff options
Diffstat (limited to 'module/hnh/util/graph.scm')
| -rw-r--r-- | module/hnh/util/graph.scm | 35 |
1 files changed, 22 insertions, 13 deletions
diff --git a/module/hnh/util/graph.scm b/module/hnh/util/graph.scm index 01e9a63a..9aff7c77 100644 --- a/module/hnh/util/graph.scm +++ b/module/hnh/util/graph.scm @@ -8,7 +8,16 @@ :use-module (hnh util) :use-module (srfi srfi-1) :use-module (srfi srfi-71) - :use-module (srfi srfi-9 gnu)) + :use-module (srfi srfi-9 gnu) + :export (make-graph + rebuild-graph + graph-empty? + add-node + get-node + remove-node + find-node-without-dependencies + find-and-remove-node-without-dependencies + resolve-dependency-graph)) ;; Immutable directed graph (define-immutable-record-type <graph> @@ -20,23 +29,23 @@ (node-equal? node-equal?) ; node, node -> symb ) -(define*-public (make-graph optional: - (node-key-proc identity) - (node-equal? eq?)) +(define* (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 '())) +(define* (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) +(define (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) +(define (add-node graph node edge-neighbours) (rebuild-graph graph (lset-adjoin (node-equal? graph) (graph-nodes graph) @@ -46,12 +55,12 @@ edge-neighbours)))) ;; get node by key -(define-public (get-node graph key) +(define (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) +(define (remove-node graph node) (rebuild-graph graph (remove (lambda (other) ((node-equal? graph) node other)) @@ -64,14 +73,14 @@ ;; 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) +(define (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) +(define (find-and-remove-node-without-dependencies graph) (let ((node (find-node-without-dependencies graph))) (unless node (scm-error 'graph-error "find-and-remove-node-without-dependencies" @@ -83,7 +92,7 @@ ;; 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) +(define (resolve-dependency-graph graph) (catch 'graph-error (lambda () (let loop ((graph graph)) |