From: Mark H Weaver <mhw@netris.org>
To: guix-devel@gnu.org
Subject: [PATCH] Optimize package-transitive-supported-systems
Date: Sun, 21 Dec 2014 16:43:23 -0500 [thread overview]
Message-ID: <873888n0g4.fsf@netris.org> (raw)
[-- Attachment #1: Type: text/plain, Size: 506 bytes --]
When hydra evaluates a jobset, 'package-transitive-supported-systems' is
called for every package+system combination. Each of these calls
traverses the tree of inputs, but without eliminating duplicate
transitive-inputs. In other words, the amount of time spent is
proportional not to the number of transitive-inputs, but the number of
_paths_ to all transitive-inputs.
This patch memoizes 'package-transitive-supported-systems', so that the
total time to apply it to all packages is O(N).
Mark
[-- Attachment #2: [PATCH] Optimize package-transitive-supported-systems --]
[-- Type: text/x-patch, Size: 3742 bytes --]
From 90541f6c7e2a9e2f8a7b412532b4b5a56a10e481 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Sun, 21 Dec 2014 16:21:02 -0500
Subject: [PATCH] Optimize package-transitive-supported-systems.
* guix/packages.scm (first-value): Remove.
(define-memoized/v): New macro.
(package-transitive-supported-systems): Rewrite.
---
guix/packages.scm | 61 +++++++++++++++++++++++++++----------------------------
1 file changed, 30 insertions(+), 31 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index 07f6d0c..2a9a55e 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -543,40 +544,38 @@ for the host system (\"native inputs\"), and not target inputs."
recursively."
(transitive-inputs (package-propagated-inputs package)))
-(define-syntax-rule (first-value exp)
- "Truncate all but the first value returned by EXP."
- (call-with-values (lambda () exp)
- (lambda (result . _)
- result)))
+(define-syntax define-memoized/v
+ (lambda (form)
+ "Define a memoized single-valued unary procedure with docstring.
+The procedure argument is compared to cached keys using `eqv?'."
+ (syntax-case form ()
+ ((_ (proc arg) docstring body body* ...)
+ (string? (syntax->datum #'docstring))
+ #'(define proc
+ (let ((cache (make-hash-table)))
+ (define (proc arg)
+ docstring
+ (match (hashv-get-handle cache arg)
+ ((_ . value)
+ value)
+ (_
+ (let ((result (let () body body* ...)))
+ (hashv-set! cache arg result)
+ result))))
+ proc))))))
-(define (package-transitive-supported-systems package)
+(define-memoized/v (package-transitive-supported-systems package)
"Return the intersection of the systems supported by PACKAGE and those
supported by its dependencies."
- (first-value
- (let loop ((package package)
- (systems (package-supported-systems package))
- (visited vlist-null))
- (match (vhash-assq package visited)
- ((_ . result)
- (values (lset-intersection string=? systems result)
- visited))
- (#f
- (call-with-values
- (lambda ()
- (fold2 (lambda (input systems visited)
- (match input
- ((label (? package? package) . _)
- (loop package systems visited))
- (_
- (values systems visited))))
- (lset-intersection string=?
- systems
- (package-supported-systems package))
- visited
- (package-direct-inputs package)))
- (lambda (systems visited)
- (values systems
- (vhash-consq package systems visited)))))))))
+ (fold (lambda (input systems)
+ (match input
+ ((label (? package? p) . _)
+ (lset-intersection
+ string=? systems (package-transitive-supported-systems p)))
+ (_
+ systems)))
+ (package-supported-systems package)
+ (package-direct-inputs package)))
(define (bag-transitive-inputs bag)
"Same as 'package-transitive-inputs', but applied to a bag."
--
2.1.2
next reply other threads:[~2014-12-21 21:43 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-12-21 21:43 Mark H Weaver [this message]
2014-12-21 23:37 ` [PATCH] Optimize package-transitive-supported-systems Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=873888n0g4.fsf@netris.org \
--to=mhw@netris.org \
--cc=guix-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.