summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-01-28 17:09:34 +0100
committerLudovic Courtès <ludo@gnu.org>2017-01-28 18:55:20 +0100
commit55b2d921456e888f097bf4e43a3d25b112f3e563 (patch)
tree5e2e834a2aa37f50dd27a33ae38a2f82c30091a7
parentf9704f179a5160013c4a401dce3761714bba8e72 (diff)
downloadguix-55b2d921456e888f097bf4e43a3d25b112f3e563.tar.gz
Use 'mlambda' instead of 'memoize'.
* gnu/packages.scm (find-newest-available-packages): Use 'mlambda'
instead of (memoize (lambda ...) ...).
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Likewise.
* guix/build-system/gnu.scm (package-with-explicit-inputs)[rewritten-input]:
Likewise.
* guix/build-system/python.scm (package-with-explicit-python)[transform]:
Likewise.
* guix/derivations.scm (derivation->string): Likewise.
* guix/gnu-maintenance.scm (gnu-package?): Likewise.
* guix/modules.scm (module-file-dependencies): Likewise.
* guix/scripts/graph.scm (standard-package-set): Likewise.
* guix/scripts/lint.scm (official-gnu-packages*): Likewise.
* guix/store.scm (store-regexp*): Likewise.
* guix/utils.scm (location): Likewise.
-rw-r--r--gnu/packages.scm31
-rw-r--r--gnu/packages/bootstrap.scm35
-rw-r--r--guix/build-system/gnu.scm47
-rw-r--r--guix/build-system/python.scm85
-rw-r--r--guix/derivations.scm88
-rw-r--r--guix/gnu-maintenance.scm83
-rw-r--r--guix/modules.scm21
-rw-r--r--guix/scripts/graph.scm11
-rw-r--r--guix/scripts/lint.scm9
-rw-r--r--guix/store.scm9
-rw-r--r--guix/utils.scm9
11 files changed, 208 insertions, 220 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm
index ec2473422f..0aa289d56c 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -235,28 +235,27 @@ decreasing version order."
             matching)))))
 
 (define find-newest-available-packages
-  (memoize
-   (lambda ()
-     "Return a vhash keyed by package names, and with
+  (mlambda ()
+    "Return a vhash keyed by package names, and with
 associated values of the form
 
   (newest-version newest-package ...)
 
 where the preferred package is listed first."
 
-     ;; FIXME: Currently, the preferred package is whichever one
-     ;; was found last by 'fold-packages'.  Find a better solution.
-     (fold-packages (lambda (p r)
-                      (let ((name    (package-name p))
-                            (version (package-version p)))
-                        (match (vhash-assoc name r)
-                          ((_ newest-so-far . pkgs)
-                           (case (version-compare version newest-so-far)
-                             ((>) (vhash-cons name `(,version ,p) r))
-                             ((=) (vhash-cons name `(,version ,p ,@pkgs) r))
-                             ((<) r)))
-                          (#f (vhash-cons name `(,version ,p) r)))))
-                    vlist-null))))
+    ;; FIXME: Currently, the preferred package is whichever one
+    ;; was found last by 'fold-packages'.  Find a better solution.
+    (fold-packages (lambda (p r)
+                     (let ((name    (package-name p))
+                           (version (package-version p)))
+                       (match (vhash-assoc name r)
+                         ((_ newest-so-far . pkgs)
+                          (case (version-compare version newest-so-far)
+                            ((>) (vhash-cons name `(,version ,p) r))
+                            ((=) (vhash-cons name `(,version ,p ,@pkgs) r))
+                            ((<) r)))
+                         (#f (vhash-cons name `(,version ,p) r)))))
+                   vlist-null)))
 
 (define (find-best-packages-by-name name version)
   "If version is #f, return the list of packages named NAME with the highest
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index 7cde51fff8..c8d94c8303 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -131,30 +131,29 @@ successful, or false to signal an error."
     (license gpl3+)))
 
 (define package-with-bootstrap-guile
-  (memoize
-   (lambda (p)
+  (mlambda (p)
     "Return a variant of P such that all its origins are fetched with
 %BOOTSTRAP-GUILE."
     (define rewritten-input
       (match-lambda
-       ((name (? origin? o))
-        `(,name ,(bootstrap-origin o)))
-       ((name (? package? p) sub-drvs ...)
-        `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
-       (x x)))
+        ((name (? origin? o))
+         `(,name ,(bootstrap-origin o)))
+        ((name (? package? p) sub-drvs ...)
+         `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
+        (x x)))
 
     (package (inherit p)
-      (source (match (package-source p)
-                ((? origin? o) (bootstrap-origin o))
-                (s s)))
-      (inputs (map rewritten-input
-                   (package-inputs p)))
-      (native-inputs (map rewritten-input
-                          (package-native-inputs p)))
-      (propagated-inputs (map rewritten-input
-                              (package-propagated-inputs p)))
-      (replacement (and=> (package-replacement p)
-                          package-with-bootstrap-guile))))))
+             (source (match (package-source p)
+                       ((? origin? o) (bootstrap-origin o))
+                       (s s)))
+             (inputs (map rewritten-input
+                          (package-inputs p)))
+             (native-inputs (map rewritten-input
+                                 (package-native-inputs p)))
+             (propagated-inputs (map rewritten-input
+                                     (package-propagated-inputs p)))
+             (replacement (and=> (package-replacement p)
+                                 package-with-bootstrap-guile)))))
 
 (define* (glibc-dynamic-linker
           #:optional (system (or (and=> (%current-target-system)
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index f05ddf91f5..730e638c89 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -84,15 +84,15 @@ builder, or the distro's final Guile when GUILE is #f."
 
   (let loop ((p p))
     (define rewritten-input
-      (memoize
-       (match-lambda
-        ((name (? package? p) sub-drv ...)
-         ;; XXX: Check whether P's build system knows #:implicit-inputs, for
-         ;; things like `cross-pkg-config'.
-         (if (eq? (package-build-system p) gnu-build-system)
-             (cons* name (loop p) sub-drv)
-             (cons* name p sub-drv)))
-        (x x))))
+      (mlambda (input)
+        (match input
+          ((name (? package? p) sub-drv ...)
+           ;; XXX: Check whether P's build system knows #:implicit-inputs, for
+           ;; things like `cross-pkg-config'.
+           (if (eq? (package-build-system p) gnu-build-system)
+               (cons* name (loop p) sub-drv)
+               (cons* name p sub-drv)))
+          (x x))))
 
     (package (inherit p)
       (location (if (pair? loc) (source-properties->location loc) loc))
@@ -393,22 +393,21 @@ packages that must not be referenced."
 ;;;
 
 (define standard-cross-packages
-  (memoize
-   (lambda (target kind)
-     "Return the list of name/package tuples to cross-build for TARGET.  KIND
+  (mlambda (target kind)
+    "Return the list of name/package tuples to cross-build for TARGET.  KIND
 is one of `host' or `target'."
-     (let* ((cross     (resolve-interface '(gnu packages cross-base)))
-            (gcc       (module-ref cross 'cross-gcc))
-            (binutils  (module-ref cross 'cross-binutils))
-            (libc      (module-ref cross 'cross-libc)))
-       (case kind
-         ((host)
-          `(("cross-gcc" ,(gcc target
-                               (binutils target)
-                               (libc target)))
-            ("cross-binutils" ,(binutils target))))
-         ((target)
-          `(("cross-libc" ,(libc target)))))))))
+    (let* ((cross     (resolve-interface '(gnu packages cross-base)))
+           (gcc       (module-ref cross 'cross-gcc))
+           (binutils  (module-ref cross 'cross-binutils))
+           (libc      (module-ref cross 'cross-libc)))
+      (case kind
+        ((host)
+         `(("cross-gcc" ,(gcc target
+                              (binutils target)
+                              (libc target)))
+           ("cross-binutils" ,(binutils target))))
+        ((target)
+         `(("cross-libc" ,(libc target))))))))
 
 (define* (gnu-cross-build store name
                           #:key
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index bfe0eca9f6..383e8cb64a 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -87,49 +87,48 @@ pre-defined variants."
     ;; Memoize the transformations.  Failing to do that, we would build a huge
     ;; object graph with lots of duplicates, which in turns prevents us from
     ;; benefiting from memoization in 'package-derivation'.
-    (memoize                                      ;FIXME: use 'eq?'
-     (lambda (p)
-       (let* ((rewrite-if-package
-               (lambda (content)
-                 ;; CONTENT may be a file name, in which case it is returned,
-                 ;; or a package, which is rewritten with the new PYTHON and
-                 ;; NEW-PREFIX.
-                 (if (package? content)
-                     (transform content)
-                     content)))
-              (rewrite
-               (match-lambda
-                 ((name content . rest)
-                  (append (list name (rewrite-if-package content)) rest)))))
-
-         (cond
-          ;; If VARIANT-PROPERTY is present, use that.
-          ((and variant-property
-                (assoc-ref (package-properties p) variant-property))
-           => force)
-
-          ;; Otherwise build the new package object graph.
-          ((eq? (package-build-system p) python-build-system)
-           (package
-             (inherit p)
-             (location (package-location p))
-             (name (let ((name (package-name p)))
-                     (string-append new-prefix
-                                    (if (string-prefix? old-prefix name)
-                                        (substring name
-                                                   (string-length old-prefix))
-                                        name))))
-             (arguments
-              (let ((python (if (promise? python)
-                                (force python)
-                                python)))
-                (ensure-keyword-arguments (package-arguments p)
-                                          `(#:python ,python))))
-             (inputs (map rewrite (package-inputs p)))
-             (propagated-inputs (map rewrite (package-propagated-inputs p)))
-             (native-inputs (map rewrite (package-native-inputs p)))))
-          (else
-           p))))))
+    (mlambda (p)                                  ;XXX: use 'eq?'
+      (let* ((rewrite-if-package
+              (lambda (content)
+                ;; CONTENT may be a file name, in which case it is returned,
+                ;; or a package, which is rewritten with the new PYTHON and
+                ;; NEW-PREFIX.
+                (if (package? content)
+                    (transform content)
+                    content)))
+             (rewrite
+              (match-lambda
+                ((name content . rest)
+                 (append (list name (rewrite-if-package content)) rest)))))
+
+        (cond
+         ;; If VARIANT-PROPERTY is present, use that.
+         ((and variant-property
+               (assoc-ref (package-properties p) variant-property))
+          => force)
+
+         ;; Otherwise build the new package object graph.
+         ((eq? (package-build-system p) python-build-system)
+          (package
+            (inherit p)
+            (location (package-location p))
+            (name (let ((name (package-name p)))
+                    (string-append new-prefix
+                                   (if (string-prefix? old-prefix name)
+                                       (substring name
+                                                  (string-length old-prefix))
+                                       name))))
+            (arguments
+             (let ((python (if (promise? python)
+                               (force python)
+                               python)))
+               (ensure-keyword-arguments (package-arguments p)
+                                         `(#:python ,python))))
+            (inputs (map rewrite (package-inputs p)))
+            (propagated-inputs (map rewrite (package-propagated-inputs p)))
+            (native-inputs (map rewrite (package-native-inputs p)))))
+         (else
+          p)))))
 
   transform)
 
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 056b1163b4..47a783f42f 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -557,12 +557,11 @@ that form."
      (display ")" port))))
 
 (define derivation->string
-  (memoize
-   (lambda (drv)
-     "Return the external representation of DRV as a string."
-     (with-fluids ((%default-port-encoding "UTF-8"))
-       (call-with-output-string
-        (cut write-derivation drv <>))))))
+  (mlambda (drv)
+    "Return the external representation of DRV as a string."
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (call-with-output-string
+        (cut write-derivation drv <>)))))
 
 (define* (derivation->output-path drv #:optional (output "out"))
   "Return the store path of its output OUTPUT.  Raise a
@@ -584,12 +583,14 @@ DRV."
 
 (define derivation-path->output-path
   ;; This procedure is called frequently, so memoize it.
-  (memoize
-   (lambda* (path #:optional (output "out"))
-     "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
+  (let ((memoized (mlambda (path output)
+                    (derivation->output-path (call-with-input-file path
+                                               read-derivation)
+                                             output))))
+    (lambda* (path #:optional (output "out"))
+      "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
 path of its output OUTPUT."
-     (derivation->output-path (call-with-input-file path read-derivation)
-                              output))))
+      (memoized path output))))
 
 (define (derivation-path->output-paths path)
   "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the
@@ -616,23 +617,21 @@ in SIZE bytes."
           (loop (+ 1 i))))))
 
 (define derivation-path->base16-hash
-  (memoize
-   (lambda (file)
-     "Return a string containing the base16 representation of the hash of the
+  (mlambda (file)
+    "Return a string containing the base16 representation of the hash of the
 derivation at FILE."
-     (call-with-input-file file
-       (compose bytevector->base16-string
-                derivation-hash
-                read-derivation)))))
+    (call-with-input-file file
+      (compose bytevector->base16-string
+               derivation-hash
+               read-derivation))))
 
 (define derivation-hash            ; `hashDerivationModulo' in derivations.cc
-  (memoize
-   (lambda (drv)
+  (mlambda (drv)
     "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
     (match drv
       (($ <derivation> ((_ . ($ <derivation-output> path
-                                (? symbol? hash-algo) (? bytevector? hash)
-                                (? boolean? recursive?)))))
+                                                    (? symbol? hash-algo) (? bytevector? hash)
+                                                    (? boolean? recursive?)))))
        ;; A fixed-output derivation.
        (sha256
         (string->utf8
@@ -642,14 +641,14 @@ derivation at FILE."
                         ":" (bytevector->base16-string hash)
                         ":" path))))
       (($ <derivation> outputs inputs sources
-          system builder args env-vars)
+                       system builder args env-vars)
        ;; A regular derivation: replace the path of each input with that
        ;; input's hash; return the hash of serialization of the resulting
        ;; derivation.
        (let* ((inputs (map (match-lambda
-                            (($ <derivation-input> path sub-drvs)
-                             (let ((hash (derivation-path->base16-hash path)))
-                               (make-derivation-input hash sub-drvs))))
+                             (($ <derivation-input> path sub-drvs)
+                              (let ((hash (derivation-path->base16-hash path)))
+                                (make-derivation-input hash sub-drvs))))
                            inputs))
               (drv    (make-derivation outputs
                                        (sort (coalesce-duplicate-inputs inputs)
@@ -662,7 +661,7 @@ derivation at FILE."
          ;; the SHA256 port's `write' method gets called for every single
          ;; character.
          (sha256
-          (string->utf8 (derivation->string drv)))))))))
+          (string->utf8 (derivation->string drv))))))))
 
 (define (store-path type hash name)               ; makeStorePath
   "Return the store path for NAME/HASH/TYPE."
@@ -916,18 +915,17 @@ recursively."
     (define rewritten-input
       ;; Rewrite the given input according to MAPPING, and return an input
       ;; in the format used in 'derivation' calls.
-      (memoize
-       (lambda (input loop)
-         (match input
-           (($ <derivation-input> path (sub-drvs ...))
-            (match (vhash-assoc path mapping)
-              ((_ . (? derivation? replacement))
-               (cons replacement sub-drvs))
-              ((_ . replacement)
-               (list replacement))
-              (#f
-               (let* ((drv (loop (call-with-input-file path read-derivation))))
-                 (cons drv sub-drvs)))))))))
+      (mlambda (input loop)
+        (match input
+          (($ <derivation-input> path (sub-drvs ...))
+           (match (vhash-assoc path mapping)
+             ((_ . (? derivation? replacement))
+              (cons replacement sub-drvs))
+             ((_ . replacement)
+              (list replacement))
+             (#f
+              (let* ((drv (loop (call-with-input-file path read-derivation))))
+                (cons drv sub-drvs))))))))
 
     (let loop ((drv drv))
       (let* ((inputs       (map (cut rewritten-input <> loop)
@@ -1058,13 +1056,13 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
 (define search-path*
   ;; A memoizing version of 'search-path' so 'imported-modules' does not end
   ;; up looking for the same files over and over again.
-  (memoize (lambda (path file)
-             "Search for FILE in PATH and memoize the result.  Raise a
+  (mlambda (path file)
+    "Search for FILE in PATH and memoize the result.  Raise a
 '&file-search-error' condition if it could not be found."
-             (or (search-path path file)
-                 (raise (condition
-                         (&file-search-error (file file)
-                                             (path path))))))))
+    (or (search-path path file)
+        (raise (condition
+                (&file-search-error (file file)
+                                    (path path)))))))
 
 (define (module->source-file-name module)
   "Return the file name corresponding to MODULE, a Guile module name (a list
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 05ea19236b..012f587525 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -165,49 +165,48 @@ found."
         (official-gnu-packages)))
 
 (define gnu-package?
-  (memoize
-   (let ((official-gnu-packages (memoize official-gnu-packages)))
-     (lambda (package)
-       "Return true if PACKAGE is a GNU package.  This procedure may access the
+  (let ((official-gnu-packages (memoize official-gnu-packages)))
+    (mlambda (package)
+      "Return true if PACKAGE is a GNU package.  This procedure may access the
 network to check in GNU's database."
-       (define (mirror-type url)
-         (let ((uri (string->uri url)))
-           (and (eq? (uri-scheme uri) 'mirror)
-                (cond
-                 ((member (uri-host uri)
-                          '("gnu" "gnupg" "gcc" "gnome"))
-                  ;; Definitely GNU.
-                  'gnu)
-                 ((equal? (uri-host uri) "cran")
-                  ;; Possibly GNU: mirror://cran could be either GNU R itself
-                  ;; or a non-GNU package.
-                  #f)
-                 (else
-                  ;; Definitely non-GNU.
-                  'non-gnu)))))
-
-       (define (gnu-home-page? package)
-         (letrec-syntax ((>> (syntax-rules ()
-                               ((_ value proc)
-                                (and=> value proc))
-                               ((_ value proc rest ...)
-                                (and=> value
-                                       (lambda (next)
-                                         (>> (proc next) rest ...)))))))
-           (>> package package-home-page
-               string->uri uri-host
-               (lambda (host)
-                 (member host '("www.gnu.org" "gnu.org"))))))
-
-       (or (gnu-home-page? package)
-           (let ((url  (and=> (package-source package) origin-uri))
-                 (name (package-upstream-name package)))
-             (case (and (string? url) (mirror-type url))
-               ((gnu) #t)
-               ((non-gnu) #f)
-               (else
-                (and (member name (map gnu-package-name (official-gnu-packages)))
-                     #t)))))))))
+      (define (mirror-type url)
+        (let ((uri (string->uri url)))
+          (and (eq? (uri-scheme uri) 'mirror)
+               (cond
+                ((member (uri-host uri)
+                         '("gnu" "gnupg" "gcc" "gnome"))
+                 ;; Definitely GNU.
+                 'gnu)
+                ((equal? (uri-host uri) "cran")
+                 ;; Possibly GNU: mirror://cran could be either GNU R itself
+                 ;; or a non-GNU package.
+                 #f)
+                (else
+                 ;; Definitely non-GNU.
+                 'non-gnu)))))
+
+      (define (gnu-home-page? package)
+        (letrec-syntax ((>> (syntax-rules ()
+                              ((_ value proc)
+                               (and=> value proc))
+                              ((_ value proc rest ...)
+                               (and=> value
+                                      (lambda (next)
+                                        (>> (proc next) rest ...)))))))
+          (>> package package-home-page
+              string->uri uri-host
+              (lambda (host)
+                (member host '("www.gnu.org" "gnu.org"))))))
+
+      (or (gnu-home-page? package)
+          (let ((url  (and=> (package-source package) origin-uri))
+                (name (package-upstream-name package)))
+            (case (and (string? url) (mirror-type url))
+              ((gnu) #t)
+              ((non-gnu) #f)
+              (else
+               (and (member name (map gnu-package-name (official-gnu-packages)))
+                    #t))))))))
 
 
 ;;;
diff --git a/guix/modules.scm b/guix/modules.scm
index 2ff94007b5..8c63f21a97 100644
--- a/guix/modules.scm
+++ b/guix/modules.scm
@@ -71,18 +71,17 @@ CLAUSES."
              result)))))
 
 (define module-file-dependencies
-  (memoize
-   (lambda (file)
-     "Return the list of the names of modules that the Guile module in FILE
+  (mlambda (file)
+    "Return the list of the names of modules that the Guile module in FILE
 depends on."
-     (call-with-input-file file
-       (lambda (port)
-         (match (read port)
-           (('define-module name clauses ...)
-            (extract-dependencies clauses))
-           ;; XXX: R6RS 'library' form is ignored.
-           (_
-            '())))))))
+    (call-with-input-file file
+      (lambda (port)
+        (match (read port)
+          (('define-module name clauses ...)
+           (extract-dependencies clauses))
+          ;; XXX: R6RS 'library' form is ignored.
+          (_
+           '()))))))
 
 (define (module-name->file-name module)
   "Return the file name for MODULE."
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 8c82d8978c..9804d41929 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -191,12 +191,11 @@ Dependencies may include packages, origin, and file names."
                  %store-monad))))
 
 (define standard-package-set
-  (memoize
-   (lambda ()
-     "Return the set of standard packages provided by GNU-BUILD-SYSTEM."
-     (match (standard-packages)
-       (((labels packages . output) ...)
-        (list->setq packages))))))
+  (mlambda ()
+    "Return the set of standard packages provided by GNU-BUILD-SYSTEM."
+    (match (standard-packages)
+      (((labels packages . output) ...)
+       (list->setq packages)))))
 
 (define (bag-node-edges-sans-bootstrap thing)
   "Like 'bag-node-edges', but pretend that the standard packages of
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index cb64dc8b2b..0b38aac319 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -559,12 +559,11 @@ patch could not be found."
                       str)))
 
 (define official-gnu-packages*
-  (memoize
-   (lambda ()
-     "A memoizing version of 'official-gnu-packages' that returns the empty
+  (mlambda ()
+    "A memoizing version of 'official-gnu-packages' that returns the empty
 list when something goes wrong, such as a networking issue."
-     (let ((gnus (false-if-exception (official-gnu-packages))))
-       (or gnus '())))))
+    (let ((gnus (false-if-exception (official-gnu-packages))))
+      (or gnus '()))))
 
 (define (check-gnu-synopsis+description package)
   "Make sure that, if PACKAGE is a GNU package, it uses the synopsis and
diff --git a/guix/store.scm b/guix/store.scm
index 491cd5ac06..cb3fbed912 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1282,11 +1282,10 @@ valid inputs."
 (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})-([^/]+)$")))))
+  (mlambda (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."
diff --git a/guix/utils.scm b/guix/utils.scm
index 8aa2cb734d..72dc0687a4 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -771,11 +771,10 @@ be determined."
   (column        location-column))                ; 0-indexed column
 
 (define location
-  (memoize
-   (lambda (file line column)
-     "Return the <location> object for the given FILE, LINE, and COLUMN."
-     (and line column file
-          (make-location file line column)))))
+  (mlambda (file line column)
+    "Return the <location> object for the given FILE, LINE, and COLUMN."
+    (and line column file
+         (make-location file line column))))
 
 (define (source-properties->location loc)
   "Return a location object based on the info in LOC, an alist as returned