diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-10-26 10:46:12 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-10-26 12:46:27 +0200 |
| commit | b7b0ac85443c719a616edee6963578e58396f339 (patch) | |
| tree | d4a75f94d1c573989618f2a43872ccc6df747779 /guix/packages.scm | |
| parent | b7a36599b4533db35e27e0fc5506589fb7c8221f (diff) | |
| download | guix-b7b0ac85443c719a616edee6963578e58396f339.tar guix-b7b0ac85443c719a616edee6963578e58396f339.tar.gz | |
packages: Optimize 'package-transitive-supported-systems'.
With this change, the wall-clock time of:
./pre-inst-env guile -c '(use-modules (gnu) (guix)(ice-9 time)) (time (pk (fold-packages (lambda (p r)(supported-package? p)(+ 1 r)) 0)))'
goes from 3.2s to 2.0s, a 37% improvement.
* guix/packages.scm (package-transitive-supported-systems): Change
'supported-systems' to 'supported-systems-procedure', returning an
'mlambdaq' instead of the original 'mlambda'. Add 'procs'. Adjust body
accordingly.
Diffstat (limited to 'guix/packages.scm')
| -rw-r--r-- | guix/packages.scm | 39 |
1 files changed, 26 insertions, 13 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index b99689b9a4..780c6ddb65 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1018,23 +1018,36 @@ in INPUTS and their transitive propagated inputs." (define package-transitive-supported-systems (let () - (define supported-systems - (mlambda (package system) - (parameterize ((%current-system system)) - (fold (lambda (input systems) - (match input - ((label (? package? package) . _) - (lset-intersection string=? systems - (supported-systems package system))) - (_ - systems))) - (package-supported-systems package) - (bag-direct-inputs (package->bag package)))))) + (define (supported-systems-procedure system) + (define supported-systems + (mlambdaq (package) + (parameterize ((%current-system system)) + (fold (lambda (input systems) + (match input + ((label (? package? package) . _) + (lset-intersection string=? systems + (supported-systems package))) + (_ + systems))) + (package-supported-systems package) + (bag-direct-inputs (package->bag package)))))) + + supported-systems) + + (define procs + ;; Map system strings to one-argument procedures. This allows these + ;; procedures to have fast 'eq?' memoization on their argument. + (make-hash-table)) (lambda* (package #:optional (system (%current-system))) "Return the intersection of the systems supported by PACKAGE and those supported by its dependencies." - (supported-systems package system)))) + (match (hash-ref procs system) + (#f + (hash-set! procs system (supported-systems-procedure system)) + (package-transitive-supported-systems package system)) + (proc + (proc package)))))) (define* (supported-package? package #:optional (system (%current-system))) "Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its |