/usr/share/gauche-0.9/0.9.4/lib/util/toposort.scm is in gauche 0.9.4-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 57 58 59 60 | ;;;
;;; toposort.scm - topological sorting
;;;
;;; Written by Shiro Kawai (shiro@acm.org) 2001
;;; Public Domain.. I guess lots of Scheme programmers have already
;;; written similar code.
;;;
(define-module util.toposort
(use srfi-1)
(export topological-sort)
)
(select-module util.toposort)
;; (topological-sort nodes &optional =)
;;
;; nodes : a list of (<from> <to0> <to1> ...)
(define (topological-sort nodes :optional (eq eqv?))
(define table (map (^n (cons (car n) 0)) nodes))
(define queue '())
(define result '())
;; set up - compute number of nodes that each node depends on.
(define (set-up)
(for-each (lambda (node)
(for-each (lambda (to)
(cond ((assoc to table eq)
=> (^p (inc! (cdr p))))
(else
(push! table (cons to 1)))))
(cdr node)))
nodes))
;; traverse
(define (traverse)
(unless (null? queue)
(let ((n0 (assoc (pop! queue) nodes eq)))
(when n0
(for-each (lambda (to)
(cond ((assoc to table eq)
=> (lambda (p)
(let ((cnt (- (cdr p) 1)))
(when (= cnt 0)
(push! result to)
(push! queue to))
(set! (cdr p) cnt))))
))
(cdr n0)))
(traverse))))
(set-up)
(set! queue (append-map (^p (if (= (cdr p) 0) (list (car p)) '()))
table))
(set! result queue)
(traverse)
(let1 rest (filter (^e (not (zero? (cdr e)))) table)
(unless (null? rest)
(error "graph has circular dependency" (map car rest))))
(reverse result))
|