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.master
parent
c61a5b4a6d
commit
5c0f184536
|
@ -653,21 +653,25 @@ valid inputs."
|
||||||
"Return #t if PATH is a derivation path."
|
"Return #t if PATH is a derivation path."
|
||||||
(and (store-path? path) (string-suffix? ".drv" 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)
|
(define (store-path-package-name path)
|
||||||
"Return the package name part of PATH, a file name in the store."
|
"Return the package name part of PATH, a file name in the store."
|
||||||
(define store-path-rx
|
(let ((path-rx (store-regexp* (%store-prefix))))
|
||||||
(make-regexp (string-append "^.*" (regexp-quote (%store-prefix))
|
(and=> (regexp-exec path-rx path)
|
||||||
"/[^-]+-(.+)$")))
|
(cut match:substring <> 2))))
|
||||||
|
|
||||||
(and=> (regexp-exec store-path-rx path)
|
|
||||||
(cut match:substring <> 1)))
|
|
||||||
|
|
||||||
(define (store-path-hash-part path)
|
(define (store-path-hash-part path)
|
||||||
"Return the hash part of PATH as a base32 string, or #f if PATH is not a
|
"Return the hash part of PATH as a base32 string, or #f if PATH is not a
|
||||||
syntactically valid store path."
|
syntactically valid store path."
|
||||||
(let ((path-rx (make-regexp
|
(let ((path-rx (store-regexp* (%store-prefix))))
|
||||||
(string-append"^" (regexp-quote (%store-prefix))
|
|
||||||
"/([0-9a-df-np-sv-z]{32})-[^/]+$"))))
|
|
||||||
(and=> (regexp-exec path-rx path)
|
(and=> (regexp-exec path-rx path)
|
||||||
(cut match:substring <> 1))))
|
(cut match:substring <> 1))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue