From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 23 Feb 1998 05:37:47 +0000 (+0000)
Subject: Add stupid mechanism to break cycles in reference graphs.  This
X-Git-Tag: 20090517-FFI~4838
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=dbb756e6820b1b9015948307ee113239334c63c9;p=mit-scheme.git

Add stupid mechanism to break cycles in reference graphs.  This
doesn't try to do a good job -- it just breaks them at the point where
they are discovered.  After having used this program for over a year,
the cycle I just ran across was the first, out of perhaps 100,000
messages or more, so this is an unusual occurrence.
---

diff --git a/v7/src/edwin/nntp.scm b/v7/src/edwin/nntp.scm
index 255f5d456..b5054eb3b 100644
--- a/v7/src/edwin/nntp.scm
+++ b/v7/src/edwin/nntp.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: nntp.scm,v 1.17 1997/11/13 08:01:59 cph Exp $
+;;;	$Id: nntp.scm,v 1.18 1998/02/23 05:37:47 cph Exp $
 ;;;
-;;;	Copyright (c) 1995-97 Massachusetts Institute of Technology
+;;;	Copyright (c) 1995-98 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -1492,14 +1492,26 @@
 	((NONE)
 	 (hash-table/put! table header 'PENDING)
 	 (let ((result
-		(reduce unionq
-			'()
-			(let ((headers (step header)))
-			  (cons headers (map loop headers))))))
+		(reduce
+		 unionq
+		 '()
+		 (let ((headers (step header)))
+		   (cons headers
+			 (map (lambda (header*)
+				(let ((result (loop header*)))
+				  (if (eq? 'CYCLE result)
+				      (begin
+					(if (eq? step news-header:followups)
+					    (unlink-headers! header header*)
+					    (unlink-headers! header* header))
+					'())
+				      result)))
+			      headers))))))
 	   (hash-table/put! table header result)
 	   result))
 	((PENDING)
-	 (error "Cycle detected in header graph:" header))
+	 ;;(error "Cycle detected in header graph:" header)
+	 'CYCLE)
 	(else cache)))))
 
 (define (reset-caches! tables header)