cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Switch parts of the comparison code to use hash tables

Browse source 
Rather than vhashes. This removes the need for the expensive vhash-delete
calls.
This commit is contained in:
Christopher Baines 2019-03-24 17:35:19 +00:00
parent 800c850276
commit 5dbdfe1133
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577
1 changed files with 57 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

112
guix-data-service/comparison.scm
View file

@ -119,44 +119,43 @@ ORDER BY base_packages.name DESC, base_packages.version, target_packages.name, t
#:targets (if (null? targets) #f targets) #:targets (if (null? targets) #f targets)
#:build-statuses (if (null? build-statuses) #f build-statuses))))) #:build-statuses (if (null? build-statuses) #f build-statuses)))))
(define (package-data-vhash->package-name-and-version-vhash vhash) (define (package-data-vhash->package-name-and-version-hash-table vhash)
(vhash-fold (lambda (name details result) (vhash-fold (lambda (name details result)
(let ((key (cons name (first details)))) (let ((key (cons name (first details))))
(vhash-cons key (hash-set! result
(cons (cdr details) key
(or (and=> (vhash-assoc key result) cdr) (cons (cdr details)
'())) (or (hash-ref result key)
(vhash-delete key result)))) '())))
vlist-null result))
(make-hash-table)
vhash)) vhash))
(define (package-data-vhashes->new-packages base-packages-vhash target-packages-vhash) (define (package-data-vhashes->new-packages base-packages-vhash target-packages-vhash)
(map (hash-map->list
(match-lambda (match-lambda*
(((name . version) metadata ...) (((name . version) metadata ...)
`((name . ,name) `((name . ,name)
(version . ,version)))) (version . ,version))))
(vlist->list (package-data-vhash->package-name-and-version-hash-table
(package-data-vhash->package-name-and-version-vhash (vlist-filter (match-lambda
(vlist-filter (match-lambda ((name . details)
((name . details) (not (vhash-assoc name base-packages-vhash))))
(not (vhash-assoc name base-packages-vhash)))) target-packages-vhash))))
target-packages-vhash)))))
(define (package-data-vhashes->removed-packages base-packages-vhash target-packages-vhash) (define (package-data-vhashes->removed-packages base-packages-vhash target-packages-vhash)
(map (hash-map->list
(match-lambda (match-lambda*
(((name . version) metadata ...) (((name . version) metadata ...)
`((name . ,name) `((name . ,name)
(version . ,version)))) (version . ,version))))
(vlist->list (package-data-vhash->package-name-and-version-hash-table
(package-data-vhash->package-name-and-version-vhash (vlist-filter (match-lambda
(vlist-filter (match-lambda ((name . details)
((name . details) (not (vhash-assoc name target-packages-vhash))))
(not (vhash-assoc name target-packages-vhash)))) base-packages-vhash))))
base-packages-vhash)))))
(define (package-data-vhash->package-versions-vhash package-data-vhash) (define (package-data-vhash->package-versions-hash-table package-data-vhash)
(define (system-and-target<? a b) (define (system-and-target<? a b)
(if (string=? (car a) (car b)) (if (string=? (car a) (car b))
(string<? (cdr a) (cdr b)) (string<? (cdr a) (cdr b))
@ -174,42 +173,45 @@ ORDER BY base_packages.name DESC, base_packages.version, target_packages.name, t
(vhash-fold (lambda (name details result) (vhash-fold (lambda (name details result)
(let ((version (first details)) (let ((version (first details))
(known-versions (or (and=> (vhash-assoc name result) cdr) (known-versions (or (hash-ref result name)
'()))) '())))
(vhash-cons name (hash-set! result
(add-version-system-and-target-to-alist known-versions name
details) (add-version-system-and-target-to-alist known-versions
(vhash-delete name result)))) details))
vlist-null result))
(make-hash-table)
package-data-vhash)) package-data-vhash))
(define (package-data-version-changes base-packages-vhash target-packages-vhash) (define (package-data-version-changes base-packages-vhash target-packages-vhash)
(let ((base-versions (package-data-vhash->package-versions-vhash (let ((base-versions
base-packages-vhash)) (package-data-vhash->package-versions-hash-table
(target-versions (package-data-vhash->package-versions-vhash base-packages-vhash))
target-packages-vhash))) (target-versions
(vhash-fold (lambda (name target-versions result) (package-data-vhash->package-versions-hash-table
(let ((base-versions (and=> (vhash-assoc name base-versions) target-packages-vhash)))
cdr)))
(if base-versions (hash-fold (lambda (name target-versions result)
(begin (let ((base-versions (hash-ref base-versions name)))
(if (equal? base-versions target-versions) (if base-versions
result (let ((base-version-numbers (map car base-versions))
`((,name . ((base . ,(list->vector (target-version-numbers (map car target-versions)))
(map car base-versions))) (if (equal? base-version-numbers target-version-numbers)
(target . ,(list->vector result
(map car target-versions))))) (cons
,@result))) `(,name . ((base . ,(list->vector base-version-numbers))
result))) (target . ,(list->vector target-version-numbers))))
'() result)))
target-versions))) result)))
'()
target-versions)))
(define (package-data-derivation-changes base-packages-vhash target-packages-vhash) (define (package-data-derivation-changes base-packages-vhash target-packages-vhash)
(define base-package-details-by-name-and-version (define base-package-details-by-name-and-version
(package-data-vhash->package-name-and-version-vhash base-packages-vhash)) (package-data-vhash->package-name-and-version-hash-table base-packages-vhash))
(define target-package-details-by-name-and-version (define target-package-details-by-name-and-version
(package-data-vhash->package-name-and-version-vhash target-packages-vhash)) (package-data-vhash->package-name-and-version-hash-table target-packages-vhash))
(define (derivation-system-and-target-list->alist lst) (define (derivation-system-and-target-list->alist lst)
(if (null? lst) (if (null? lst)
@ -222,13 +224,13 @@ ORDER BY base_packages.name DESC, base_packages.version, target_packages.name, t
,@(derivation-system-and-target-list->alist (cdr lst))))) ,@(derivation-system-and-target-list->alist (cdr lst)))))
(list->vector (list->vector
(vhash-fold (hash-fold
(lambda (name-and-version target-packages-entry result) (lambda (name-and-version target-packages-entry result)
(let ((base-packages-entry (let ((base-packages-entry
(vhash-assoc name-and-version (hash-ref base-package-details-by-name-and-version
base-package-details-by-name-and-version))) name-and-version)))
(if base-packages-entry (if base-packages-entry
(let ((base-derivations (map cdr (cdr base-packages-entry))) (let ((base-derivations (map cdr base-packages-entry))
(target-derivations (map cdr target-packages-entry))) (target-derivations (map cdr target-packages-entry)))
(if (equal? base-derivations target-derivations) (if (equal? base-derivations target-derivations)
result result