From b3f02896a07f15e05d2f1b8b17db5cd8b1b11d92 Mon Sep 17 00:00:00 2001
From: Shiro Kawai <shiro@acm.org>
Date: Wed, 18 Sep 2024 19:28:01 -1000
Subject: [PATCH] Update srfi.234 to the latest reference impl

---
 lib/srfi/234.scm               | 31 ++++++++++++++++++++++---------
 test/include/srfi-234-test.scm | 30 ++++++++++++++++++++++++++++++
 2 files changed, 52 insertions(+), 9 deletions(-)

diff --git a/lib/srfi/234.scm b/lib/srfi/234.scm
index ef669a773..3c02d458c 100644
--- a/lib/srfi/234.scm
+++ b/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 (shiro@acm.org)  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))
diff --git a/test/include/srfi-234-test.scm b/test/include/srfi-234-test.scm
index 4fd2bb804..a1af86469 100644
--- a/test/include/srfi-234-test.scm
+++ b/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")