@@ -27330,6 +27331,10 @@
13.2.3. SRFI features
srfi-233 |
+topological-sort |
+srfi-234 |
+
+
combinators |
srfi-235 |
diff --git a/lib/srfi/234.stk b/lib/srfi/234.stk
new file mode 100644
index 00000000..a364b27b
--- /dev/null
+++ b/lib/srfi/234.stk
@@ -0,0 +1,264 @@
+;;;;
+;;;; 234.stk -- Implementation of SRFI-234
+;;;;
+;;;; Copyright © 2020 Jeronimo Pellegrini -
+;;;;
+;;;;
+;;;; This program 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.
+;;;;
+;;;; This program 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 this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; This file is a derivative work from the implementation of
+;;;; this SRFI by Shiro Kawai, John Cowan, Arne Babenhauserheide,
+;;;; it is copyrighted as:
+;;;;
+;;;;;; © 2024 John Cowan, Shiro Kawai, Arthur A. Gleckler, Arne
+;;;;;; Babenhauserheide.
+;;;;;;
+;;;;;; Permission is hereby granted, free of charge, to any person
+;;;;;; obtaining a copy of this software and associated documentation
+;;;;;; files (the "Software"), to deal in the Software without
+;;;;;; restriction, including without limitation the rights to use,
+;;;;;; copy, modify, merge, publish, distribute, sublicense, and/or
+;;;;;; sell copies of the Software, and to permit persons to whom the
+;;;;;; Software is furnished to do so, subject to the following
+;;;;;; conditions:
+;;;;;;
+;;;;;; The above copyright notice and this permission notice
+;;;;;; (including the next paragraph) shall be included in all copies
+;;;;;; or substantial portions of the Software.
+;;;;;;
+;;;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+;;;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+;;;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+;;;;;; OTHER DEALINGS IN THE SOFTWARE.
+;;;;
+;;;; Author: Jeronimo Pellegrini [j_p@aleph0.info]
+;;;; Creation date: 10-Oct-2024 17:12 (jpellegrini)
+;;;;
+
+(define-module srfi/234
+ (import
+ (scheme base)
+ (scheme case-lambda)
+ (srfi 1)
+ (srfi 11) ;; let-values
+ (srfi 26)) ;; cut
+ (export topological-sort
+ topological-sort/details
+ edgelist->graph
+ edgelist/inverted->graph
+ graph->edgelist
+ graph->edgelist/inverted
+ connected-components)
+
+(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))
+ (define queue '())
+ (define result '())
+
+ ;; set up - compute number of nodes that each node depends on.
+ (define (set-up)
+ (for-each
+ (lambda (node)
+ (for-each
+ (lambda (to)
+ (define p (assoc to table eq))
+ (if p
+ (set-cdr! p (+ 1 (cdr p)))
+ (set! table (cons
+ (cons to 1)
+ table))))
+ (cdr node)))
+ graph))
+
+ ;; traverse
+ (define (traverse)
+ (unless (null? queue)
+ (let ((n0 (assoc (car queue) graph eq)))
+ (set! queue (cdr queue))
+ (when n0
+ (for-each
+ (lambda (to)
+ (define p (assoc to table eq))
+ (when p
+ (let ((cnt (- (cdr p) 1)))
+ (when (= cnt 0)
+ (set! result (cons to result))
+ (set! queue (cons to queue)))
+ (set-cdr! p cnt))))
+ (cdr n0)))
+ (traverse))))
+
+ (set-up)
+ (set! queue
+ (apply append
+ (map
+ (lambda (p)
+ (if (= (cdr p) 0)
+ (list (car p))
+ '()))
+ table)))
+ (set! result queue)
+ (traverse)
+ (let ((rest (filter (lambda (e)
+ (not (zero? (cdr e))))
+ table)))
+ (if (null? rest)
+ (values
+ (if nodes
+ ;; replace indizes by node values
+ (let loop ((res '()) (result result))
+ (if (null? result)
+ res
+ (loop (cons (vector-ref nodes (car result)) res)
+ (cdr result))))
+ (reverse result))
+ #f #f)
+ (values #f "graph has circular dependency" (map car rest)))))
+
+;; Calculate the connected components from a graph of in-neighbors
+;; implements Kosaraju's algorithm: https://en.wikipedia.org/wiki/Kosaraju%27s_algorithm
+(define (connected-components graph)
+ (define nodes-with-inbound-links (map car graph))
+ ;; graph of out-neighbors
+ (define graph/inverted (edgelist->graph (graph->edgelist/inverted graph)))
+ (define nodes-with-outbound-links (map car graph/inverted))
+ ;; for simplicity this uses a list of nodes to query for membership. This is expensive.
+ (define visited '())
+ (define vertex-list '())
+ ;; create vertex-list sorted with outbound elements first
+ (define (visit! node)
+ (cond ((member node visited) '())
+ (else
+ ;; mark as visited before traversing
+ (set! visited (cons node visited))
+ ;; this uses the graph: the outbound connections
+ (let ((node-in-graph (assoc node graph)))
+ (when node-in-graph
+ (for-each visit! (cdr node-in-graph))))
+ ;; add to list after traversing
+ (set! vertex-list (cons node vertex-list)))))
+ ;; for simplicity this uses a list of nodes to query for membership. This is expensive.
+ (define in-component '())
+ (define components '())
+ ;; assign nodes to their components
+ (define (assign! u root)
+ (unless (member u in-component)
+ (set! in-component (cons u in-component))
+ (set! components (cons (cons u (car components)) (cdr components)))
+ ;; this uses the graph/inverted: the inbound connections
+ (let ((node-in-graph (assoc u graph/inverted)))
+ (when node-in-graph
+ (for-each (cut assign! <> root) (cdr node-in-graph))))))
+ (define (assign-as-component! u)
+ (unless (member u in-component)
+ (set! components (cons '() components))
+ (assign! u u)))
+ (for-each visit! nodes-with-outbound-links)
+ (for-each assign-as-component! vertex-list)
+ components)
+
+;; convert an edgelist '((a b) (a c) (b e)) to a graph '((a b c) (b e))
+(define edgelist->graph
+ (case-lambda
+ ((edgelist) (edgelist->graph-impl edgelist assoc))
+ ((edgelist asc) (edgelist->graph-impl edgelist asc))))
+(define (edgelist->graph-impl edgelist asc)
+ (let loop ((graph '()) (edges edgelist))
+ (cond
+ ((null? edges) (reverse! graph))
+ ((asc (car (car edges)) graph)
+ (let* ((edge (car edges))
+ (left (car edge))
+ (graph-entry (asc left graph))
+ (right (car (cdr edge))))
+ ;; adjust the right-most cdr
+ (let lp ((entry graph-entry))
+ (if (null? (cdr entry))
+ (set-cdr! entry (list right))
+ (lp (cdr entry))))
+ (loop graph (cdr edges))))
+ ;; use apply list to break up immutable pairs
+ (else (loop (cons (apply list (car edges)) graph) (cdr edges))))))
+
+;; convert an inverted edgelist '((b a) (c a) (e b)) to a graph '((a b c) (b e))
+(define edgelist/inverted->graph
+ (case-lambda
+ ((edgelist) (edgelist/inverted->graph-impl edgelist assoc))
+ ((edgelist asc) (edgelist/inverted->graph-impl edgelist asc))))
+(define (edgelist/inverted->graph-impl edgelist asc)
+ (let loop ((graph '()) (edges edgelist))
+ (cond
+ ((null? edges) (reverse! graph))
+ ((asc (car (cdr (car edges))) graph)
+ (let* ((edge (car edges))
+ (left (car (cdr edge)))
+ (graph-entry (asc left graph))
+ (right (car edge)))
+ ;; adjust the right-most cdr
+ (let lp ((entry graph-entry))
+ (if (null? (cdr entry))
+ (set-cdr! entry (list right))
+ (lp (cdr entry))))
+ (loop graph (cdr edges))))
+ ;; reverse instead of reverse! to avoid immutable lists
+ (else (loop (cons (reverse (car edges)) graph) (cdr edges))))))
+
+(define (graph->edgelist graph)
+ (graph->edgelist/base graph (lambda (top) (list (car top) (car (cdr top))))))
+
+(define (graph->edgelist/inverted graph)
+ (graph->edgelist/base graph (lambda (top) (list (car (cdr top)) (car top)))))
+
+(define (graph->edgelist/base graph top-to-edge-fun)
+ (let loop ((edgelist '()) (graph graph))
+ (cond ((null? graph)
+ (reverse! edgelist))
+ ((null? (car graph))
+ (loop edgelist (cdr graph)))
+ ((null? (cdr (car graph)))
+ (loop edgelist (cdr graph)))
+ (else
+ (let* ((top (car graph))
+ (edge (top-to-edge-fun top))
+ (rest (cdr (cdr top))))
+ (loop (cons edge edgelist)
+ (cons (cons (car top) rest) (cdr graph))))))))
+)
+
+(provide "srfi/234")
diff --git a/lib/srfi/Makefile.am b/lib/srfi/Makefile.am
index 3074353a..cbc49e77 100644
--- a/lib/srfi/Makefile.am
+++ b/lib/srfi/Makefile.am
@@ -143,6 +143,7 @@ SRC_STK = 1.stk \
230.stk \
232.stk \
233.stk \
+ 234.stk \
235.stk \
236.stk \
244.stk
@@ -257,6 +258,7 @@ SRC_OSTK = 1.ostk \
230.ostk \
232.ostk \
233.ostk \
+ 234.ostk \
235.ostk \
236.ostk \
244.ostk
@@ -337,6 +339,7 @@ SUFFIXES = .stk .ostk .stk -incl.c .$(SO) .c
217.ostk: ../stklos/itrie.$(SO)
221.ostk: 41.ostk 158.ostk
224.ostk: ../scheme/comparator.ostk
+234.ostk: 1.ostk 11.ostk 26.ostk
235.ostk: 1.ostk
diff --git a/lib/srfi/Makefile.in b/lib/srfi/Makefile.in
index c6524a4e..ced2e1af 100644
--- a/lib/srfi/Makefile.in
+++ b/lib/srfi/Makefile.in
@@ -510,6 +510,7 @@ SRC_STK = 1.stk \
230.stk \
232.stk \
233.stk \
+ 234.stk \
235.stk \
236.stk \
244.stk
@@ -624,6 +625,7 @@ SRC_OSTK = 1.ostk \
230.ostk \
232.ostk \
233.ostk \
+ 234.ostk \
235.ostk \
236.ostk \
244.ostk
@@ -1057,6 +1059,7 @@ STKLOS_BINARY ?= ../../src/stklos
217.ostk: ../stklos/itrie.$(SO)
221.ostk: 41.ostk 158.ostk
224.ostk: ../scheme/comparator.ostk
+234.ostk: 1.ostk 11.ostk 26.ostk
235.ostk: 1.ostk
25.$(SO): 25-incl.c 25.c
diff --git a/lib/srfis.stk b/lib/srfis.stk
index c4643df5..d9981a84 100644
--- a/lib/srfis.stk
+++ b/lib/srfis.stk
@@ -272,7 +272,7 @@
;; 231 Intervals and Generalized Arrays (Updated^2)
(232 "Flexible Curried Procedures" () "srfi-232")
(233 "INI files" (ini-files) "srfi-233")
- ;; 234 Topological sorting (draft)
+ (234 "Topological sorting" (topological-sort) "srfi-234")
(235 "Combinators" (combinators) "srfi-235")
(236 "Evaluating expressions in an unspecified order" () "srfi-236")
;; 237 R6RS Records (refined)
diff --git a/src/boot.c b/src/boot.c
index 1b3b63bc..da0b6646 100644
--- a/src/boot.c
+++ b/src/boot.c
@@ -2186,7 +2186,7 @@ char* STk_boot_consts = "#("
"(lambda (bindings . body) `(%let-syntax ,(map (lambda (x) (let ((macro-name (car x)) (syn-rules (cadr x))) (let ((alt-ellipsis? (not (list? (cadr syn-rules))))) (let ((ellipsis (if alt-ellipsis? (cadr syn-rules) '...)) (keywords (if alt-ellipsis? (cons macro-name (caddr syn-rules)) (cons macro-name (cadr syn-rules)))) (clauses (if alt-ellipsis? (cdddr syn-rules) (cddr syn-rules)))) `(,macro-name (lambda args (%find-macro-clause ',macro-name args ',keywords ',clauses ',ellipsis))))))) bindings) ,@body))" " "
"((SCHEME))" " "
"((srfi0-register-feature! . srfi0-register-feature!) (srfi-0-feature-implementation-file . srfi-0-feature-implementation-file) (require-feature . require-feature) (cond-expand . cond-expand) (%srfi-0-expand . %srfi-0-expand))" " "
-"(srfi-0 (srfi-1 . \"srfi-1\") (lists . \"srfi-1\") (srfi-2 . \"srfi-2\") (and-let* . \"srfi-2\") (srfi-4 . \"srfi-4\") (hvectors . \"srfi-4\") (srfi-5 . \"srfi-5\") srfi-6 (srfi-7 . \"srfi-7\") (program . \"srfi-7\") srfi-8 (srfi-9 . \"srfi-9\") (records . \"srfi-9\") srfi-10 srfi-11 (srfi-13 . \"srfi-13\") (srfi-14 . \"srfi-14\") srfi-15 srfi-16 case-lambda (srfi-17 . \"srfi-17\") srfi-18 (srfi-19 . \"srfi-19\") srfi-22 srfi-23 error (srfi-25 . \"srfi-25\") (srfi-26 . \"srfi-26\") (srfi-27 . \"srfi-27\") (random . \"srfi-27\") srfi-28 (srfi-29 . \"srfi-29\") srfi-30 srfi-31 srfi-34 (srfi-35 . \"srfi-35\") (srfi-36 . \"srfi-36\") (srfi-37 . \"srfi-37\") (args-fold . \"srfi-37\") srfi-38 srfi-39 parameters (srfi-41 . \"srfi-41\") (streams . \"srfi-41\") (srfi-43 . \"srfi-43\") srfi-45 srfi-46 (srfi-48 . \"srfi-48\") (srfi-51 . \"srfi-51\") (rest-list . \"srfi-51\") (srfi-54 . \"srfi-54\") (formatting . \"srfi-54\") srfi-55 (srfi-59 . \"srfi-59\") (srfi-60 . \"srfi-60\") (srfi-61 . \"srfi-61\") srfi-62 (srfi-64 . \"srfi-64\") (testing . \"srfi-64\") (srfi-66 . \"srfi-66\") (srfi-69 . \"srfi-69\") (hash-tables . \"srfi-69\") srfi-70 (srfi-74 . \"srfi-74\") srfi-87 srfi-88 (srfi-89 . \"srfi-89\") (srfi-94 . \"srfi-94\") (srfi-95 . \"srfi-95\") (srfi-96 . \"srfi-96\") srfi-98 (srfi-100 . \"srfi-100\") srfi-111 boxes srfi-112 (srfi-113 . \"srfi-113\") (sets-bags . \"srfi-113\") (srfi-115 . \"srfi-115\") (srfi-116 . \"srfi-116\") (immutable-lists . \"srfi-116\") (srfi-117 . \"srfi-117\") (queues-as-lists . \"srfi-117\") srfi-118 adjustable-strings (srfi-125 . \"srfi-125\") (hash-table . \"srfi-125\") (srfi-127 . \"srfi-127\") (lazy-sequences . \"srfi-127\") (srfi-128 . \"srfi-128\") (comparators-reduced . \"srfi-128\") (srfi-129 . \"srfi-129\") (titlecase . \"srfi-129\") (srfi-130 . \"srfi-130\") (srfi-132 . \"srfi-132\") (sort . \"srfi-132\") (srfi-133 . \"srfi-133\") (vector . \"srfi-133\") (srfi-134 . \"srfi-134\") (immutable-deques . \"srfi-134\") (srfi-135 . \"srfi-135\") (immutable-texts . \"srfi-135\") (srfi-137 . \"srfi-137\") srfi-138 (srfi-141 . \"srfi-141\") (integer-division . \"srfi-141\") srfi-143 (srfi-144 . \"srfi-144\") srfi-145 (srfi-151 . \"srfi-151\") (bitwise-ops . \"srfi-151\") (srfi-152 . \"srfi-152\") (srfi-154 . \"srfi-154\") (srfi-156 . \"srfi-156\") (srfi-158 . \"srfi-158\") (srfi-160 . \"srfi-160\") (srfi-161 . \"srfi-161\") (srfi-162 . \"srfi-128\") srfi-169 (srfi-170 . \"srfi-170\") (posix . \"srfi-170\") (srfi-171 . \"srfi-171\") (transducers . \"srfi-171\") (srfi-173 . \"srfi-173\") (hooks . \"srfi-173\") (srfi-174 . \"srfi-174\") (posix-timespecs . \"srfi-174\") (srfi-175 . \"srfi-175\") (ascii . \"srfi-175\") srfi-176 (srfi-178 . \"srfi-178\") (srfi-180 . \"srfi-180\") (JSON . \"srfi-180\") (json . \"srfi-180\") (srfi-185 . \"srfi-185\") (srfi-189 . \"srfi-189\") (maybe-either . \"srfi-189\") (srfi-190 . \"srfi-190\") srfi-192 srfi-193 srfi-195 (srfi-196 . \"srfi-196\") (srfi-207 . \"srfi-207\") srfi-208 (srfi-214 . \"srfi-214\") (srfi-215 . \"srfi-215\") (srfi-216 . \"srfi-216\") (srfi-217 . \"srfi-217\") srfi-219 (srfi-221 . \"srfi-221\") (srfi-222 . \"srfi-222\") (srfi-223 . \"srfi-223\") (srfi-224 . \"srfi-224\") (srfi-227 . \"srfi-227\") (srfi-228 . \"srfi-228\") (srfi-229 . \"srfi-229\") (srfi-230 . \"srfi-230\") (srfi-232 . \"srfi-232\") (srfi-233 . \"srfi-233\") (ini-files . \"srfi-233\") (srfi-235 . \"srfi-235\") (combinators . \"srfi-235\") (srfi-236 . \"srfi-236\") (srfi-238 . \"srfi-238\") srfi-244 (conditions \"srfi-35\" \"srfi-36\") (generators \"srfi-158\" \"srfi-190\"))" " "
+"(srfi-0 (srfi-1 . \"srfi-1\") (lists . \"srfi-1\") (srfi-2 . \"srfi-2\") (and-let* . \"srfi-2\") (srfi-4 . \"srfi-4\") (hvectors . \"srfi-4\") (srfi-5 . \"srfi-5\") srfi-6 (srfi-7 . \"srfi-7\") (program . \"srfi-7\") srfi-8 (srfi-9 . \"srfi-9\") (records . \"srfi-9\") srfi-10 srfi-11 (srfi-13 . \"srfi-13\") (srfi-14 . \"srfi-14\") srfi-15 srfi-16 case-lambda (srfi-17 . \"srfi-17\") srfi-18 (srfi-19 . \"srfi-19\") srfi-22 srfi-23 error (srfi-25 . \"srfi-25\") (srfi-26 . \"srfi-26\") (srfi-27 . \"srfi-27\") (random . \"srfi-27\") srfi-28 (srfi-29 . \"srfi-29\") srfi-30 srfi-31 srfi-34 (srfi-35 . \"srfi-35\") (srfi-36 . \"srfi-36\") (srfi-37 . \"srfi-37\") (args-fold . \"srfi-37\") srfi-38 srfi-39 parameters (srfi-41 . \"srfi-41\") (streams . \"srfi-41\") (srfi-43 . \"srfi-43\") srfi-45 srfi-46 (srfi-48 . \"srfi-48\") (srfi-51 . \"srfi-51\") (rest-list . \"srfi-51\") (srfi-54 . \"srfi-54\") (formatting . \"srfi-54\") srfi-55 (srfi-59 . \"srfi-59\") (srfi-60 . \"srfi-60\") (srfi-61 . \"srfi-61\") srfi-62 (srfi-64 . \"srfi-64\") (testing . \"srfi-64\") (srfi-66 . \"srfi-66\") (srfi-69 . \"srfi-69\") (hash-tables . \"srfi-69\") srfi-70 (srfi-74 . \"srfi-74\") srfi-87 srfi-88 (srfi-89 . \"srfi-89\") (srfi-94 . \"srfi-94\") (srfi-95 . \"srfi-95\") (srfi-96 . \"srfi-96\") srfi-98 (srfi-100 . \"srfi-100\") srfi-111 boxes srfi-112 (srfi-113 . \"srfi-113\") (sets-bags . \"srfi-113\") (srfi-115 . \"srfi-115\") (srfi-116 . \"srfi-116\") (immutable-lists . \"srfi-116\") (srfi-117 . \"srfi-117\") (queues-as-lists . \"srfi-117\") srfi-118 adjustable-strings (srfi-125 . \"srfi-125\") (hash-table . \"srfi-125\") (srfi-127 . \"srfi-127\") (lazy-sequences . \"srfi-127\") (srfi-128 . \"srfi-128\") (comparators-reduced . \"srfi-128\") (srfi-129 . \"srfi-129\") (titlecase . \"srfi-129\") (srfi-130 . \"srfi-130\") (srfi-132 . \"srfi-132\") (sort . \"srfi-132\") (srfi-133 . \"srfi-133\") (vector . \"srfi-133\") (srfi-134 . \"srfi-134\") (immutable-deques . \"srfi-134\") (srfi-135 . \"srfi-135\") (immutable-texts . \"srfi-135\") (srfi-137 . \"srfi-137\") srfi-138 (srfi-141 . \"srfi-141\") (integer-division . \"srfi-141\") srfi-143 (srfi-144 . \"srfi-144\") srfi-145 (srfi-151 . \"srfi-151\") (bitwise-ops . \"srfi-151\") (srfi-152 . \"srfi-152\") (srfi-154 . \"srfi-154\") (srfi-156 . \"srfi-156\") (srfi-158 . \"srfi-158\") (srfi-160 . \"srfi-160\") (srfi-161 . \"srfi-161\") (srfi-162 . \"srfi-128\") srfi-169 (srfi-170 . \"srfi-170\") (posix . \"srfi-170\") (srfi-171 . \"srfi-171\") (transducers . \"srfi-171\") (srfi-173 . \"srfi-173\") (hooks . \"srfi-173\") (srfi-174 . \"srfi-174\") (posix-timespecs . \"srfi-174\") (srfi-175 . \"srfi-175\") (ascii . \"srfi-175\") srfi-176 (srfi-178 . \"srfi-178\") (srfi-180 . \"srfi-180\") (JSON . \"srfi-180\") (json . \"srfi-180\") (srfi-185 . \"srfi-185\") (srfi-189 . \"srfi-189\") (maybe-either . \"srfi-189\") (srfi-190 . \"srfi-190\") srfi-192 srfi-193 srfi-195 (srfi-196 . \"srfi-196\") (srfi-207 . \"srfi-207\") srfi-208 (srfi-214 . \"srfi-214\") (srfi-215 . \"srfi-215\") (srfi-216 . \"srfi-216\") (srfi-217 . \"srfi-217\") srfi-219 (srfi-221 . \"srfi-221\") (srfi-222 . \"srfi-222\") (srfi-223 . \"srfi-223\") (srfi-224 . \"srfi-224\") (srfi-227 . \"srfi-227\") (srfi-228 . \"srfi-228\") (srfi-229 . \"srfi-229\") (srfi-230 . \"srfi-230\") (srfi-232 . \"srfi-232\") (srfi-233 . \"srfi-233\") (ini-files . \"srfi-233\") (srfi-234 . \"srfi-234\") (topological-sort . \"srfi-234\") (srfi-235 . \"srfi-235\") (combinators . \"srfi-235\") (srfi-236 . \"srfi-236\") (srfi-238 . \"srfi-238\") srfi-244 (conditions \"srfi-35\" \"srfi-36\") (generators \"srfi-158\" \"srfi-190\"))" " "
"%srfi-feature-list" " "
"\"STklos-\"" " "
"\"id-\"" " "
diff --git a/tests/srfis/234.stk b/tests/srfis/234.stk
new file mode 100644
index 00000000..644d3d5b
--- /dev/null
+++ b/tests/srfis/234.stk
@@ -0,0 +1,117 @@
+
+(test "srfi-234.1"
+ '(a b d c)
+ (topological-sort '((a b c)
+ (b d)
+ (c)
+ (d c))))
+
+;; details: multiple values
+(test "srfi-234.2"
+ '((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 "srfi-234.3"
+ #f
+ (topological-sort '((a b)
+ (b a))))
+
+;; cycle error details
+(test "srfi-234.4"
+ '(#f "graph has circular dependency" (a b))
+ (let-values
+ (((v0 v1 v2)
+ (topological-sort/details '((a b)
+ (b a)))))
+ (list v0 v1 v2)))
+
+(test "srfi-234.5"
+ '("a" "b" "d" "c")
+ (topological-sort '(("a" "b" "c")
+ ("b" "d")
+ ("c")
+ ("d" "c"))
+ string=?))
+
+(test "srfi-234.6"
+ '((a b c) (b e))
+ (edgelist->graph '((a b) (a c) (b e))))
+
+(test "srfi-234.7"
+ '((a b) (a c) (b e))
+ (graph->edgelist '((a b c) (b e))))
+
+(test "srfi-234.8"
+ '((a b c) (b e))
+ (edgelist/inverted->graph '((b a) (c a) (e b))))
+
+(test "srfi-234.9"
+ '((b a) (c a) (e b))
+ (graph->edgelist/inverted '((a b c) (b e))))
+
+(test "srfi-234.10"
+ '((0 1) (1 2) (2 0) (3 1 2 4) (4 3 5) (5 2 6) (6 5) (7 4 6 7))
+ (edgelist->graph '((0 1)
+ (1 2)
+ (2 0)
+ (3 1) (3 2) (3 4)
+ (4 3) (4 5)
+ (5 2) (5 6)
+ (6 5)
+ (7 4) (7 6) (7 7))))
+
+(test "srfi-234.11"
+ '((1 0 3) (2 1 3 5) (0 2) (4 3 7) (3 4) (5 4 6) (6 5 7) (7 7))
+ (edgelist/inverted->graph '((0 1)
+ (1 2)
+ (2 0)
+ (3 1) (3 2) (3 4)
+ (4 3) (4 5)
+ (5 2) (5 6)
+ (6 5)
+ (7 4) (7 6) (7 7))))
+
+(test "srfi-234.12"
+ '((2 0 1) (6 5) (3 4) (7))
+ (connected-components
+ (edgelist->graph '((0 1)
+ (1 2)
+ (2 0)
+ (3 1) (3 2) (3 4)
+ (4 3) (4 5)
+ (5 2) (5 6)
+ (6 5)
+ (7 4) (7 6) (7 7)))))
+
+(define (permutations edgelist)
+ (if (null? edgelist) '(())
+ (apply append
+ (map (lambda (edge)
+ (map (lambda (permutation)
+ (cons edge permutation))
+ (permutations (delete edge edgelist))))
+ edgelist))))
+
+(test "srfi-234.13"
+ #t
+ (every (lambda (edgelist)
+ (let* ((graph (edgelist->graph edgelist))
+ (order (topological-sort graph equal?)))
+ (cond
+ ((equal? order '(top left right bottom)) #t)
+ ((equal? order '(top right left bottom)) #t)
+ (else order))))
+ (permutations '((top left) (top right) (left bottom) (right bottom)))))
+
+(test "srfi-234.14"
+ '(libnewsboat regex-rs strprintf)
+ (topological-sort (edgelist->graph '((libnewsboat strprintf)
+ (libnewsboat regex-rs)
+ (regex-rs strprintf)))))