From mboxrd@z Thu Jan 1 00:00:00 1970 From: Mark H Weaver Subject: [PATCH] Optimize package-transitive-supported-systems Date: Sun, 21 Dec 2014 16:43:23 -0500 Message-ID: <873888n0g4.fsf@netris.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:52783) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y2oHZ-0007At-Ku for guix-devel@gnu.org; Sun, 21 Dec 2014 16:43:26 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Y2oHV-0002mP-5z for guix-devel@gnu.org; Sun, 21 Dec 2014 16:43:21 -0500 Received: from world.peace.net ([50.252.239.5]:48278) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Y2oHV-0002lI-1H for guix-devel@gnu.org; Sun, 21 Dec 2014 16:43:17 -0500 List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0001-Optimize-package-transitive-supported-systems.patch Content-Transfer-Encoding: quoted-printable Content-Description: [PATCH] Optimize package-transitive-supported-systems >From 90541f6c7e2a9e2f8a7b412532b4b5a56a10e481 Mon Sep 17 00:00:00 2001 From: Mark H Weaver 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 =C2=A9 2012, 2013, 2014 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -543,40 +544,38 @@ for the host system (\"native inputs\"), and not targ= et inputs." recursively." (transitive-inputs (package-propagated-inputs package))) =20 -(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)))))) =20 -(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=3D? 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=3D? - 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=3D? systems (package-transitive-supported-systems p))) + (_ + systems))) + (package-supported-systems package) + (package-direct-inputs package))) =20 (define (bag-transitive-inputs bag) "Same as 'package-transitive-inputs', but applied to a bag." --=20 2.1.2 --=-=-=--