svn: r12408

collects/drscheme/private/zo-cache.ss

@@ -1,72 +0,0 @@
-#lang scheme/base
-(require scheme/path
-         scheme/file
-         compiler/cm)
-
-#|
-
-All of this code runs on the user's parameterization/thread
-
-|#
-
-(provide build-and-load-zo-file)
-
-(define (build-and-load-zo-file original-load/use-compiled-handler path mod)
-  (cond
-    [(or (not (filename-extension path))
-         (already-a-compiled-file? path))
-     ;; if there is no extension, just give up.
-     ;; if there is a compiled file that look up to date
-     ;;    in the usual place, use it.
-     (original-load/use-compiled-handler path mod)]
-    [else
-     ;; otherwise do some managed compilation
-     (parameterize ([manager-skip-file-handler (λ (x)
-                                                 (printf "considering ~s\n" x)
-                                                 #f)])
-       (managed-compile-zo path))
-     (original-load/use-compiled-handler path mod)]))
-
-(define (exists-and-is-newer? orig-path candidate-path)
-  (and (file-exists? candidate-path)
-       (< (file-or-directory-modify-seconds orig-path)
-          (file-or-directory-modify-seconds candidate-path))))
-
-(define (already-a-compiled-file? path) 
-  (let* ([filename (file-name-from-path path)]
-         [base (path-only path)]
-         [file-zo-name (and filename (compiled-name filename #".zo"))]
-         [fm (file-or-directory-modify-seconds path)]
-         [newer-exists?
-          (λ (pot-path)
-            (and (file-exists? pot-path)
-                 (< fm (file-or-directory-modify-seconds pot-path))))])
-    (and file-zo-name
-         (ormap 
-          (λ (c-f-p)
-            (or (newer-exists? (build-path base c-f-p file-zo-name))
-                (newer-exists? (build-path base 
-                                           c-f-p 
-                                           "native"
-                                           (system-library-subpath)
-                                           (compiled-name filename (system-type 'so-suffix))))))
-          (use-compiled-file-paths)))))
-
-
-;; compiled-name : path [bytes] -> path or #f
-;; returns #f if the path does not have an extension.
-;; otherwise, returns an appropriately modified filename, extended with new-extension
-(define (compiled-name path new-extension)
-  (let* ([extension (filename-extension path)]
-         [basename (and extension
-                        (let ([pbs (path->bytes path)])
-                          (subbytes pbs
-                                    0 
-                                    (- (bytes-length pbs)
-                                       (bytes-length extension)
-                                       1 ;; extra one for '.' in there
-                                       ))))])
-    (and basename
-         (bytes->path
-          (bytes-append basename #"_" extension new-extension)))))
-