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

Made `this-expression-source-directory' use setup/plthome if the current path

Browse Source 
is in the plthome tree, so that generated syntax doesn't hard-wire a plthome
location.  The resulting syntax will use `un-plthome-ify' in this case.

original commit: 127a796f8b6f589987f435a5cdba07b7d9551846
This commit is contained in:
Eli Barzilay 2003-11-29 04:01:29 +00:00
parent d034e63d73
commit 98ae6cb185
1 changed files with 20 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/mzlib/etc.ss
View File

@ -1,10 +1,12 @@
(module etc mzscheme
(require "spidey.ss")
(require "spidey.ss"
(lib "plthome.ss" "setup"))
(require-for-syntax (lib "kerncase.ss" "syntax")
(lib "stx.ss" "syntax")
(lib "name.ss" "syntax")
(lib "context.ss" "syntax")
(lib "plthome.ss" "setup")
"private/stxset.ss")
(provide true false
@ -438,28 +440,23 @@
(define-syntax (this-expression-source-directory stx)
(syntax-case stx ()
[(_)
(let ([source (syntax-source stx)]
[local (lambda ()
(let ([s (or (current-load-relative-directory)
(current-directory))])
(datum->syntax-object
(quote-syntax 'here)
s
stx)))])
(if (and source
(string? source)
(file-exists? source))
(let-values ([(base file dir?) (split-path source)])
(cond
[(string? base)
(with-syntax ([base (path->complete-path
base
(or (current-load-relative-directory)
(current-directory)))])
(syntax base))]
[else ; must be (eq? base 'relative)
(local)]))
(local)))]))
(let* ([source (syntax-source stx)]
[local (lambda ()
(or (current-load-relative-directory)
(current-directory)))]
[dir (plthome-ify
(or (and source (string? source) (file-exists? source)
(let-values ([(base file dir?) (split-path source)])
(and (string? base)
(path->complete-path
base
(or (current-load-relative-directory)
(current-directory))))))
(local)))])
(if (and (pair? dir) (eq? 'plthome (car dir)))
(with-syntax ([d dir])
(syntax (un-plthome-ify 'd)))
(datum->syntax-object (quote-syntax here) dir stx)))]))
;; This is a macro-generating macro that wants to expand
;; expressions used in the generated macro. So it's weird,