Greetings, Maxime.
;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Ludovic Courtès <l...@gnu.org> ;;; Copyright © 2022 Maxime Devos <maximede...@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
;; To be used by the implementation of workspaces.
;; Extracted from (guix import utils), and changed from (guix sets)
;; to a guile-pfds equivalent.
(define-module (topological-sort)
#:export (topological-sort)
#:use-module ((srfi srfi-69) #:select (hash))
#:use-module ((ice-9 match) #:select (match))
#:use-module (pfds hamts))
(define (topological-sort nodes
node-dependencies
node-name)
"Perform a breadth-first traversal of the graph rooted at NODES, a list of
nodes, and return the list of nodes sorted in topological order. Call
NODE-DEPENDENCIES to obtain the dependencies of a node, and NODE-NAME to
obtain a node's uniquely identifying \"key\"."
;; It is important to do a breadth-first traversal instead of a depth-first
;; traversal -- a simpler depth-first traversal has caused failures in the
;; past.
(let loop ((unexpanded-nodes nodes)
(result '()) ; in reverse topological order
;; Identical to 'result', except for using a different data
;; structure.
(visited (make-hamt hash equal?)))
(if (null? unexpanded-nodes)
(reverse result) ; done!
(let inner-loop ((current-unexpanded-nodes unexpanded-nodes)
(later-unexpanded-nodes '())
(result result)
(visited visited))
(match current-unexpanded-nodes
((first . current-unexpanded-nodes)
(if (hamt-ref visited (node-name first) #false)
;; Already visisted, nothing to do!
(inner-loop current-unexpanded-nodes
later-unexpanded-nodes result visited)
;; Expand 'first', putting dependencies in
;; 'later-unexpanded-nodes'.
(inner-loop current-unexpanded-nodes
(append (node-dependencies first)
later-unexpanded-nodes)
(cons first result)
(hamt-set visited (node-name first) #true))))
(() ;; All nodes on the current level are expanded, descend!
(loop later-unexpanded-nodes result visited)))))))
OpenPGP_0x49E3EE22191725EE.asc
Description: OpenPGP public key
OpenPGP_signature
Description: OpenPGP digital signature
