summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-12-11 00:19:27 +0100
committerLudovic Courtès <ludo@gnu.org>2013-12-11 00:19:27 +0100
commit5c0f1845364fe8a5657a9e5a33090ea0ba781ea9 (patch)
tree179cfefd68b9b28267ecbcd29c72a6ca0e4eadd4
parentc61a5b4a6d9703c7a76bce0e22e8e0644126f86b (diff)
downloadguix-patches-5c0f1845364fe8a5657a9e5a33090ea0ba781ea9.tar
guix-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.scm22
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))))