Re: [Chicken-hackers] tests/reverser

2013-03-03 Thread Peter Bex
On Sun, Mar 03, 2013 at 01:28:16PM +0100, Jörg F. Wittenberger wrote:
 I wonder what's the purpose of the directory (and content) of
 tests/reverser in branch master is.

It's a bogus egg which exists for testing private repositories
and the deployment mode.  See runtests.sh, the tests at the very end.

 Is this just garbage?  (Or maybe an artifact of me now knowing
 how to make git delete obsolete files?)

No, not garbage.

Cheers,
Peter
-- 
http://www.more-magic.net

___
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers


[Chicken-hackers] [PATCH] Reimplement topological-sort with cycle detection

2013-03-03 Thread Moritz Heidkamp
Fellow Chickeneers,

I recently noticed that Chicken's topological-sort function does not
detect cycles in the passed graph. Initially I ventured into patching
this functionality into the existing implementation which originates
from SLIB. This turned out to be tricky as it is a heavily imperative
implemenatation. By the time I had figured out how it works I had
already opened the relevant chapter of Introduction to
Algorithms. According to the header comment of the SLIB implementation
(see
http://cvs.savannah.gnu.org/viewvc/slib/slib/tsort.scm?revision=1.2) it
is also based on that algorithm, but apparently without the cycle
detection (or maybe it wasn't in the 1st edition which is what the
author used, while I used the 3rd edition). Eventually I found it easier
to reimplement the algorithm in a functinal style to add the cycle
detection bit.

One thing I'm not sure about is how I raise the condition in case a
cycle is detected. Comments on that are very welcome!

Have a nice Sunday
Moritz

From 840b24477b38f1ca3815248ae9704911bd8527b0 Mon Sep 17 00:00:00 2001
From: Moritz Heidkamp mor...@twoticketsplease.de
Date: Sun, 3 Mar 2013 13:28:20 +0100
Subject: [PATCH] Reimplement topological-sort with cycle detection

---
 data-structures.scm | 85 ++---
 1 file changed, 41 insertions(+), 44 deletions(-)

diff --git a/data-structures.scm b/data-structures.scm
index 56944ec..d51abe4 100644
--- a/data-structures.scm
+++ b/data-structures.scm
@@ -707,52 +707,49 @@
 	(sort! (append seq '()) less?)))
 
 
-;;;  Simple topological sort:
-;
-; Taken from SLIB (slightly adapted): Copyright (C) 1995 Mikael Djurfeldt
+;;; Topological sort with cycle detection:
+;;
+;; A functional implementation of the algorithm described in Cormen,
+;; et al. (2009), Introduction to Algorithms (3rd ed.), pp. 612-615.
 
 (define (topological-sort dag pred)
-  (if (null? dag)
-  '()
-  (let* ((adj-table '())
-	 (sorted '()))
-
-	(define (insert x y)
-	  (let loop ([at adj-table])
-	(cond [(null? at) (set! adj-table (cons (cons x y) adj-table))]
-		  [(pred x (caar at)) (set-cdr! (car at) y)]
-		  [else (loop (cdr at))] ) ) )
-	
-	(define (lookup x)
-	  (let loop ([at adj-table])
-	(cond [(null? at) #f]
-		  [(pred x (caar at)) (cdar at)]
-		  [else (loop (cdr at))] ) ) )
-	
-	(define (visit u adj-list)
-	  ;; Color vertex u
-	  (insert u 'colored)
-	  ;; Visit uncolored vertices which u connects to
-	  (for-each (lambda (v)
-		  (let ((val (lookup v)))
-			(if (not (eq? val 'colored))
-			(visit v (or val '())
-		adj-list)
-	  ;; Since all vertices downstream u are visited
-	  ;; by now, we can safely put u on the output list
-	  (set! sorted (cons u sorted)) )
-	
-	;; Hash adjacency lists
-	(for-each (lambda (def) (insert (car def) (cdr def)))
-		  (cdr dag))
-	;; Visit vertices
-	(visit (caar dag) (cdar dag))
-	(for-each (lambda (def)
-		(let ((val (lookup (car def
-		  (if (not (eq? val 'colored))
-			  (visit (car def) (cdr def)
-		  (cdr dag)) 
-	sorted) ) )
+  (define (visit dag node edges path state)
+(case (alist-ref node (car state) pred)
+  ((grey)
+   (##sys#abort
+(##sys#make-structure
+ 'condition
+ '(exn cycle)
+ `((exn . message) cycle detected
+   (exn . arguments) ,(list (cons node (reverse path)))
+   (exn . call-chain) ,(##sys#get-call-chain)
+   (exn . location) topological-sort
+  ((black)
+   state)
+  (else
+   (let walk ((edges (or edges (alist-ref node dag pred '(
+  (state (cons (cons (cons node 'grey) (car state))
+   (cdr state
+ (if (null? edges)
+ (cons (alist-update! node 'black (car state) pred)
+   (cons node (cdr state)))
+ (let ((edge (car edges)))
+   (walk (cdr edges)
+ (visit dag
+edge
+#f
+(cons edge path)
+state
+  (let loop ((dag dag)
+ (state (cons (list) (list
+(if (null? dag)
+(cdr state)
+(loop (cdr dag)
+  (visit dag
+ (caar dag)
+ (cdar dag)
+ '()
+ state)
 
 
 ;;; Binary search:
-- 
1.8.1.4

___
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers


Re: [Chicken-hackers] [PATCH] Reimplement topological-sort with cycle detection

2013-03-03 Thread John Cowan
Moritz Heidkamp scripsit:

 Only the first cycle detected is reported currently.

I think that's more than satisfactory.  Users shouldn't be topologically
sorting a graph that might have cycles anyway.

-- 
Normally I can handle panic attacks on my own;   John Cowan co...@ccil.org
but panic is, at the moment, a way of life.  http://www.ccil.org/~cowan
--Joseph Zitt

___
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers