diff --git a/collects/mzlib/etc.ss b/collects/mzlib/etc.ss index c05767de7c..9125609b89 100644 --- a/collects/mzlib/etc.ss +++ b/collects/mzlib/etc.ss @@ -262,39 +262,47 @@ (define-syntax (this-expression-source-directory stx) (syntax-case stx () - [(_) - (let ([source-path - (let* ([source (syntax-source stx)] - [source (and (path? source) source)] - [local (or (current-load-relative-directory) (current-directory))] - [dir (path->main-collects-relative - (or (and source (file-exists? source) - (let-values ([(base file dir?) - (split-path source)]) - (and (path? base) - (path->complete-path base local)))) - local))]) - (if (and (pair? dir) (eq? 'collects (car dir))) - (with-syntax ([d dir]) - (syntax/loc stx (main-collects-relative->path 'd))) - (with-syntax ([d (if (bytes? dir) dir (path->bytes dir))]) - (syntax/loc stx (bytes->path d)))))]) - (let ([mpi (syntax-source-module stx)]) - (if mpi - (quasisyntax/loc stx - (or (extract-module-directory (quote-syntax #,stx)) - #,source-path)) - source-path)))])) + [(_ sub) + (let ([stx (syntax sub)]) + (let ([source-path + (let* ([source (syntax-source stx)] + [source (and (path? source) source)] + [local (or (current-load-relative-directory) (current-directory))] + [dir (path->main-collects-relative + (or (and source (file-exists? source) + (let-values ([(base file dir?) + (split-path source)]) + (and (path? base) + (path->complete-path base local)))) + local))]) + (if (and (pair? dir) (eq? 'collects (car dir))) + (with-syntax ([d dir]) + (syntax/loc stx (main-collects-relative->path 'd))) + (with-syntax ([d (if (bytes? dir) dir (path->bytes dir))]) + (syntax/loc stx (bytes->path d)))))]) + (let ([mpi (syntax-source-module stx)]) + (if mpi + (quasisyntax/loc stx + (or (extract-module-directory (quote-syntax #,(datum->syntax-object + stx + 'context + stx + stx))) + #,source-path)) + source-path))))] + [(_) #`(this-expression-source-directory #,stx)])) (define-syntax (this-expression-file-name stx) (syntax-case stx () - [(_) - (let* ([f (syntax-source stx)] - [f (and f (path? f) (file-exists? f) - (let-values ([(base file dir?) (split-path f)]) file))]) - (if f - (with-syntax ([f (path->bytes f)]) #'(bytes->path f)) - #'#f))])) + [(_ sub) + (let ([stx #'sub]) + (let* ([f (syntax-source stx)] + [f (and f (path? f) (file-exists? f) + (let-values ([(base file dir?) (split-path f)]) file))]) + (if f + (with-syntax ([f (path->bytes f)]) #'(bytes->path f)) + #'#f)))] + [(_) #`(this-expression-file-name #,stx)])) ;; This is a macro-generating macro that wants to expand ;; expressions used in the generated macro. So it's weird, diff --git a/collects/mzlib/scribblings/etc.scrbl b/collects/mzlib/scribblings/etc.scrbl index 2ddf335c74..b272298a0c 100644 --- a/collects/mzlib/scribblings/etc.scrbl +++ b/collects/mzlib/scribblings/etc.scrbl @@ -227,45 +227,48 @@ Equivalent, respectively, to ]} -@deftogether[( -@defform[(this-expression-source-directory)] -@defform[(this-expression-file-name)] -)]{ +@defform*[[(this-expression-source-directory) + (this-expression-source-directory datum)]]{ @margin-note{See @schememodname[scheme/runtime-path] for a definition form that works better when creating executables.} -Expands to an expression that evaluates to the name of the directory -of the file containing the source expression, or the name of the file -containing the source expression. +Expands to an expression that evaluates to the directory of the file +containing the source @scheme[datum]. If @scheme[datum] is not +supplied, then the entire @scheme[(this-expression-source-directory)] +expression is used as @scheme[datum]. -If the expression has a source module, then the expansion attempts to +If @scheme[datum] has a source module, then the expansion attempts to determine the module's run-time location. This location is determined -by preserving the original expression as a syntax object, extracting -its source module path at run time, and then resolving the module -path. +by preserving the lexical context of @scheme[datum] in a syntax +object, extracting its source module path at run time, and then +resolving the module path. -Otherwise, the source expression's file is determined through source -location information associated with the syntax, if it is present. If -the expression has no source, or if no directory can be determined at -run time, the expansion falls back to using source-location -information associated with the expression. +Otherwise, @scheme[datum]'s source file is determined through source +location information associated with @scheme[datum], if it is +present. As a last resort, @scheme[current-load-relative-directory] is +used if it is not @scheme[#f], and @scheme[current-directory] is used +if all else fails. -As a last resort, @scheme[#f] is used for the file name; for the -directory name, @scheme[current-load-relative-directory] is used if it -is not @scheme[#f], and @scheme[current-directory] is used if all else -fails. +A directory path derived from source location is always stored in +bytes in the expanded code, unless the file is within the result of +@scheme[find-collects-dir], in which case the expansion records the +path relative to @scheme[(find-collects-dir)] and then reconstructs it +using @scheme[(find-collects-dir)] at run time.} -A directory path is stored in bytes in the expanded code, unless the -file is within the result of @scheme[find-collects-dir], in which case -the expansion records the path relative to -@scheme[(find-collects-dir)] and then reconstructs it using -@scheme[(find-collects-dir)] at run time.} + +@defform*[[(this-expression-file-name) + (this-expression-file-name datum)]]{ + +Similar to @scheme[this-expression-source-directory], except that only +source information associated with @scheme[datum] or +@scheme[(this-expression-file-name)] is used to extract a filename. If +no filename is available, the result is @scheme[#f].} @defform[#:literals (quote unsyntax scheme) (hash-table (#,(scheme quote) flag) ... (key-expr val-expr) ...)]{ Creates a new hash-table providing the quoted flags (if any) to -@scheme[make-hash-table], and them mapping each key to the +@scheme[make-hash-table], and then mapping each key to the corresponding values.} diff --git a/collects/mzlib/scribblings/mzlib.scrbl b/collects/mzlib/scribblings/mzlib.scrbl index 832ab72110..f3dd027df9 100644 --- a/collects/mzlib/scribblings/mzlib.scrbl +++ b/collects/mzlib/scribblings/mzlib.scrbl @@ -316,3 +316,7 @@ Re-exports @schememodname[file/zip]. #:date "1999") ) + +@;------------------------------------------------------------------------ + +@index-section[]