suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

moved some of the module language compiler setup code into the compiler/cm library so others can use it outside of DrScheme

Browse Source 
svn: r15730
This commit is contained in:
Robby Findler 2009-08-13 21:09:15 +00:00
parent adbec1785e
commit 4c9dcdc36d
3 changed files with 58 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
collects/compiler/cm.ss
View File

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

51
collects/drscheme/private/module-language.ss
View File

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

7
collects/scribblings/mzc/make.scrbl
View File

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