From 28db39b1c5967e79adeb7d2ddb8b81916bc84be7 Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Thu, 13 Feb 2003 09:52:13 +0000
Subject: [PATCH] Fixes from S48 1.0: STRUCTURE-CLIENTS may contain both,
 packages and structures.

---
 scheme/env/pedit.scm | 47 ++++++++++++++++++++++++--------------------
 1 file changed, 26 insertions(+), 21 deletions(-)

diff --git a/scheme/env/pedit.scm b/scheme/env/pedit.scm
index 01423a6..5fdcdf1 100644
--- a/scheme/env/pedit.scm
+++ b/scheme/env/pedit.scm
@@ -138,16 +138,21 @@
       (list package)
       (let ((losers '())) ; was (list package) but that disables the
 	                  ; entire procedure
-	(let recur ((package package))
-	  (if (and (not (memq package losers))
-		   (not (table-ref (package-definitions package) name)))
-	      (begin (set! losers (cons package losers))
-		     (walk-population
-		      (lambda (struct)
-			(if (interface-member? (structure-interface struct) name)
-			    (walk-population recur (structure-clients struct))))
-		      (package-clients package)))))
-	losers)))
+	(let recur ((package-or-structure package))
+	  (let ((package (if (package? package-or-structure)
+			     package
+			     (structure-package package-or-structure))))
+	    (if (and (not (memq package losers))
+		     (not (table-ref (package-definitions package) name)))
+		(begin (set! losers (cons package losers))
+		       (walk-population
+			(lambda (struct)
+			  (if (interface-member? (structure-interface struct)
+						 name)
+			      (walk-population recur
+					       (structure-clients struct))))
+			(package-clients package))))))
+        losers)))
 
 (define (set-location-forward! loser new name p)
   (if *debug?*
@@ -187,18 +192,18 @@
 (define (verify-loser loser)
   (if *debug?*
       (begin (write `(verify-loser ,loser)) (newline)))
-  (cond ((structure? loser)
+  (cond ((interface? loser)
+	 (walk-population verify-loser (interface-clients loser)))
+	((structure? loser)
 	 (reinitialize-structure! loser)
-	 (walk-population
-	  (lambda (p)
-	    (reinitialize-package! p)
-	    (let ((ps (fluid $package-losers)))
-	      (if (not (memq p ps))
-		  (set-fluid! $package-losers
-			      (cons p ps)))))
-	  (structure-clients loser)))
-	((interface? loser)
-	 (walk-population verify-loser (interface-clients loser)))))
+	 (walk-population verify-loser (structure-clients loser)))
+	((package? loser)
+	 (reinitialize-package! loser)
+	 (let ((losers (fluid $package-losers)))
+	   (if (not (memq loser losers))
+	       (set-fluid! $package-losers
+			   (cons loser losers)))))))
+
 
 (define (drain flu check)
   (let loop ()