From 4c9dcdc36dcd6883d1c5b9a33e7ec3e9d399412b Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 13 Aug 2009 21:09:15 +0000 Subject: [PATCH] moved some of the module language compiler setup code into the compiler/cm library so others can use it outside of DrScheme svn: r15730 --- collects/compiler/cm.ss | 51 +++++++++++++++++++- collects/drscheme/private/module-language.ss | 51 +------------------- collects/scribblings/mzc/make.scrbl | 7 +++ 3 files changed, 58 insertions(+), 51 deletions(-) diff --git a/collects/compiler/cm.ss b/collects/compiler/cm.ss index 278ba232c6..6830e72175 100644 --- a/collects/compiler/cm.ss +++ b/collects/compiler/cm.ss @@ -3,7 +3,8 @@ syntax/modresolve setup/main-collects scheme/file - scheme/list) + scheme/list + scheme/path) (provide make-compilation-manager-load/use-compiled-handler managed-compile-zo @@ -11,6 +12,7 @@ trust-existing-zos manager-compile-notify-handler manager-skip-file-handler + file-date-in-collection (rename-out [trace manager-trace-handler])) (define manager-compile-notify-handler (make-parameter void)) @@ -19,6 +21,53 @@ (define trust-existing-zos (make-parameter #f)) (define manager-skip-file-handler (make-parameter (λ (x) #f))) +(define (file-date-in-collection p) + (let ([p-eles (explode-path (simplify-path p))]) + (let c-loop ([collects-paths (current-library-collection-paths)]) + (cond + [(null? collects-paths) #f] + [else + (let i-loop ([collects-eles (explode-path (car collects-paths))] + [p-eles p-eles]) + (cond + [(null? collects-eles) + ;; we're inside the collection hierarchy, so we just + ;; use the date of the original file (or the zo, whichever + ;; is newer). + (let-values ([(base name dir) (split-path p)]) + (let* ([ext (filename-extension p)] + [pbytes (path->bytes name)] + [zo-file-name + (and ext + (bytes->path + (bytes-append + (subbytes + pbytes + 0 + (- (bytes-length pbytes) + (bytes-length ext))) + #"zo")))] + [zo-path (and zo-file-name + (build-path + base + (car (use-compiled-file-paths)) + zo-file-name))]) + (cond + [(and zo-file-name (file-exists? zo-path)) + (max (file-or-directory-modify-seconds p) + (file-or-directory-modify-seconds zo-file-name))] + [else + (file-or-directory-modify-seconds p)])))] + [(null? p-eles) + ;; this case shouldn't happen... I think. + (c-loop (cdr collects-paths))] + [else + (cond + [(equal? (car p-eles) (car collects-eles)) + (i-loop (cdr collects-eles) (cdr p-eles))] + [else + (c-loop (cdr collects-paths))])]))])))) + (define (trace-printf fmt . args) (let ([t (trace)]) (unless (eq? t void) diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss index a69f2e62c5..d3a14a1090 100644 --- a/collects/drscheme/private/module-language.ss +++ b/collects/drscheme/private/module-language.ss @@ -184,56 +184,7 @@ (use-compiled-file-paths)))])) (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)) - - (manager-skip-file-handler - (λ (p) - ;; iterate over all of the collection paths; if we find that this path is - ;; inside the collection hierarchy, we skip it. - (let ([p-eles (explode-path (simplify-path p))]) - (let c-loop ([collects-paths (current-library-collection-paths)]) - (cond - [(null? collects-paths) #f] - [else - (let i-loop ([collects-eles (explode-path (car collects-paths))] - [p-eles p-eles]) - (cond - [(null? collects-eles) - ;; we're inside the collection hierarchy, so we just - ;; use the date of the original file (or the zo, whichever - ;; is newer). - (let-values ([(base name dir) (split-path p)]) - (let* ([ext (filename-extension p)] - [pbytes (path->bytes name)] - [zo-file-name - (and ext - (bytes->path - (bytes-append - (subbytes - pbytes - 0 - (- (bytes-length pbytes) - (bytes-length ext))) - #"zo")))] - [zo-path (and zo-file-name - (build-path - base - (car (use-compiled-file-paths)) - zo-file-name))]) - (cond - [(and zo-file-name (file-exists? zo-path)) - (max (file-or-directory-modify-seconds p) - (file-or-directory-modify-seconds zo-file-name))] - [else - (file-or-directory-modify-seconds p)])))] - [(null? p-eles) - ;; this case shouldn't happen... I think. - (c-loop (cdr collects-paths))] - [else - (cond - [(equal? (car p-eles) (car collects-eles)) - (i-loop (cdr collects-eles) (cdr p-eles))] - [else - (c-loop (cdr collects-paths))])]))]))))))))) + (manager-skip-file-handler file-date-in-collection))))) (define/override (get-one-line-summary) (string-constant module-language-one-line-summary)) diff --git a/collects/scribblings/mzc/make.scrbl b/collects/scribblings/mzc/make.scrbl index 05601e8d77..4c46baa81c 100644 --- a/collects/scribblings/mzc/make.scrbl +++ b/collects/scribblings/mzc/make.scrbl @@ -250,6 +250,13 @@ A parameter whose value is called for each file that is loaded and @scheme[#f], then the file is compiled as usual. The default is @scheme[(lambda (x) #f)].} +@defproc[(file-date-in-collection [p path?]) (or/c number? #f)]{ + This is a function intended to be used with @scheme[manager-skip-file-handler]. + It returns the date of the @tt{.ss} or @tt{.zo} file (whichever is newer) + for any path that is inside the collection hierarchy and returns + @scheme[#f] for any other path. +} + @; ---------------------------------------------------------------------- @section{Compilation Manager Hook for Syntax Transformers}