Changeset 15527 in project for chicken/trunk/support.scm


Ignore:
Timestamp:
08/21/09 12:08:40 (12 years ago)
Author:
felix winkelmann
Message:

added topological-sort to data-structures unit; chicken-install sorts dependencies before installing them

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/support.scm

    r15246 r15527  
    11271127
    11281128
    1129 ;;; Simple topological sort:
    1130 ;
    1131 ; - Taken from SLIB (slightly adapted): Copyright (C) 1995 Mikael Djurfeldt
    1132 
    1133 (define (topological-sort dag pred)
    1134   (if (null? dag)
    1135       '()
    1136       (let* ((adj-table '())
    1137              (sorted '()))
    1138 
    1139         (define (insert x y)
    1140           (let loop ([at adj-table])
    1141             (cond [(null? at) (set! adj-table (cons (cons x y) adj-table))]
    1142                   [(pred x (caar at)) (set-cdr! (car at) y)]
    1143                   [else (loop (cdr at))] ) ) )
    1144        
    1145         (define (lookup x)
    1146           (let loop ([at adj-table])
    1147             (cond [(null? at) #f]
    1148                   [(pred x (caar at)) (cdar at)]
    1149                   [else (loop (cdr at))] ) ) )
    1150        
    1151         (define (visit u adj-list)
    1152           ;; Color vertex u
    1153           (insert u 'colored)
    1154           ;; Visit uncolored vertices which u connects to
    1155           (for-each (lambda (v)
    1156                       (let ((val (lookup v)))
    1157                         (if (not (eq? val 'colored))
    1158                             (visit v (or val '())))))
    1159                     adj-list)
    1160           ;; Since all vertices downstream u are visited
    1161           ;; by now, we can safely put u on the output list
    1162           (set! sorted (cons u sorted)) )
    1163        
    1164         ;; Hash adjacency lists
    1165         (for-each (lambda (def) (insert (car def) (cdr def)))
    1166                   (cdr dag))
    1167         ;; Visit vertices
    1168         (visit (caar dag) (cdar dag))
    1169         (for-each (lambda (def)
    1170                     (let ((val (lookup (car def))))
    1171                       (if (not (eq? val 'colored))
    1172                           (visit (car def) (cdr def)))))
    1173                   (cdr dag))
    1174         sorted) ) )
    1175 
    1176 
    11771129;;; Some pathname operations:
    11781130
Note: See TracChangeset for help on using the changeset viewer.