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

35
collects/mzlib/etc.ss
View File

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