aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-11-09 21:32:41 +0100
committerLudovic Courtès <ludo@gnu.org>2019-11-09 23:04:14 +0100
commit2a4309de43011f87b3a5044c3d956c261ae151e4 (patch)
tree8919ab75249b34e4bc50c000b914f005c0ca3901
parentf0034427f50be1bcab137d9877c3586e4be4d83e (diff)
downloadguix-2a4309de43011f87b3a5044c3d956c261ae151e4.tar.gz
guix-2a4309de43011f87b3a5044c3d956c261ae151e4.zip
services: 'fold-services' memoizes service values.
Previously 'fold-services' could end up traversing the same services in the graph several times, which is what this change addresses. The hit rate on the 'add-data-to-store' cache goves from 9% to 8% on "guix system build desktop.tmpl -nd", and the number of lookups in that cache goes from 4458 to 4383. * gnu/services.scm (fold-services): Turn 'loop' into a monadic procedure in %STATE-MONAD and use it to memoize values of visited services.
-rw-r--r--gnu/services.scm40
1 files changed, 28 insertions, 12 deletions
diff --git a/gnu/services.scm b/gnu/services.scm
index 6ee05d4580..394470ba7d 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -775,18 +775,34 @@ TARGET-TYPE; return the root service adjusted accordingly."
(eq? (service-kind service) target-type))
services)
((sink)
- (let loop ((sink sink))
- (let* ((dependents (map loop (dependents sink)))
- (extensions (map (apply-extension sink) dependents))
- (extend (service-type-extend (service-kind sink)))
- (compose (service-type-compose (service-kind sink)))
- (params (service-value sink)))
- ;; We distinguish COMPOSE and EXTEND because PARAMS typically has a
- ;; different type than the elements of EXTENSIONS.
- (if extend
- (service (service-kind sink)
- (extend params (compose extensions)))
- sink))))
+ ;; Use the state monad to keep track of already-visited services in the
+ ;; graph and to memoize their value once folded.
+ (run-with-state
+ (let loop ((sink sink))
+ (mlet %state-monad ((visited (current-state)))
+ (match (vhash-assq sink visited)
+ (#f
+ (mlet* %state-monad
+ ((dependents (mapm %state-monad loop (dependents sink)))
+ (visited (current-state))
+ (extensions -> (map (apply-extension sink) dependents))
+ (extend -> (service-type-extend (service-kind sink)))
+ (compose -> (service-type-compose (service-kind sink)))
+ (params -> (service-value sink))
+ (service
+ ->
+ ;; Distinguish COMPOSE and EXTEND because PARAMS typically
+ ;; has a different type than the elements of EXTENSIONS.
+ (if extend
+ (service (service-kind sink)
+ (extend params (compose extensions)))
+ sink)))
+ (mbegin %state-monad
+ (set-current-state (vhash-consq sink service visited))
+ (return service))))
+ ((_ . service) ;SINK was already visited
+ (return service)))))
+ vlist-null))
(()
(raise
(condition (&missing-target-service-error