bug#58198: topological-sort does not sort topologically in case of diamonds

[Maxime Devos <maximedevos@telenet.be>]

[-- Attachment #1.1.1: Type: text/plain, Size: 2511 bytes --]

Consider the following DAG (arrows are implicitly downwards):

top -> left, right
left,right -> bottom.

Or in ASCII art:

      top
     /    \
left      right
     \    /
      bottom

Currently, they are sorted incorrectly with topological-sort -- the 
exact resulting order depends on the order in which the dependencies are 
passed to 'topological-sort' (from (guix import utils)), but you can get 
the following:

right bottom left top

'bottom' and 'right' need to be switched.

(Background)
I would like to use a copy of 'topological-sort' for determining the 
order in which 'workspace' members need to be built in antioxidant, but 
currently it produces bogus results (at least for 'greetd').

Theoretically, it would also impact recursive imports (unverified) 
(topological-sort is used to emit them in topological order).

Code to reproduce the bug:

(use-modules (guix sets) (ice-9 match) (srfi srfi-1))

(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\"."
   (let loop ((nodes nodes)
              (result '())
              (visited (set)))
     (match nodes
       (()
        result)
       ((head . tail)
        (if (set-contains? visited (node-name head))
            (loop tail result visited)
            (let ((dependencies (node-dependencies head)))
              (loop (append dependencies tail)
                    (cons head result)
                    (set-insert (node-name head) visited))))))))

(define %dependencies
   '((top left right)
     (left bottom)
     (right bottom)
     (bottom)))
(define root-nodes '(top))
(define (node-dependencies node)
   (assoc-ref %dependencies node))
(define node-name identity)
(define sorted (topological-sort root-nodes node-dependencies node-name))
(write sorted)

;; Verify the dependencies have smaller indices
(define (node-index node)
   (list-index (lambda (x) (equal? node x)) sorted))
(define (check node)
   (unless (<= (apply max 0 (map node-index (node-dependencies node)))
	      (node-index node))
     (pk node)
     (error "incorrectly sorted!")))
(for-each check (map car %dependencies))


Greetings,
Maxime.

[-- Attachment #1.1.2: OpenPGP public key --]
[-- Type: application/pgp-keys, Size: 929 bytes --]

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 236 bytes --]