From d8aecf9695eb558277b967148b4eca26ca6a1f27 Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Sat, 23 May 2020 05:50:08 +0800 Subject: [PATCH] [new-aging] speed up split->owner several speed ups 1. split->owner will now cache results, bypassing gncOwnerGetOwnerFromLot and gncInvoiceGetInvoiceFromLot for repeated calls to the same split. 2. previously each call to split->owner would allocate a new gncOwner. now a new gncOwner is only allocated during a cache miss. the list of gncOwners is maintained and is purged when split->owner is called with #f. There is no need to maintain a tofree list of gncOwners anymore. 3. instead of slow gncOwnerReturnGUID to test equality, use gncOwnerEqual --- gnucash/report/reports/standard/new-aging.scm | 57 +++++++++---------- 1 file changed, 26 insertions(+), 31 deletions(-) diff --git a/gnucash/report/reports/standard/new-aging.scm b/gnucash/report/reports/standard/new-aging.scm index fe44c8330e2..f5a91569262 100644 --- a/gnucash/report/reports/standard/new-aging.scm +++ b/gnucash/report/reports/standard/new-aging.scm @@ -170,20 +170,11 @@ exist but have no suitable transactions.")) (not (or (eqv? type TXN-TYPE-INVOICE) (eqv? type TXN-TYPE-PAYMENT))))) -(define (gnc-owner-equal? a b) - (string=? (gncOwnerReturnGUID a) (gncOwnerReturnGUID b))) - (define (split-has-owner? split owner) - (let* ((split-owner (split->owner split)) - (retval (gnc-owner-equal? split-owner owner))) - (gncOwnerFree split-owner) - retval)) + (gncOwnerEqual (split->owner split) owner)) (define (split-owner-is-invalid? split) - (let* ((owner (split->owner split)) - (retval (not (gncOwnerIsValid owner)))) - (gncOwnerFree owner) - retval)) + (not (gncOwnerIsValid (split->owner split)))) (define (split-from-acct? split acct) (equal? acct (xaccSplitGetAccount split))) @@ -192,17 +183,27 @@ exist but have no suitable transactions.")) (let-values (((list-yes list-no) (partition (lambda (elt) (fn elt cmp)) lst))) (cons list-yes list-no))) -;; simpler version of gnc:owner-from-split. must be gncOwnerFree after -;; use! see split-has-owner? above... -(define (split->owner split) - (let* ((lot (xaccSplitGetLot split)) - (owner (gncOwnerNew)) - (use-lot-owner? (gncOwnerGetOwnerFromLot lot owner))) - (unless use-lot-owner? - (gncOwnerCopy (gncOwnerGetEndOwner - (gncInvoiceGetOwner (gncInvoiceGetInvoiceFromLot lot))) - owner)) - owner)) +;; optimized from gnc:owner-from-split. It will allocate and memoize +;; (cache) the owners because gncOwnerGetOwnerFromLot is slow. after +;; use, it must be called with #f to free the owners. +(define split->owner + (let ((ht (make-hash-table))) + (lambda (split) + (cond + ((not split) + (hash-for-each (lambda (k v) (gncOwnerFree v)) ht) + (hash-clear! ht)) + ((hashv-ref ht (string-hash (gncSplitGetGUID split))) => identity) + (else + (let ((lot (xaccSplitGetLot split)) + (owner (gncOwnerNew))) + (unless (gncOwnerGetOwnerFromLot lot owner) + (gncOwnerCopy (gncOwnerGetEndOwner + (gncInvoiceGetOwner + (gncInvoiceGetInvoiceFromLot lot))) + owner)) + (hashv-set! ht (string-hash (gncSplitGetGUID split)) owner) + owner)))))) (define (aging-renderer report-obj receivable) (define options (gnc:report-options report-obj)) @@ -267,8 +268,7 @@ exist but have no suitable transactions.")) (let loop ((accounts accounts) (splits splits) (accounts-and-owners '()) - (invalid-splits '()) - (tofree '())) + (invalid-splits '())) (cond ((null? accounts) @@ -345,7 +345,7 @@ exist but have no suitable transactions.")) acc-totals))))) (reverse accounts-and-owners)) - (for-each gncOwnerFree tofree) + (split->owner #f) ;free the gncOwners (gnc:html-document-add-object! document table) (unless (null? invalid-splits) @@ -371,7 +371,6 @@ exist but have no suitable transactions.")) (let lp ((acc-splits (car splits-acc-others)) (acc-totals (make-list (1+ num-buckets) 0)) (invalid-splits invalid-splits) - (tofree tofree) (owners-and-aging '())) (match acc-splits @@ -382,8 +381,7 @@ exist but have no suitable transactions.")) accounts-and-owners (cons (list account owners-and-aging acc-totals) accounts-and-owners)) - invalid-splits - tofree)) + invalid-splits)) ;; txn type != TXN_TYPE_INVOICE or TXN_TYPE_PAYMENT. (((? split-is-not-business? this) . rest) @@ -392,7 +390,6 @@ exist but have no suitable transactions.")) acc-totals (cons (list (format #f (_ "Invalid Txn Type ~a") type) this) invalid-splits) - tofree owners-and-aging))) ;; some payment splits may have no owner in this @@ -402,7 +399,6 @@ exist but have no suitable transactions.")) (lp rest acc-totals (cons (list (_ "Payment has no owner") this) invalid-splits) - tofree owners-and-aging)) ((this . _) @@ -416,7 +412,6 @@ exist but have no suitable transactions.")) (lp other-owner-splits (map + acc-totals (reverse (cons aging-total aging))) invalid-splits - (cons owner tofree) (if (or show-zeros (any (negate zero?) aging)) (cons (list owner aging aging-total) owners-and-aging) owners-and-aging)))))))))))))