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

@@ -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)

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 file-date-in-collection)))))
-             (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))])]))])))))))))
       
       (define/override (get-one-line-summary)
         (string-constant module-language-one-line-summary))

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}