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.
This commit is contained in:
parent
f0034427f5
commit
2a4309de43
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user