;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Maxime Devos <maximedevos@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)))))))