use simple-form-path more consistently for path normalization

--- a reversal of opinion from my earlier commit; the problem
 with syntactic simplification is that it may not refer to the
 same file, due to soft links; given that true normalization is
 impossible, simplify-path and simple-form-path provide a good
 compromise between preserving paths as given and exanding
 soft links as neede

collects/compiler/cm.rkt

@@ -31,12 +31,12 @@
   (file-stamp-in-paths p (current-library-collection-paths)))
 
 (define (file-stamp-in-paths p paths)
-  (let ([p-eles (explode-path (simplify-path p))])
+  (let ([p-eles (explode-path (simple-form-path p))])
     (let c-loop ([paths paths])
       (cond
         [(null? paths) #f]
         [else
-         (let i-loop ([collects-eles (explode-path (car paths))]
+         (let i-loop ([collects-eles (explode-path (simple-form-path (car paths)))]
                       [p-eles p-eles])
            (cond
              [(null? collects-eles)
@@ -187,7 +187,7 @@
                               [v (cons (cons (delay v) dep) l)]
                               [must-exist? (error 'cm "cannot find external-dependency file: ~v" p)]
                               [else #f]))]
-                     [(or (hash-ref up-to-date (simplify-path (cleanse-path p)) #f)
+                     [(or (hash-ref up-to-date (simple-form-path p) #f)
                           ;; Use `compiler-root' with `sha1-only?' as #t:
                           (compile-root mode p up-to-date read-src-syntax #t))
                       => (lambda (sh)
@@ -439,7 +439,7 @@
         p)))
 
 (define (compile-root mode path0 up-to-date read-src-syntax sha1-only?)
-  (define orig-path (simplify-path (cleanse-path path0)))
+  (define orig-path (simple-form-path path0))
   (define (read-deps path)
     (with-handlers ([exn:fail:filesystem? (lambda (ex) (list (version) '#f))])
       (call-with-input-file

collects/launcher/launcher-unit.rkt

@@ -221,7 +221,7 @@
    #rx"[\"`'$\\]" (if (path? s) (path->string s) s) "\\\\&"))
 
 (define (normalize+explode-path p)
-  (explode-path (normal-case-path (normalize-path p))))
+  (explode-path (normal-case-path (simple-form-path p))))
 
 (define (relativize bindir-explode dest-explode)
   (let loop ([b bindir-explode] [d dest-explode])

collects/planet/private/cmdline-tool.rkt

@@ -8,6 +8,7 @@ PLANNED FEATURES:
 |#
   (require mzlib/string
            mzlib/file
+           (only racket/path simple-form-path)
            (only mzlib/list sort)
            net/url
            mzlib/match
@@ -178,7 +179,7 @@ This command does not unpack or install the named .plt file."
     
   (define (install-plt-file filestr owner majstr minstr)
     (unless (file-exists? filestr) (fail "File does not exist: ~a" filestr))
-    (let* ([file (normalize-path filestr)]
+    (let* ([file (simple-form-path filestr)]
            [name (let-values ([(base name dir?) (split-path file)]) (path->string name))]
            [fullspec (params->full-pkg-spec owner name majstr minstr)])
       (install-pkg fullspec file (pkg-spec-maj fullspec) (pkg-spec-minor-lo fullspec))))
@@ -186,7 +187,7 @@ This command does not unpack or install the named .plt file."
   (define (do-archive p)
     (unless (directory-exists? p)
       (fail "No such directory: ~a" p))
-    (make-planet-archive (normalize-path p)))
+    (make-planet-archive (simple-form-path p)))
   
   (define (remove owner pkg majstr minstr)
     (let ((maj (string->number majstr))
@@ -273,19 +274,19 @@ This command does not unpack or install the named .plt file."
   (define (do-unpack plt-file target)
     (unless (file-exists? plt-file)
       (fail (format "The specified file (~a) does not exist" plt-file))) 
-    (let ([file (normalize-path plt-file)])
+    (let ([file (simple-form-path plt-file)])
       (unpack-planet-archive file target)))
   
   (define (do-structure plt-file)
     (unless (file-exists? plt-file)
       (fail (format "The specified file (~a) does not exist" plt-file))) 
-    (let ([file (normalize-path plt-file)])
+    (let ([file (simple-form-path plt-file)])
       (display-plt-file-structure file)))
   
   (define (do-display plt-file file-to-print)
     (unless (file-exists? plt-file)
       (fail (format "The specified file (~a) does not exist" plt-file))) 
-    (let ([file (normalize-path plt-file)])
+    (let ([file (simple-form-path plt-file)])
       (display-plt-archived-file file file-to-print)))
   
   ;; ------------------------------------------------------------

collects/planet/util.rkt

@@ -159,10 +159,10 @@
           #:exists 'truncate/replace)))))
 
 ;; subpath? : path path -> boolean
-;; determines if p1 is a subpath of p2. Both paths must actually exist on the filesystem
+;; determines if p1 is a subpath of p2.
 (define (subpath? p1 p2)
-  (let ([full-p1 (explode-path (normalize-path p1))]
-        [full-p2 (explode-path (normalize-path p2))])
+  (let ([full-p1 (explode-path (simple-form-path p1))]
+        [full-p2 (explode-path (simple-form-path p2))])
     (sublist? full-p1 full-p2 (o2 bytes=? path->bytes))))
 
 ;; o2 : (X X -> Y) (Z -> X) -> (Z Z -> Y)
@@ -353,11 +353,11 @@
      (let-values ([(path name must-be-dir?) (split-path dir)])
        (make-planet-archive 
         dir 
-        (build-path (normalize-path (current-directory))
+        (build-path (current-directory)
                     (string-append (path->string name) ".plt"))))]
     [(dir archive-name)
-     (let ([abs-dir (normalize-path dir)])
-       (parameterize ((current-directory (normalize-path dir)))
+     (let ([abs-dir (simple-form-path dir)])
+       (parameterize ((current-directory abs-dir))
          (let ([announcements '()]
                [warnings '()]
                [critical-errors '()])
@@ -429,7 +429,7 @@
             (λ (s) (fprintf (current-error-port) "WARNING:\n\t~a\n" s))
             (reverse warnings))))
        
-       (normalize-path archive-name))]))
+       (simple-form-path archive-name))]))
 
 (define (unpack-planet-archive plt-file target)
   (parameterize ([current-directory target])
@@ -816,8 +816,8 @@
 
 ;; contains-dir? : path -> pkg -> boolean
 (define ((contains-dir? srcdir) alleged-superdir-pkg)
-  (let* ([nsrcdir (normalize-path srcdir)]
-         [nsuperdir (normalize-path (car alleged-superdir-pkg))]
+  (let* ([nsrcdir (simple-form-path srcdir)]
+         [nsuperdir (simple-form-path (car alleged-superdir-pkg))]
          [nsrclist (explode-path nsrcdir)]
          [nsuperlist (explode-path nsuperdir)])
     (list-prefix? nsuperlist nsrclist)))

collects/racket/sandbox.rkt

@@ -109,10 +109,10 @@
 (define (simplify-path* path)
   (if (symbol? path)
       #f
-      (simplify-path (cleanse-path (path->complete-path
-                                    (cond [(bytes? path) (bytes->path path)]
-                                          [(string? path) (string->path path)]
-                                          [else path]))))))
+      (simple-form-path
+       (cond [(bytes? path) (bytes->path path)]
+             [(string? path) (string->path path)]
+             [else path]))))
 
 ;; 'read-bytecode is special, it's higher than 'read, but not lower than
 ;; 'delete.

collects/scribblings/reference/paths.scrbl

@@ -344,8 +344,7 @@ expansion).}
 @defproc[(cleanse-path [path path-string?]) path]{
 
 @techlink{Cleanse}s @racket[path] (as described at the beginning of
-this section). The filesystem might be accessed, but the source or
-expanded path might be a non-existent path.}
+this chapter) without consulting the filesystem.}
 
 
 @defproc[(expand-user-path [path path-string?]) path]{
@@ -525,21 +524,26 @@ no extension, @racket[#f] is returned.}
                              [path (or/c path-string?  path-for-some-system?)])
          path-for-some-system?]{
 
-Finds a relative pathname with respect to @racket[base] that names
-the same file or directory as @racket[path]. Both @racket[base]
-and @racket[path] must be simplified in the sense of
-@racket[simple-form-path].  If @racket[path] is not a proper subpath
-of @racket[base] (i.e., a subpath that is strictly longer),
-@racket[path] is returned.}
+Finds a relative pathname with respect to @racket[base] that names the
+same file or directory as @racket[path]. Both @racket[base] and
+@racket[path] must be simplified in the sense of @racket[simple-form-path].  If
+@racket[path] is not a proper subpath of @racket[base] (i.e., a
+subpath that is strictly longer), @racket[path] is returned.}
 
 @defproc[(normalize-path [path path-string?]
                          [wrt (and/c path-string? complete-path?)
                               (current-directory)]) 
          path?]{
 
-Returns a normalized, complete version of @racket[path], expanding the
-path and resolving all soft links. If @racket[path] is relative, then
-@racket[wrt] is used as the base path.
+@margin-note{For most purposes, @racket[simple-form-path] is the
+ preferred mechanism to normalize a path, because it works for paths
+ that include non-existent directory components, and it avoids
+ unnecessarily expanding soft links.}
+
+Returns a complete version of @racket[path] by making the path
+complete, expanding the complete path, and resolving all soft links
+(which requires consulting the filesystem). If @racket[path] is
+relative, then @racket[wrt] is used as the base path.
 
 Letter case is @italic{not} normalized by @racket[normalize-path]. For
 this and other reasons, such as whether the path is syntactically a

collects/setup/private/lib-roots.rkt

@@ -31,7 +31,7 @@
                     (reverse r)
                     (let ([x (and (list? x) (= 7 (length x)) (list-ref x 4))])
                       (loop (if (bytes? x)
-                              (cons (cons (simplify-path (bytes->path x) #f) 0) r)
+                              (cons (cons (simple-form-path (bytes->path x)) 0) r)
                               r))))))))))))
 
 (define path->library-root
@@ -44,7 +44,7 @@
       (unless (complete-path? path)
         (raise-type-error 'path->library-root "complete-path" path))
       (unless t (init-table))
-      (let loop ([rpath (reverse (explode-path (simplify-path path #f)))]
+      (let loop ([rpath (reverse (explode-path (simple-form-path path)))]
                  [subdir '()])
         (let ([x (hash-ref t rpath #f)])
           (cond [(and x ((length subdir) . >= . x))

collects/setup/private/omitted-paths.rkt

@@ -49,7 +49,7 @@
     (let ([omit (info 'compile-omit-paths (lambda () '()))])
       (if (eq? 'all omit)
         'all
-        (map (lambda (e) (explode-path (simplify-path e #f)))
+        (map (lambda (e) (explode-path (simplify-path e)))
              ;; for backward compatibility
              (append omit (info 'compile-omit-files (lambda () '())))))))
   (cond
@@ -86,7 +86,7 @@
   (unless (and (path-string? dir) (complete-path? dir) (directory-exists? dir))
     (raise-type-error 'omitted-paths
                       "complete path to an existing directory" dir))
-  (let* ([dir* (explode-path (simplify-path dir #f))]
+  (let* ([dir* (explode-path (simple-form-path dir))]
          [r (ormap (lambda (root+table)
                      (let ([r (relative-from dir* (car root+table))])
                        (and r (cons (reverse r) root+table))))

collects/setup/setup-unit.rkt

@@ -404,8 +404,8 @@
         (for ([path paths])
           (let ([full-path (build-path (cc-path cc) path)])
             (when (or (file-exists? full-path) (directory-exists? full-path))
-              (let ([path (find-relative-path (simplify-path (cc-path cc) #f)
-                                              (simplify-path full-path #f))])
+              (let ([path (find-relative-path (simple-form-path (cc-path cc))
+                                              (simple-form-path full-path))])
                 (let loop ([path path])
                   (let-values ([(base name dir?) (split-path path)])
                     (cond
@@ -522,7 +522,7 @@
              [doing-path (lambda (path)
                            (unless (verbose)
                              (let ([path (normal-case-path (path-only path))])
-                               (unless (hash-ref dir-table path (lambda () #f))
+                               (unless (hash-ref dir-table path #f)
                                  (hash-set! dir-table path #t)
                                  (print-verbose oop path)))))])
         (parameterize ([current-output-port (if (verbose) (current-output-port) (open-output-nowhere))]
@@ -888,7 +888,7 @@
        '())))
 
   (current-library-collection-paths
-   (map (lambda (p) (simplify-path p #f)) (current-library-collection-paths)))
+   (map simple-form-path (current-library-collection-paths)))
 
   (setup-printf "version" "~a [~a]" (version) (system-type 'gc))
   (setup-printf "variants" "~a" (string-join (map symbol->string (available-mzscheme-variants)) ", "))

src/racket/src/startup.inc

@@ -639,7 +639,7 @@
 "(list(ss->rkt file))))))))"
 "((path? s) "
 "(if(absolute-path? s)"
-"(path-ss->rkt s)"
+"(path-ss->rkt(simplify-path s))"
 " (list \" (a path must be absolute)\")))"
 "((eq?(car s) 'lib)"
 "(or(hash-ref -path-cache"
@@ -674,7 +674,8 @@
 "(ss->rkt file)"
 " (string-append file \".rkt\")))))))))"
 "((eq?(car s) 'file)"
-"(path-ss->rkt(path->complete-path(expand-user-path(cadr s))(get-dir)))))))"
+"(path-ss->rkt "
+"(simplify-path(path->complete-path(expand-user-path(cadr s))(get-dir))))))))"
 "(unless(or(path? s-parsed) "
 "(vector? s-parsed))"
 "(if stx"

src/racket/src/startup.rktl

@@ -731,7 +731,8 @@
                                        (list (ss->rkt file)))))))]
                       [(path? s) 
                        (if (absolute-path? s)
-                           (path-ss->rkt s)
+                           ;; Use filesystem-sensitive `simplify-path' here:
+                           (path-ss->rkt (simplify-path s))
                            (list " (a path must be absolute)"))]
                       [(eq? (car s) 'lib)
                        (or (hash-ref -path-cache
@@ -766,7 +767,9 @@
                                                          (ss->rkt file)
                                                          (string-append file ".rkt"))))))))]
                       [(eq? (car s) 'file)
-                       (path-ss->rkt (path->complete-path (expand-user-path (cadr s)) (get-dir)))])])
+                       ;; Use filesystem-sensitive `simplify-path' here:
+                       (path-ss->rkt 
+                        (simplify-path (path->complete-path (expand-user-path (cadr s)) (get-dir))))])])
                 (unless (or (path? s-parsed)			  
                             (vector? s-parsed))
                   (if stx