diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-11-09 21:32:41 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-11-09 23:04:14 +0100 |
commit | 2a4309de43011f87b3a5044c3d956c261ae151e4 (patch) | |
tree | 8919ab75249b34e4bc50c000b914f005c0ca3901 /gnu | |
parent | f0034427f50be1bcab137d9877c3586e4be4d83e (diff) | |
download | patches-2a4309de43011f87b3a5044c3d956c261ae151e4.tar patches-2a4309de43011f87b3a5044c3d956c261ae151e4.tar.gz |
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.
Diffstat (limited to 'gnu')
-rw-r--r-- | gnu/services.scm | 40 |
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 |