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

Split a helper function out from get-module-code in syntax/modcode.

Browse Source 
The get-module-path function finds the compiled or source file corresponding
to a module; get-module-code reads and compiles the contents of this file.
This commit is contained in:
Carl Eastlund 2013-06-09 21:58:26 -04:00
parent 85fc035f75
commit d7ebc497ba
1 changed files with 69 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

135
collects/syntax/modcode.rkt
View File

@ -82,19 +82,13 @@
[(relative-path? root) (build-path base root)]
[else (reroot-path base root)]))
(define (get-module-code
(define (get-module-path
path0
#:roots [roots (current-compiled-file-roots)]
#:submodule-path [submodule-path '()]
#:submodule? [submodule? #f]
#:sub-path [sub-path/kw "compiled"]
[sub-path sub-path/kw]
#:compile [compile/kw compile]
[compiler compile/kw]
#:extension-handler [ext-handler/kw #f]
[ext-handler ext-handler/kw]
#:choose [choose (lambda (src zo so) #f)]
#:notify [notify void]
#:source-reader [read-src-syntax read-syntax]
#:rkt-try-ss? [rkt-try-ss? #t])
(define resolved-path (resolve path0))
(define-values (path0-rel path0-file path0-dir?) (split-path path0))
@ -156,11 +150,67 @@
(path-add-suffix alt-src-file #".zo"))))
(define so (get-so src-file))
(define alt-so (and try-alt? (get-so alt-src-file)))
(define (with-dir t)
(parameterize ([current-load-relative-directory
(if (path? path0-base) path0-base (current-directory))])
(t)))
(define prefer (choose src-path zo so))
(cond
;; Use .zo, if it's new enough
[(or (eq? prefer 'zo)
(and (not prefer)
(pair? roots)
(or (date>=? zo src-date)
(and try-alt?
(date>=? alt-zo src-date)))))
(let ([zo (if (date>=? zo src-date)
zo
(if (and try-alt? (date>=? alt-zo src-date))
alt-zo
zo))])
(values zo 'zo))]
;; Maybe there's an .so? Use it only if we don't prefer source
;; and only if there's no submodule path.
[(and (not submodule?)
(or (eq? prefer 'so)
(and (not prefer)
(pair? roots)
(or (date>=? so src-date)
(and try-alt?
(date>=? alt-so src-date))))))
(let ([so (if (date>=? so src-date)
so
(if (and try-alt? (date>=? alt-so src-date))
alt-so
so))])
(values so 'so))]
;; Use source if it exists
[(or (eq? prefer 'src) src-date)
(values src-path 'src)]
;; Report a not-there error
[else (raise (make-exn:get-module-code
(format "get-module-code: no such file: ~e" resolved-path)
(current-continuation-marks)
#f))]))
(define (get-module-code
path0
#:roots [roots (current-compiled-file-roots)]
#:submodule-path [submodule-path '()]
#:sub-path [sub-path/kw "compiled"]
[sub-path sub-path/kw]
#:compile [compile/kw compile]
[compiler compile/kw]
#:extension-handler [ext-handler/kw #f]
[ext-handler ext-handler/kw]
#:choose [choose (lambda (src zo so) #f)]
#:notify [notify void]
#:source-reader [read-src-syntax read-syntax]
#:rkt-try-ss? [rkt-try-ss? #t])
(define-values (path type)
(get-module-path
path0
#:roots roots
#:submodule? (pair? submodule-path)
#:sub-path sub-path
#:choose choose
#:rkt-try-ss? rkt-try-ss?))
(define (extract-submodule m [sm-path submodule-path])
(cond
[(null? sm-path) m]
@ -176,57 +226,28 @@
(current-continuation-marks)
#f)))
(cdr sm-path))]))
(cond
;; Use .zo, if it's new enough
[(or (eq? prefer 'zo)
(and (not prefer)
(pair? roots)
(or (date>=? zo src-date)
(and try-alt?
(date>=? alt-zo src-date)))))
(let ([zo (if (date>=? zo src-date)
zo
(if (and try-alt? (date>=? alt-zo src-date))
alt-zo
zo))])
(notify zo)
(extract-submodule (read-one src-path zo #f read-syntax)))]
;; Maybe there's an .so? Use it only if we don't prefer source
;; and only if there's no submodule path.
[(and (null? submodule-path)
(or (eq? prefer 'so)
(and (not prefer)
(pair? roots)
(or (date>=? so src-date)
(and try-alt?
(date>=? alt-so src-date))))))
(let ([so (if (date>=? so src-date)
so
(if (and try-alt? (date>=? alt-so src-date))
alt-so
so))])
(case type
[(zo)
(notify path)
(extract-submodule (read-one path0 path #f read-syntax))]
[(so)
(if ext-handler
(begin
(notify so)
(ext-handler so #f))
(notify path)
(ext-handler path #f))
(raise (make-exn:get-module-code
(format "get-module-code: cannot use extension file; ~e" so)
(format "get-module-code: cannot use extension file; ~e" path)
(current-continuation-marks)
so))))]
;; Use source if it exists
[(or (eq? prefer 'src) src-date)
(notify src-path)
path)))]
[(src)
(notify path)
(define (compile-one)
(with-dir
(lambda ()
(compiler (read-one resolved-path src-path #t read-src-syntax)))))
(define-values (path0-base path0-name path0-dir?) (split-path path0))
(parameterize ([current-load-relative-directory
(if (path? path0-base) path0-base (current-directory))])
(compiler (read-one path0 path #t read-src-syntax))))
(if (null? submodule-path)
;; allow any result:
(compile-one)
;; expect a compiled-module result:
(extract-submodule (compile-one)))]
;; Report a not-there error
[else (raise (make-exn:get-module-code
(format "get-module-code: no such file: ~e" resolved-path)
(current-continuation-marks)
#f))]))
(extract-submodule (compile-one)))]))