15/15: gexp: Reduce allocations in 'gexp-attribute'.

[guix-commits]

civodul pushed a commit to branch wip-build-systems-gexp
in repository guix.

commit 0ffad81025dd34a613befd6c5a328c1394aaa0a8
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Feb 23 14:19:48 2021 +0100

    gexp: Reduce allocations in 'gexp-attribute'.
    
    * guix/gexp.scm (gexp-attribute): Use 'fold' and 'fold/tree' instead of
    'append-map'.
---
 guix/gexp.scm | 35 ++++++++++++++++++++++-------------
 1 file changed, 22 insertions(+), 13 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 8f49a0b..bab964a 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -759,19 +759,28 @@ attribute that is traversed."
        (append (let ((attribute (self-attribute gexp)))
                  (validate gexp attribute)
                  attribute)
-               (append-map (match-lambda
-                             (($ <gexp-input> (? gexp? exp))
-                              (gexp-attribute exp self-attribute
-                                              #:validate validate))
-                             (($ <gexp-input> (lst ...))
-                              (append-map (lambda (item)
-                                            (gexp-attribute item self-attribute
-                                                            #:validate
-                                                            validate))
-                                          lst))
-                             (_
-                              '()))
-                           (gexp-references gexp)))
+               (reverse
+                (fold (lambda (input result)
+                        (match input
+                          (($ <gexp-input> (? gexp? exp))
+                           (append (gexp-attribute exp self-attribute
+                                                   #:validate validate)
+                                   result))
+                          (($ <gexp-input> (lst ...))
+                           (fold/tree (lambda (obj result)
+                                        (match obj
+                                          ((? gexp? exp)
+                                           (append (gexp-attribute exp 
self-attribute
+                                                                   #:validate 
validate)
+                                                   result))
+                                          (_
+                                           result)))
+                                      result
+                                      lst))
+                          (_
+                           result)))
+                      '()
+                      (gexp-references gexp))))
        equal?)
       '()))                                       ;plain Scheme data type