From 5dbdfe1133ecaf0fef1613d927eb9a586440a416 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 24 Mar 2019 17:35:19 +0000 Subject: Switch parts of the comparison code to use hash tables Rather than vhashes. This removes the need for the expensive vhash-delete calls. --- guix-data-service/comparison.scm | 114 ++++++++++++++++++++------------------- 1 file changed, 58 insertions(+), 56 deletions(-) (limited to 'guix-data-service/comparison.scm') diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm index 1a12005..3e0bfe9 100644 --- a/guix-data-service/comparison.scm +++ b/guix-data-service/comparison.scm @@ -119,44 +119,43 @@ ORDER BY base_packages.name DESC, base_packages.version, target_packages.name, t #:targets (if (null? targets) #f targets) #: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) (let ((key (cons name (first details)))) - (vhash-cons key - (cons (cdr details) - (or (and=> (vhash-assoc key result) cdr) - '())) - (vhash-delete key result)))) - vlist-null + (hash-set! result + key + (cons (cdr details) + (or (hash-ref result key) + '()))) + result)) + (make-hash-table) vhash)) (define (package-data-vhashes->new-packages base-packages-vhash target-packages-vhash) - (map - (match-lambda + (hash-map->list + (match-lambda* (((name . version) metadata ...) `((name . ,name) (version . ,version)))) - (vlist->list - (package-data-vhash->package-name-and-version-vhash - (vlist-filter (match-lambda - ((name . details) - (not (vhash-assoc name base-packages-vhash)))) - target-packages-vhash))))) + (package-data-vhash->package-name-and-version-hash-table + (vlist-filter (match-lambda + ((name . details) + (not (vhash-assoc name base-packages-vhash)))) + target-packages-vhash)))) (define (package-data-vhashes->removed-packages base-packages-vhash target-packages-vhash) - (map - (match-lambda + (hash-map->list + (match-lambda* (((name . version) metadata ...) `((name . ,name) (version . ,version)))) - (vlist->list - (package-data-vhash->package-name-and-version-vhash - (vlist-filter (match-lambda - ((name . details) - (not (vhash-assoc name target-packages-vhash)))) - base-packages-vhash))))) - -(define (package-data-vhash->package-versions-vhash package-data-vhash) + (package-data-vhash->package-name-and-version-hash-table + (vlist-filter (match-lambda + ((name . details) + (not (vhash-assoc name target-packages-vhash)))) + base-packages-vhash)))) + +(define (package-data-vhash->package-versions-hash-table package-data-vhash) (define (system-and-target (vhash-assoc name result) cdr) + (known-versions (or (hash-ref result name) '()))) - (vhash-cons name - (add-version-system-and-target-to-alist known-versions - details) - (vhash-delete name result)))) - vlist-null + (hash-set! result + name + (add-version-system-and-target-to-alist known-versions + details)) + result)) + (make-hash-table) package-data-vhash)) (define (package-data-version-changes base-packages-vhash target-packages-vhash) - (let ((base-versions (package-data-vhash->package-versions-vhash - base-packages-vhash)) - (target-versions (package-data-vhash->package-versions-vhash - target-packages-vhash))) - (vhash-fold (lambda (name target-versions result) - (let ((base-versions (and=> (vhash-assoc name base-versions) - cdr))) - (if base-versions - (begin - (if (equal? base-versions target-versions) - result - `((,name . ((base . ,(list->vector - (map car base-versions))) - (target . ,(list->vector - (map car target-versions))))) - ,@result))) - result))) - '() - target-versions))) + (let ((base-versions + (package-data-vhash->package-versions-hash-table + base-packages-vhash)) + (target-versions + (package-data-vhash->package-versions-hash-table + target-packages-vhash))) + + (hash-fold (lambda (name target-versions result) + (let ((base-versions (hash-ref base-versions name))) + (if base-versions + (let ((base-version-numbers (map car base-versions)) + (target-version-numbers (map car target-versions))) + (if (equal? base-version-numbers target-version-numbers) + result + (cons + `(,name . ((base . ,(list->vector base-version-numbers)) + (target . ,(list->vector target-version-numbers)))) + result))) + result))) + '() + target-versions))) (define (package-data-derivation-changes base-packages-vhash target-packages-vhash) (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 - (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) (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))))) (list->vector - (vhash-fold + (hash-fold (lambda (name-and-version target-packages-entry result) (let ((base-packages-entry - (vhash-assoc name-and-version - base-package-details-by-name-and-version))) + (hash-ref base-package-details-by-name-and-version + name-and-version))) (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))) (if (equal? base-derivations target-derivations) result -- cgit v1.2.3