summaryrefslogtreecommitdiff
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)
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 ec2473422f4..0aa289d56c0 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -235,28 +235,27 @@ decreasing version order."
235 matching))))) 235 matching)))))
236 236
237(define find-newest-available-packages 237(define find-newest-available-packages
238 (memoize 238 (mlambda ()
239 (lambda () 239 "Return a vhash keyed by package names, and with
240 "Return a vhash keyed by package names, and with
241associated values of the form 240associated values of the form
242 241
243 (newest-version newest-package ...) 242 (newest-version newest-package ...)
244 243
245where the preferred package is listed first." 244where the preferred package is listed first."
246 245
247 ;; FIXME: Currently, the preferred package is whichever one 246 ;; FIXME: Currently, the preferred package is whichever one
248 ;; was found last by 'fold-packages'. Find a better solution. 247 ;; was found last by 'fold-packages'. Find a better solution.
249 (fold-packages (lambda (p r) 248 (fold-packages (lambda (p r)
250 (let ((name (package-name p)) 249 (let ((name (package-name p))
251 (version (package-version p))) 250 (version (package-version p)))
252 (match (vhash-assoc name r) 251 (match (vhash-assoc name r)
253 ((_ newest-so-far . pkgs) 252 ((_ newest-so-far . pkgs)
254 (case (version-compare version newest-so-far) 253 (case (version-compare version newest-so-far)
255 ((>) (vhash-cons name `(,version ,p) r)) 254 ((>) (vhash-cons name `(,version ,p) r))
256 ((=) (vhash-cons name `(,version ,p ,@pkgs) r)) 255 ((=) (vhash-cons name `(,version ,p ,@pkgs) r))
257 ((<) r))) 256 ((<) r)))
258 (#f (vhash-cons name `(,version ,p) r))))) 257 (#f (vhash-cons name `(,version ,p) r)))))
259 vlist-null)))) 258 vlist-null)))
260 259
261(define (find-best-packages-by-name name version) 260(define (find-best-packages-by-name name version)
262 "If version is #f, return the list of packages named NAME with the highest 261 "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 7cde51fff80..c8d94c83036 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -131,30 +131,29 @@ successful, or false to signal an error."
131 (license gpl3+))) 131 (license gpl3+)))
132 132
133(define package-with-bootstrap-guile 133(define package-with-bootstrap-guile
134 (memoize 134 (mlambda (p)
135 (lambda (p)
136 "Return a variant of P such that all its origins are fetched with 135 "Return a variant of P such that all its origins are fetched with
137%BOOTSTRAP-GUILE." 136%BOOTSTRAP-GUILE."
138 (define rewritten-input 137 (define rewritten-input
139 (match-lambda 138 (match-lambda
140 ((name (? origin? o)) 139 ((name (? origin? o))
141 `(,name ,(bootstrap-origin o))) 140 `(,name ,(bootstrap-origin o)))
142 ((name (? package? p) sub-drvs ...) 141 ((name (? package? p) sub-drvs ...)
143 `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs)) 142 `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
144 (x x))) 143 (x x)))
145 144
146 (package (inherit p) 145 (package (inherit p)
147 (source (match (package-source p) 146 (source (match (package-source p)
148 ((? origin? o) (bootstrap-origin o)) 147 ((? origin? o) (bootstrap-origin o))
149 (s s))) 148 (s s)))
150 (inputs (map rewritten-input 149 (inputs (map rewritten-input
151 (package-inputs p))) 150 (package-inputs p)))
152 (native-inputs (map rewritten-input 151 (native-inputs (map rewritten-input
153 (package-native-inputs p))) 152 (package-native-inputs p)))
154 (propagated-inputs (map rewritten-input 153 (propagated-inputs (map rewritten-input
155 (package-propagated-inputs p))) 154 (package-propagated-inputs p)))
156 (replacement (and=> (package-replacement p) 155 (replacement (and=> (package-replacement p)
157 package-with-bootstrap-guile)))))) 156 package-with-bootstrap-guile)))))
158 157
159(define* (glibc-dynamic-linker 158(define* (glibc-dynamic-linker
160 #:optional (system (or (and=> (%current-target-system) 159 #:optional (system (or (and=> (%current-target-system)
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index f05ddf91f5b..730e638c89c 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."
84 84
85 (let loop ((p p)) 85 (let loop ((p p))
86 (define rewritten-input 86 (define rewritten-input
87 (memoize 87 (mlambda (input)
88 (match-lambda 88 (match input
89 ((name (? package? p) sub-drv ...) 89 ((name (? package? p) sub-drv ...)
90 ;; XXX: Check whether P's build system knows #:implicit-inputs, for 90 ;; XXX: Check whether P's build system knows #:implicit-inputs, for
91 ;; things like `cross-pkg-config'. 91 ;; things like `cross-pkg-config'.
92 (if (eq? (package-build-system p) gnu-build-system) 92 (if (eq? (package-build-system p) gnu-build-system)
93 (cons* name (loop p) sub-drv) 93 (cons* name (loop p) sub-drv)
94 (cons* name p sub-drv))) 94 (cons* name p sub-drv)))
95 (x x)))) 95 (x x))))
96 96
97 (package (inherit p) 97 (package (inherit p)
98 (location (if (pair? loc) (source-properties->location loc) loc)) 98 (location (if (pair? loc) (source-properties->location loc) loc))
@@ -393,22 +393,21 @@ packages that must not be referenced."
393;;; 393;;;
394 394
395(define standard-cross-packages 395(define standard-cross-packages
396 (memoize 396 (mlambda (target kind)
397 (lambda (target kind) 397 "Return the list of name/package tuples to cross-build for TARGET. KIND
398 "Return the list of name/package tuples to cross-build for TARGET. KIND
399is one of `host' or `target'." 398is one of `host' or `target'."
400 (let* ((cross (resolve-interface '(gnu packages cross-base))) 399 (let* ((cross (resolve-interface '(gnu packages cross-base)))
401 (gcc (module-ref cross 'cross-gcc)) 400 (gcc (module-ref cross 'cross-gcc))
402 (binutils (module-ref cross 'cross-binutils)) 401 (binutils (module-ref cross 'cross-binutils))
403 (libc (module-ref cross 'cross-libc))) 402 (libc (module-ref cross 'cross-libc)))
404 (case kind 403 (case kind
405 ((host) 404 ((host)
406 `(("cross-gcc" ,(gcc target 405 `(("cross-gcc" ,(gcc target
407 (binutils target) 406 (binutils target)
408 (libc target))) 407 (libc target)))
409 ("cross-binutils" ,(binutils target)))) 408 ("cross-binutils" ,(binutils target))))
410 ((target) 409 ((target)
411 `(("cross-libc" ,(libc target))))))))) 410 `(("cross-libc" ,(libc target))))))))
412 411
413(define* (gnu-cross-build store name 412(define* (gnu-cross-build store name
414 #:key 413 #:key
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index bfe0eca9f60..383e8cb64a3 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -87,49 +87,48 @@ pre-defined variants."
87 ;; Memoize the transformations. Failing to do that, we would build a huge 87 ;; Memoize the transformations. Failing to do that, we would build a huge
88 ;; object graph with lots of duplicates, which in turns prevents us from 88 ;; object graph with lots of duplicates, which in turns prevents us from
89 ;; benefiting from memoization in 'package-derivation'. 89 ;; benefiting from memoization in 'package-derivation'.
90 (memoize ;FIXME: use 'eq?' 90 (mlambda (p) ;XXX: use 'eq?'
91 (lambda (p) 91 (let* ((rewrite-if-package
92 (let* ((rewrite-if-package 92 (lambda (content)
93 (lambda (content) 93 ;; CONTENT may be a file name, in which case it is returned,
94 ;; CONTENT may be a file name, in which case it is returned, 94 ;; or a package, which is rewritten with the new PYTHON and
95 ;; or a package, which is rewritten with the new PYTHON and 95 ;; NEW-PREFIX.
96 ;; NEW-PREFIX. 96 (if (package? content)
97 (if (package? content) 97 (transform content)
98 (transform content) 98 content)))
99 content))) 99 (rewrite
100 (rewrite 100 (match-lambda
101 (match-lambda 101 ((name content . rest)
102 ((name content . rest) 102 (append (list name (rewrite-if-package content)) rest)))))
103 (append (list name (rewrite-if-package content)) rest))))) 103
104 104 (cond
105 (cond 105 ;; If VARIANT-PROPERTY is present, use that.
106 ;; If VARIANT-PROPERTY is present, use that. 106 ((and variant-property
107 ((and variant-property 107 (assoc-ref (package-properties p) variant-property))
108 (assoc-ref (package-properties p) variant-property)) 108 => force)
109 => force) 109
110 110 ;; Otherwise build the new package object graph.
111 ;; Otherwise build the new package object graph. 111 ((eq? (package-build-system p) python-build-system)
112 ((eq? (package-build-system p) python-build-system) 112 (package
113 (package 113 (inherit p)
114 (inherit p) 114 (location (package-location p))
115 (location (package-location p)) 115 (name (let ((name (package-name p)))
116 (name (let ((name (package-name p))) 116 (string-append new-prefix
117 (string-append new-prefix 117 (if (string-prefix? old-prefix name)
118 (if (string-prefix? old-prefix name) 118 (substring name
119 (substring name 119 (string-length old-prefix))
120 (string-length old-prefix)) 120 name))))
121 name)))) 121 (arguments
122 (arguments 122 (let ((python (if (promise? python)
123 (let ((python (if (promise? python) 123 (force python)
124 (force python) 124 python)))
125 python))) 125 (ensure-keyword-arguments (package-arguments p)
126 (ensure-keyword-arguments (package-arguments p) 126 `(#:python ,python))))
127 `(#:python ,python)))) 127 (inputs (map rewrite (package-inputs p)))
128 (inputs (map rewrite (package-inputs p))) 128 (propagated-inputs (map rewrite (package-propagated-inputs p)))
129 (propagated-inputs (map rewrite (package-propagated-inputs p))) 129 (native-inputs (map rewrite (package-native-inputs p)))))
130 (native-inputs (map rewrite (package-native-inputs p))))) 130 (else
131 (else 131 p)))))
132 p))))))
133 132
134 transform) 133 transform)
135 134
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 056b1163b49..47a783f42f6 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -557,12 +557,11 @@ that form."
557 (display ")" port)))) 557 (display ")" port))))
558 558
559(define derivation->string 559(define derivation->string
560 (memoize 560 (mlambda (drv)
561 (lambda (drv) 561 "Return the external representation of DRV as a string."
562 "Return the external representation of DRV as a string." 562 (with-fluids ((%default-port-encoding "UTF-8"))
563 (with-fluids ((%default-port-encoding "UTF-8")) 563 (call-with-output-string
564 (call-with-output-string 564 (cut write-derivation drv <>)))))
565 (cut write-derivation drv <>))))))
566 565
567(define* (derivation->output-path drv #:optional (output "out")) 566(define* (derivation->output-path drv #:optional (output "out"))
568 "Return the store path of its output OUTPUT. Raise a 567 "Return the store path of its output OUTPUT. Raise a
@@ -584,12 +583,14 @@ DRV."
584 583
585(define derivation-path->output-path 584(define derivation-path->output-path
586 ;; This procedure is called frequently, so memoize it. 585 ;; This procedure is called frequently, so memoize it.
587 (memoize 586 (let ((memoized (mlambda (path output)
588 (lambda* (path #:optional (output "out")) 587 (derivation->output-path (call-with-input-file path
589 "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store 588 read-derivation)
589 output))))
590 (lambda* (path #:optional (output "out"))
591 "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
590path of its output OUTPUT." 592path of its output OUTPUT."
591 (derivation->output-path (call-with-input-file path read-derivation) 593 (memoized path output))))
592 output))))
593 594
594(define (derivation-path->output-paths path) 595(define (derivation-path->output-paths path)
595 "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the 596 "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the
@@ -616,23 +617,21 @@ in SIZE bytes."
616 (loop (+ 1 i)))))) 617 (loop (+ 1 i))))))
617 618
618(define derivation-path->base16-hash 619(define derivation-path->base16-hash
619 (memoize 620 (mlambda (file)
620 (lambda (file) 621 "Return a string containing the base16 representation of the hash of the
621 "Return a string containing the base16 representation of the hash of the
622derivation at FILE." 622derivation at FILE."
623 (call-with-input-file file 623 (call-with-input-file file
624 (compose bytevector->base16-string 624 (compose bytevector->base16-string
625 derivation-hash 625 derivation-hash
626 read-derivation))))) 626 read-derivation))))
627 627
628(define derivation-hash ; `hashDerivationModulo' in derivations.cc 628(define derivation-hash ; `hashDerivationModulo' in derivations.cc
629 (memoize 629 (mlambda (drv)
630 (lambda (drv)
631 "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector." 630 "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
632 (match drv 631 (match drv
633 (($ <derivation> ((_ . ($ <derivation-output> path 632 (($ <derivation> ((_ . ($ <derivation-output> path
634 (? symbol? hash-algo) (? bytevector? hash) 633 (? symbol? hash-algo) (? bytevector? hash)
635 (? boolean? recursive?))))) 634 (? boolean? recursive?)))))
636 ;; A fixed-output derivation. 635 ;; A fixed-output derivation.
637 (sha256 636 (sha256
638 (string->utf8 637 (string->utf8
@@ -642,14 +641,14 @@ derivation at FILE."
642 ":" (bytevector->base16-string hash) 641 ":" (bytevector->base16-string hash)
643 ":" path)))) 642 ":" path))))
644 (($ <derivation> outputs inputs sources 643 (($ <derivation> outputs inputs sources
645 system builder args env-vars) 644 system builder args env-vars)
646 ;; A regular derivation: replace the path of each input with that 645 ;; A regular derivation: replace the path of each input with that
647 ;; input's hash; return the hash of serialization of the resulting 646 ;; input's hash; return the hash of serialization of the resulting
648 ;; derivation. 647 ;; derivation.
649 (let* ((inputs (map (match-lambda 648 (let* ((inputs (map (match-lambda
650 (($ <derivation-input> path sub-drvs) 649 (($ <derivation-input> path sub-drvs)
651 (let ((hash (derivation-path->base16-hash path))) 650 (let ((hash (derivation-path->base16-hash path)))
652 (make-derivation-input hash sub-drvs)))) 651 (make-derivation-input hash sub-drvs))))
653 inputs)) 652 inputs))
654 (drv (make-derivation outputs 653 (drv (make-derivation outputs
655 (sort (coalesce-duplicate-inputs inputs) 654 (sort (coalesce-duplicate-inputs inputs)
@@ -662,7 +661,7 @@ derivation at FILE."
662 ;; the SHA256 port's `write' method gets called for every single 661 ;; the SHA256 port's `write' method gets called for every single
663 ;; character. 662 ;; character.
664 (sha256 663 (sha256
665 (string->utf8 (derivation->string drv))))))))) 664 (string->utf8 (derivation->string drv))))))))
666 665
667(define (store-path type hash name) ; makeStorePath 666(define (store-path type hash name) ; makeStorePath
668 "Return the store path for NAME/HASH/TYPE." 667 "Return the store path for NAME/HASH/TYPE."
@@ -916,18 +915,17 @@ recursively."
916 (define rewritten-input 915 (define rewritten-input
917 ;; Rewrite the given input according to MAPPING, and return an input 916 ;; Rewrite the given input according to MAPPING, and return an input
918 ;; in the format used in 'derivation' calls. 917 ;; in the format used in 'derivation' calls.
919 (memoize 918 (mlambda (input loop)
920 (lambda (input loop) 919 (match input
921 (match input 920 (($ <derivation-input> path (sub-drvs ...))
922 (($ <derivation-input> path (sub-drvs ...)) 921 (match (vhash-assoc path mapping)
923 (match (vhash-assoc path mapping) 922 ((_ . (? derivation? replacement))
924 ((_ . (? derivation? replacement)) 923 (cons replacement sub-drvs))
925 (cons replacement sub-drvs)) 924 ((_ . replacement)
926 ((_ . replacement) 925 (list replacement))
927 (list replacement)) 926 (#f
928 (#f 927 (let* ((drv (loop (call-with-input-file path read-derivation))))
929 (let* ((drv (loop (call-with-input-file path read-derivation)))) 928 (cons drv sub-drvs))))))))
930 (cons drv sub-drvs)))))))))
931 929
932 (let loop ((drv drv)) 930 (let loop ((drv drv))
933 (let* ((inputs (map (cut rewritten-input <> loop) 931 (let* ((inputs (map (cut rewritten-input <> loop)
@@ -1058,13 +1056,13 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
1058(define search-path* 1056(define search-path*
1059 ;; A memoizing version of 'search-path' so 'imported-modules' does not end 1057 ;; A memoizing version of 'search-path' so 'imported-modules' does not end
1060 ;; up looking for the same files over and over again. 1058 ;; up looking for the same files over and over again.
1061 (memoize (lambda (path file) 1059 (mlambda (path file)
1062 "Search for FILE in PATH and memoize the result. Raise a 1060 "Search for FILE in PATH and memoize the result. Raise a
1063'&file-search-error' condition if it could not be found." 1061'&file-search-error' condition if it could not be found."
1064 (or (search-path path file) 1062 (or (search-path path file)
1065 (raise (condition 1063 (raise (condition
1066 (&file-search-error (file file) 1064 (&file-search-error (file file)
1067 (path path)))))))) 1065 (path path)))))))
1068 1066
1069(define (module->source-file-name module) 1067(define (module->source-file-name module)
1070 "Return the file name corresponding to MODULE, a Guile module name (a list 1068 "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 05ea19236bf..012f587525c 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -165,49 +165,48 @@ found."
165 (official-gnu-packages))) 165 (official-gnu-packages)))
166 166
167(define gnu-package? 167(define gnu-package?
168 (memoize 168 (let ((official-gnu-packages (memoize official-gnu-packages)))
169 (let ((official-gnu-packages (memoize official-gnu-packages))) 169 (mlambda (package)
170 (lambda (package) 170 "Return true if PACKAGE is a GNU package. This procedure may access the
171 "Return true if PACKAGE is a GNU package. This procedure may access the
172network to check in GNU's database." 171network to check in GNU's database."
173 (define (mirror-type url) 172 (define (mirror-type url)
174 (let ((uri (string->uri url))) 173 (let ((uri (string->uri url)))
175 (and (eq? (uri-scheme uri) 'mirror) 174 (and (eq? (uri-scheme uri) 'mirror)
176 (cond 175 (cond
177 ((member (uri-host uri) 176 ((member (uri-host uri)
178 '("gnu" "gnupg" "gcc" "gnome")) 177 '("gnu" "gnupg" "gcc" "gnome"))
179 ;; Definitely GNU. 178 ;; Definitely GNU.
180 'gnu) 179 'gnu)
181 ((equal? (uri-host uri) "cran") 180 ((equal? (uri-host uri) "cran")
182 ;; Possibly GNU: mirror://cran could be either GNU R itself 181 ;; Possibly GNU: mirror://cran could be either GNU R itself
183 ;; or a non-GNU package. 182 ;; or a non-GNU package.
184 #f) 183 #f)
185 (else 184 (else
186 ;; Definitely non-GNU. 185 ;; Definitely non-GNU.
187 'non-gnu))))) 186 'non-gnu)))))
188 187
189 (define (gnu-home-page? package) 188 (define (gnu-home-page? package)
190 (letrec-syntax ((>> (syntax-rules () 189 (letrec-syntax ((>> (syntax-rules ()
191 ((_ value proc) 190 ((_ value proc)
192 (and=> value proc)) 191 (and=> value proc))
193 ((_ value proc rest ...) 192 ((_ value proc rest ...)
194 (and=> value 193 (and=> value
195 (lambda (next) 194 (lambda (next)
196 (>> (proc next) rest ...))))))) 195 (>> (proc next) rest ...)))))))
197 (>> package package-home-page 196 (>> package package-home-page
198 string->uri uri-host 197 string->uri uri-host
199 (lambda (host) 198 (lambda (host)
200 (member host '("www.gnu.org" "gnu.org")))))) 199 (member host '("www.gnu.org" "gnu.org"))))))
201 200
202 (or (gnu-home-page? package) 201 (or (gnu-home-page? package)
203 (let ((url (and=> (package-source package) origin-uri)) 202 (let ((url (and=> (package-source package) origin-uri))
204 (name (package-upstream-name package))) 203 (name (package-upstream-name package)))
205 (case (and (string? url) (mirror-type url)) 204 (case (and (string? url) (mirror-type url))
206 ((gnu) #t) 205 ((gnu) #t)
207 ((non-gnu) #f) 206 ((non-gnu) #f)
208 (else 207 (else
209 (and (member name (map gnu-package-name (official-gnu-packages))) 208 (and (member name (map gnu-package-name (official-gnu-packages)))
210 #t))))))))) 209 #t))))))))
211 210
212 211
213;;; 212;;;
diff --git a/guix/modules.scm b/guix/modules.scm
index 2ff94007b5e..8c63f21a97e 100644
--- a/guix/modules.scm
+++ b/guix/modules.scm
@@ -71,18 +71,17 @@ CLAUSES."
71 result))))) 71 result)))))
72 72
73(define module-file-dependencies 73(define module-file-dependencies
74 (memoize 74 (mlambda (file)
75 (lambda (file) 75 "Return the list of the names of modules that the Guile module in FILE
76 "Return the list of the names of modules that the Guile module in FILE
77depends on." 76depends on."
78 (call-with-input-file file 77 (call-with-input-file file
79 (lambda (port) 78 (lambda (port)
80 (match (read port) 79 (match (read port)
81 (('define-module name clauses ...) 80 (('define-module name clauses ...)
82 (extract-dependencies clauses)) 81 (extract-dependencies clauses))
83 ;; XXX: R6RS 'library' form is ignored. 82 ;; XXX: R6RS 'library' form is ignored.
84 (_ 83 (_
85 '()))))))) 84 '()))))))
86 85
87(define (module-name->file-name module) 86(define (module-name->file-name module)
88 "Return the file name for MODULE." 87 "Return the file name for MODULE."
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 8c82d8978cd..9804d419293 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -191,12 +191,11 @@ Dependencies may include packages, origin, and file names."
191 %store-monad)))) 191 %store-monad))))
192 192
193(define standard-package-set 193(define standard-package-set
194 (memoize 194 (mlambda ()
195 (lambda () 195 "Return the set of standard packages provided by GNU-BUILD-SYSTEM."
196 "Return the set of standard packages provided by GNU-BUILD-SYSTEM." 196 (match (standard-packages)
197 (match (standard-packages) 197 (((labels packages . output) ...)
198 (((labels packages . output) ...) 198 (list->setq packages)))))
199 (list->setq packages))))))
200 199
201(define (bag-node-edges-sans-bootstrap thing) 200(define (bag-node-edges-sans-bootstrap thing)
202 "Like 'bag-node-edges', but pretend that the standard packages of 201 "Like 'bag-node-edges', but pretend that the standard packages of
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index cb64dc8b2b2..0b38aac319e 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -559,12 +559,11 @@ patch could not be found."
559 str))) 559 str)))
560 560
561(define official-gnu-packages* 561(define official-gnu-packages*
562 (memoize 562 (mlambda ()
563 (lambda () 563 "A memoizing version of 'official-gnu-packages' that returns the empty
564 "A memoizing version of 'official-gnu-packages' that returns the empty
565list when something goes wrong, such as a networking issue." 564list when something goes wrong, such as a networking issue."
566 (let ((gnus (false-if-exception (official-gnu-packages)))) 565 (let ((gnus (false-if-exception (official-gnu-packages))))
567 (or gnus '()))))) 566 (or gnus '()))))
568 567
569(define (check-gnu-synopsis+description package) 568(define (check-gnu-synopsis+description package)
570 "Make sure that, if PACKAGE is a GNU package, it uses the synopsis and 569 "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 491cd5ac06a..cb3fbed912c 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1282,11 +1282,10 @@ valid inputs."
1282(define store-regexp* 1282(define store-regexp*
1283 ;; The substituter makes repeated calls to 'store-path-hash-part', hence 1283 ;; The substituter makes repeated calls to 'store-path-hash-part', hence
1284 ;; this optimization. 1284 ;; this optimization.
1285 (memoize 1285 (mlambda (store)
1286 (lambda (store) 1286 "Return a regexp matching a file in STORE."
1287 "Return a regexp matching a file in STORE." 1287 (make-regexp (string-append "^" (regexp-quote store)
1288 (make-regexp (string-append "^" (regexp-quote store) 1288 "/([0-9a-df-np-sv-z]{32})-([^/]+)$"))))
1289 "/([0-9a-df-np-sv-z]{32})-([^/]+)$")))))
1290 1289
1291(define (store-path-package-name path) 1290(define (store-path-package-name path)
1292 "Return the package name part of PATH, a file name in the store." 1291 "Return the package name part of PATH, a file name in the store."
diff --git a/guix/utils.scm b/guix/utils.scm
index 8aa2cb734dd..72dc0687a40 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -771,11 +771,10 @@ be determined."
771 (column location-column)) ; 0-indexed column 771 (column location-column)) ; 0-indexed column
772 772
773(define location 773(define location
774 (memoize 774 (mlambda (file line column)
775 (lambda (file line column) 775 "Return the <location> object for the given FILE, LINE, and COLUMN."
776 "Return the <location> object for the given FILE, LINE, and COLUMN." 776 (and line column file
777 (and line column file 777 (make-location file line column))))
778 (make-location file line column)))))
779 778
780(define (source-properties->location loc) 779(define (source-properties->location loc)
781 "Return a location object based on the info in LOC, an alist as returned 780 "Return a location object based on the info in LOC, an alist as returned