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

generalize this-expression-source-directory

Browse Source 
svn: r9176
This commit is contained in:
Matthew Flatt 2008-04-07 12:52:59 +00:00
parent 564248acdb
commit f31bf12543
3 changed files with 71 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
collects/mzlib/etc.ss
View File

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

55
collects/mzlib/scribblings/etc.scrbl
View File

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

4
collects/mzlib/scribblings/mzlib.scrbl
View File

@ -316,3 +316,7 @@ Re-exports @schememodname[file/zip].
#:date "1999")
)
@;------------------------------------------------------------------------
@index-section[]