From 9d9f06a16719684fdc2126cbe0677d704ff8ed63 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 12 Nov 2008 14:43:26 +0000 Subject: [PATCH] svn: r12408 --- collects/drscheme/private/zo-cache.ss | 72 --------------------------- 1 file changed, 72 deletions(-) delete mode 100644 collects/drscheme/private/zo-cache.ss diff --git a/collects/drscheme/private/zo-cache.ss b/collects/drscheme/private/zo-cache.ss deleted file mode 100644 index 72567d92fe..0000000000 --- a/collects/drscheme/private/zo-cache.ss +++ /dev/null @@ -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))))) -