From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 28 Jan 2008 04:26:49 +0000 (+0000)
Subject: Change WEAK-LIST->LIST and LIST->WEAK-LIST to use iterative
X-Git-Tag: 20090517-FFI~382
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=72f38b60feb20ad2e32c0c5473f23fc2395ddd6c;p=mit-scheme.git

Change WEAK-LIST->LIST and LIST->WEAK-LIST to use iterative
algorithms.
---

diff --git a/v7/src/runtime/list.scm b/v7/src/runtime/list.scm
index 12e9436f6..da52780c8 100644
--- a/v7/src/runtime/list.scm
+++ b/v7/src/runtime/list.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: list.scm,v 14.55 2007/03/21 15:06:09 cph Exp $
+$Id: list.scm,v 14.56 2008/01/28 04:26:49 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -348,26 +348,28 @@ USA.
   (system-pair-set-cdr! weak-pair object))
 
 (define (weak-list->list items)
-  (let loop ((items* items))
+  (let loop ((items* items) (result '()))
     (if (weak-pair? items*)
-	(let ((car (system-pair-car items*)))
-	  (if (not car)
-	      (loop (system-pair-cdr items*))
-	      (cons (if (eq? car weak-pair/false) #f car)
-		    (loop (system-pair-cdr items*)))))
+	(loop (system-pair-cdr items*)
+	      (let ((item (system-pair-car items*)))
+		(if (not item)
+		    result
+		    (cons (if (eq? item weak-pair/false) #f item)
+			  result))))
 	(begin
 	  (if (not (null? items*))
 	      (error:not-weak-list items 'WEAK-LIST->LIST))
-	  '()))))
+	  (reverse! result)))))
 
 (define (list->weak-list items)
-  (let loop ((items* items))
+  (let loop ((items* (reverse items)) (result '()))
     (if (pair? items*)
-	(weak-cons (car items*) (loop (cdr items*)))
+	(loop (cdr items*)
+	      (weak-cons (car items*) result))
 	(begin
 	  (if (not (null? items*))
 	      (error:not-list items 'LIST->WEAK-LIST))
-	  '()))))
+	  result))))
 
 (define weak-pair/false
   "weak-pair/false")