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

pkg/path: improve use of cache in `path->pkg'

Browse Source 
Cache exploded package paths, which cuts about half
(more than a second) of the start-up time for
`raco setup' on my machine.
This commit is contained in:
Matthew Flatt 2013-08-13 19:59:25 -06:00
parent 4efdfd6aa9
commit d586ea4e99
2 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
racket/collects/pkg/path.rkt
View File

@ -121,8 +121,14 @@
(if (and (pair? orig)
(or (eq? 'link (car orig))
(eq? 'static-link (car orig))))
(let ([orig-pkg-dir (simplify-path (path->complete-path (cadr orig) pkgs-dir) #f)])
(define e (explode orig-pkg-dir))
(let ([e (or (and cache
(hash-ref cache `(pkg-dir ,(cadr orig)) #f))
(let ([e (explode (simplify-path
(path->complete-path (cadr orig) pkgs-dir)
#f))])
(when cache
(hash-set! cache `(pkg-dir ,(cadr orig)) e))
e))])
(if (sub-path? <= p e)
(values k
(build-path* (list-tail p (length e)))

17
racket/collects/setup/path-relativize.rkt
View File

@ -19,16 +19,11 @@
;; We need to compare paths to find when something is in the racket
;; tree, so we explode the paths. This is slower than the old way
;; (by a factor of 2 or so), but it's simpler and more portable.
(define (explode-path path)
(let loop ([path (simplify-path (path->complete-path path))]
[rest null])
(let-values ([(base name dir?) (split-path path)])
(if (path? base)
(loop base (cons name rest))
(cons name rest)))))
(define (explode-path* path)
(explode-path (simplify-path (path->complete-path path))))
(define exploded-root
(delay (cond [(find-root-dir) => explode-path] [else #f])))
(delay (cond [(find-root-dir) => explode-path*] [else #f])))
;; path->relative : path-or-bytes -> datum-containing-bytes-or-path
(define (path->relative path0)
@ -37,9 +32,11 @@
[(path-string? path0) path0]
[else (raise-type-error to-rel-name "path, string, or bytes"
path0)]))
(let loop ([path (explode-path path1)] [root (force exploded-root)])
(let loop ([path (explode-path* path1)] [root (force exploded-root)])
(cond [(not root) path0]
[(null? root) (cons tag (map (lambda (pe) (datum-intern-literal (path-element->bytes pe)))
[(null? root) (cons tag (map (lambda (pe)
(datum-intern-literal
(path-element->bytes pe)))
path))]
;; Note: in some cases this returns the input path as is, which
;; could be a byte string -- it should be possible to return