[PATCH] offload: Memoize the 'machine-load' procedure

[Mark H Weaver]

This patch memoizes the 'machine-load' procedure so that the load of
each build slave is queried only once per call to 'guix offload'.  Apart
from avoiding wasteful repeated ssh connections, this is needed to
ensure that all calls to the sorting predicate are consistent with each
other, which is part of the contract with 'sort'.

     Mark

>From 1fa02a0b0f50e141935833f6dfc295f654118621 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Wed, 17 Jun 2015 13:58:00 -0400
Subject: [PATCH] offload: Memoize the 'machine-load' procedure.

* guix/scripts/offload.scm (machine-load): Memoize.
---
 guix/scripts/offload.scm | 46 ++++++++++++++++++++++++----------------------
 1 file changed, 24 insertions(+), 22 deletions(-)

diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index e6be8b4..0956f1a 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -531,30 +531,32 @@ success, #f otherwise."
                (build-requirements-features requirements)
                (build-machine-features machine))))
 
-(define (machine-load machine)
-  "Return the load of MACHINE, divided by the number of parallel builds
+(define machine-load
+  (memoize
+   (lambda (machine)
+     "Return the load of MACHINE, divided by the number of parallel builds
 allowed on MACHINE."
-  (let* ((pipe   (remote-pipe machine OPEN_READ `("cat" "/proc/loadavg")))
-         (line   (read-line pipe))
-         (status (close-pipe pipe)))
-    (unless (eqv? 0 (status:exit-val status))
-      (warning (_ "failed to obtain load of '~a': SSH client exited with ~a~%")
-               (build-machine-name machine)
-               (status:exit-val status)))
-
-    (if (eof-object? line)
-        +inf.0    ;MACHINE does not respond, so assume it is infinitely loaded
-        (match (string-tokenize line)
-          ((one five fifteen . _)
-           (let* ((raw        (string->number five))
-                  (jobs       (build-machine-parallel-builds machine))
-                  (normalized (/ raw jobs)))
-             (format (current-error-port) "load on machine '~a' is ~s\
+     (let* ((pipe   (remote-pipe machine OPEN_READ `("cat" "/proc/loadavg")))
+            (line   (read-line pipe))
+            (status (close-pipe pipe)))
+       (unless (eqv? 0 (status:exit-val status))
+         (warning (_ "failed to obtain load of '~a': SSH client exited with 
~a~%")
+                  (build-machine-name machine)
+                  (status:exit-val status)))
+
+       (if (eof-object? line)
+           +inf.0  ;MACHINE does not respond, so assume it is infinitely loaded
+           (match (string-tokenize line)
+             ((one five fifteen . _)
+              (let* ((raw        (string->number five))
+                     (jobs       (build-machine-parallel-builds machine))
+                     (normalized (/ raw jobs)))
+                (format (current-error-port) "load on machine '~a' is ~s\
  (normalized: ~s)~%"
-                     (build-machine-name machine) raw normalized)
-             normalized))
-          (_
-           +inf.0)))))           ;something's fishy about MACHINE, so avoid it
+                        (build-machine-name machine) raw normalized)
+                normalized))
+             (_
+              +inf.0)))))))       ;something's fishy about MACHINE, so avoid it
 
 (define (machine-power-factor m)
   "Return a factor that aggregates the speed and load of M.  The higher the
-- 
2.4.3