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

shrink the dependencies from racket/runtime-path (remove mzscheme

Browse Source 
and pull out the one things from mzlib/etc that it uses into a separate,
private file)
This commit is contained in:
Robby Findler 2012-06-10 13:50:15 -05:00
parent e9ddc54b18
commit b0607f04a9
4 changed files with 58 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/mzlib/etc.rkt
View File

@ -10,6 +10,7 @@
build-list
build-vector
compose)
"private/this-expression-source-directory.rkt"
(rename racket/base base-else else))
(require-for-syntax syntax/name
@ -240,50 +241,6 @@
(not (eq? (namespace-variable-value n #t (lambda () ns-undefined))
ns-undefined)))
(define (extract-module-directory stx)
(let ([srcmod (let ([mpi (syntax-source-module stx)])
(if (module-path-index? mpi)
(module-path-index-resolve mpi)
mpi))])
(let* ([name (resolved-module-path-name srcmod)]
[name (if (pair? name) (car name) name)])
(and (path? name)
(let-values ([(base name dir?) (split-path name)])
(and (path? base)
base))))))
(define-syntax (this-expression-source-directory stx)
(syntax-case stx ()
[(_ 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 ()
[(_ sub)

10
collects/mzlib/private/runtime-path-table.rkt
View File

@ -1,5 +1,5 @@
(module runtime-path-table mzscheme
(provide table)
(define table #f)
;; So table definition is not inlined across modules:
(set! table #f))
#lang racket/base
(provide table)
(define table #f)
;; So table definition is not inlined across modules:
(set! table #f)

49
collects/mzlib/private/this-expression-source-directory.rkt Normal file
View File

@ -0,0 +1,49 @@
#lang racket/base
(require (for-syntax racket/base
setup/main-collects)
setup/main-collects)
(provide this-expression-source-directory)
(define-syntax (this-expression-source-directory stx)
(syntax-case stx ()
[(_ 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
stx
'context
stx
stx)))
#,source-path))
source-path))))]
[(_) #`(this-expression-source-directory #,stx)]))
(define (extract-module-directory stx)
(let ([srcmod (let ([mpi (syntax-source-module stx)])
(if (module-path-index? mpi)
(module-path-index-resolve mpi)
mpi))])
(let* ([name (resolved-module-path-name srcmod)]
[name (if (pair? name) (car name) name)])
(and (path? name)
(let-values ([(base name dir?) (split-path name)])
(and (path? base)
base))))))

6
collects/mzlib/runtime-path.rkt
View File

@ -1,7 +1,7 @@
(module runtime-path racket/base
(require mzlib/etc
setup/dirs
(require "private/this-expression-source-directory.rkt"
racket/list
setup/dirs
(only-in "private/runtime-path-table.rkt" table)
(for-syntax racket/base))
@ -72,7 +72,7 @@
((length p) . > . 1)
(eq? 'lib (car p))
(andmap string? (cdr p)))
(let* ([strs (regexp-split #rx"/"
(let* ([strs (regexp-split #rx"/"
(let ([s (cadr p)])
(if (regexp-match? #rx"[./]" s)
s