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

82
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
key
(cons (cdr details) (cons (cdr details)
(or (and=> (vhash-assoc key result) cdr) (or (hash-ref result key)
'())) '())))
(vhash-delete key result)))) result))
vlist-null (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
name
(add-version-system-and-target-to-alist known-versions (add-version-system-and-target-to-alist known-versions
details) details))
(vhash-delete name result)))) result))
vlist-null (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
(package-data-vhash->package-versions-hash-table
base-packages-vhash)) base-packages-vhash))
(target-versions (package-data-vhash->package-versions-vhash (target-versions
(package-data-vhash->package-versions-hash-table
target-packages-vhash))) target-packages-vhash)))
(vhash-fold (lambda (name target-versions result)
(let ((base-versions (and=> (vhash-assoc name base-versions) (hash-fold (lambda (name target-versions result)
cdr))) (let ((base-versions (hash-ref base-versions name)))
(if base-versions (if base-versions
(begin (let ((base-version-numbers (map car base-versions))
(if (equal? base-versions target-versions) (target-version-numbers (map car target-versions)))
(if (equal? base-version-numbers target-version-numbers)
result result
`((,name . ((base . ,(list->vector (cons
(map car base-versions))) `(,name . ((base . ,(list->vector base-version-numbers))
(target . ,(list->vector (target . ,(list->vector target-version-numbers))))
(map car target-versions))))) result)))
,@result)))
result))) result)))
'() '()
target-versions))) 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