Tweak.
authorChris Hanson <org/chris-hanson/cph>
Sun, 15 Apr 2007 17:43:08 +0000 (17:43 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sun, 15 Apr 2007 17:43:08 +0000 (17:43 +0000)
v7/src/runtime/unxpth.scm

index 119755af4f4e006b78a0e5b40d7e4de68c23c26a..446b89083e4e721250c54e335d871c03fd54d9d1 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxpth.scm,v 14.32 2007/01/05 21:19:28 cph Exp $
+$Id: unxpth.scm,v 14.33 2007/04/15 17:43:08 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -326,15 +326,15 @@ USA.
                               (reverse!
                                (let loop
                                    ((elements (reverse (cdr directory))))
-                                 (if (null? elements)
-                                     '()
-                                      (let ((head (car elements))
-                                            (tail (loop (cdr elements))))
-                                        (if (and (eq? head 'UP)
-                                                 (not (null? tail))
-                                                 (not (eq? (car tail) 'UP)))
-                                            (cdr tail)
-                                            (cons head tail)))))))))
+                                 (if (pair? elements)
+                                     (let ((head (car elements))
+                                           (tail (loop (cdr elements))))
+                                       (if (and (eq? head 'UP)
+                                                (pair? tail)
+                                                (not (eq? (car tail) 'UP)))
+                                           (cdr tail)
+                                           (cons head tail)))
+                                     '()))))))
                    (and (not (equal? directory directory*))
                         (let ((pathname*
                                (pathname-new-directory pathname directory*)))