summaryrefslogtreecommitdiff
path: root/gnu/services.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services.scm')
-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