Update srfi.234 to the latest reference impl

lib/srfi/234.scm

@@ -1,28 +1,41 @@
+;;; SPDX-FileCopyrightText: 2024 Shiro Kawai, John Cowan, Arne Babenhauserheide
+;;; SPDX-License-Identifier: MIT
+
 ;;; Code adapted from gauche https://github.com/shirok/Gauche/blob/master/lib/util/toposort.scm :
 ;;;
 ;;; srfi-234.scm - topological sorting
 ;;;
 ;;;  Written by Shiro Kawai ([email protected])  2001
-;;;  Public Domain..  I guess lots of Scheme programmers have already
-;;;  written similar code.
-;;;
+;;;             Arne Babenhauserheide        2023--2024
+;;;  Public Domain.
 
 (define-module srfi.234
-  (export topological-sort
-          edgelist->graph
-          edgelist/inverted->graph
-          graph->edgelist
-          graph->edgelist/inverted
-          connected-components))
+  (export topological-sort topological-sort/details
+          edgelist->graph edgelist/inverted->graph
+          graph->edgelist graph->edgelist/inverted
+          connected-components)
+  )
 (select-module srfi.234)
 
+
 (define topological-sort
   (case-lambda
     ((graph) (topological-sort-impl graph equal? #f))
     ((graph eq) (topological-sort-impl graph eq #f))
     ((graph eq nodes) (topological-sort-impl graph eq nodes))))
 
+(define topological-sort/details
+  (case-lambda
+    ((graph) (topological-sort-impl/details graph equal? #f))
+    ((graph eq) (topological-sort-impl/details graph eq #f))
+    ((graph eq nodes) (topological-sort-impl/details graph eq nodes))))
+
 (define (topological-sort-impl graph eq nodes)
+  (let-values (((v0 v1 v2)
+                (topological-sort-impl/details graph eq nodes)))
+    v0))
+
+(define (topological-sort-impl/details graph eq nodes)
   (define table (map (lambda (n)
                        (cons (car n) 0))
                      graph))

test/include/srfi-234-test.scm

@@ -1,3 +1,6 @@
+;;; SPDX-FileCopyrightText: 2024 Shiro Kawai, John Cowan, Arne Babenhauserheide
+;;; SPDX-License-Identifier: MIT
+
 (cond-expand
   (guile
    (import (scheme base)
@@ -8,6 +11,7 @@
    (import (scheme base)
            (srfi 234)
            (srfi 1)
+           (srfi 11) ;; let-values
            (rename (except (chibi test) test-equal)
                    (test test-equal))))
   (chicken
@@ -32,6 +36,32 @@
                       (c)
                       (d c))))
 
+;; details: multiple values
+(test-equal
+    '((a b d c) #f #f)
+  (let-values
+      (((v0 v1 v2)
+        (topological-sort/details '((a b c)
+                              (b d)
+                              (c)
+                              (d c)))))
+    (list v0 v1 v2)))
+
+;; cycle
+(test-equal
+    #f
+  (topological-sort '((a b)
+                      (b a))))
+
+;; cycle error details
+(test-equal
+    '(#f "graph has circular dependency" (a b))
+  (let-values
+      (((v0 v1 v2)
+        (topological-sort/details '((a b)
+                                    (b a)))))
+    (list v0 v1 v2)))
+
 (test-equal
     '("a" "b" "d" "c")
   (topological-sort '(("a" "b" "c")