diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-12-11 00:19:27 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-12-11 00:19:27 +0100 |
commit | 5c0f1845364fe8a5657a9e5a33090ea0ba781ea9 (patch) | |
tree | 179cfefd68b9b28267ecbcd29c72a6ca0e4eadd4 | |
parent | c61a5b4a6d9703c7a76bce0e22e8e0644126f86b (diff) | |
download | patches-5c0f1845364fe8a5657a9e5a33090ea0ba781ea9.tar patches-5c0f1845364fe8a5657a9e5a33090ea0ba781ea9.tar.gz |
store: Optimize 'store-path-package-name' and 'store-path-hash-part'.
* guix/store.scm (store-regexp*): New procedure.
(store-path-package-name, store-path-hash-part): Use it.
-rw-r--r-- | guix/store.scm | 22 |
1 files changed, 13 insertions, 9 deletions
diff --git a/guix/store.scm b/guix/store.scm index 2821cacdcc..08b0671b29 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -653,21 +653,25 @@ valid inputs." "Return #t if PATH is a derivation path." (and (store-path? path) (string-suffix? ".drv" path))) +(define store-regexp* + ;; The substituter makes repeated calls to 'store-path-hash-part', hence + ;; this optimization. + (memoize + (lambda (store) + "Return a regexp matching a file in STORE." + (make-regexp (string-append "^" (regexp-quote store) + "/([0-9a-df-np-sv-z]{32})-([^/]+)$"))))) + (define (store-path-package-name path) "Return the package name part of PATH, a file name in the store." - (define store-path-rx - (make-regexp (string-append "^.*" (regexp-quote (%store-prefix)) - "/[^-]+-(.+)$"))) - - (and=> (regexp-exec store-path-rx path) - (cut match:substring <> 1))) + (let ((path-rx (store-regexp* (%store-prefix)))) + (and=> (regexp-exec path-rx path) + (cut match:substring <> 2)))) (define (store-path-hash-part path) "Return the hash part of PATH as a base32 string, or #f if PATH is not a syntactically valid store path." - (let ((path-rx (make-regexp - (string-append"^" (regexp-quote (%store-prefix)) - "/([0-9a-df-np-sv-z]{32})-[^/]+$")))) + (let ((path-rx (store-regexp* (%store-prefix)))) (and=> (regexp-exec path-rx path) (cut match:substring <> 1)))) |