futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gexp: Reduce allocations while traversing lists.

Browse Source 
This reduces the total amount of memory allocated by 8% when running
"guix build qemu -d --no-grafts".

* guix/gexp.scm (fold/tree): New procedure.
(gexp-inputs)[interesting?]: New procedure.
[add-reference-inputs]: Change (lst ...) clause to (? pair? lst), and
use 'fold/tree' to recurse into it.
(gexp-inputs)[add-reference-output]: Likewise, and remove
plain (lst ...) clause.
Call 'fold'.
(gexp->sexp)[reference->sexp]: In the list case, avoid boxing and
recursive call when the object has a plain non-aggregate type.
This commit is contained in:
Ludovic Courtès 2021-02-19 10:18:48 +01:00
parent b57de6fea1
commit c8bd5fa59c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 49 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
guix/gexp.scm
View File

@ -1207,6 +1207,16 @@ The other arguments are as for 'derivation'."
#:substitutable? substitutable?
#:properties properties))))
(define (fold/tree proc seed lst)
"Like 'fold', but recurse into sub-lists of LST and accept improper lists."
(let loop ((obj lst)
(result seed))
(match obj
((head . tail)
(loop tail (loop head result)))
(_
(proc obj result)))))
(define (gexp-inputs exp)
"Return the list of <gexp-input> for EXP."
(define set-gexp-input-native?
@ -1214,6 +1224,10 @@ The other arguments are as for 'derivation'."
(($ <gexp-input> thing output)
(%gexp-input thing output #t))))
(define (interesting? obj)
(or (file-like? obj)
(and (string? obj) (direct-store-path? obj))))
(define (add-reference-inputs ref result)
(match ref
(($ <gexp-input> (? gexp? exp) _ #t)
@ -1230,18 +1244,23 @@ The other arguments are as for 'derivation'."
;; THING is a derivation, or a package, or an origin, etc.
(cons ref result)
result))
(($ <gexp-input> (lst ...) output n?)
(fold-right add-reference-inputs result
;; XXX: For now, automatically convert LST to a list of
;; gexp-inputs. Inherit N?.
(map (match-lambda
((? gexp-input? x)
(%gexp-input (gexp-input-thing x)
(gexp-input-output x)
n?))
(x
(%gexp-input x "out" n?)))
lst)))
(($ <gexp-input> (? pair? lst) output n?)
;; XXX: Scan LST for inputs. Inherit N?.
(fold/tree (lambda (obj result)
(match obj
((? gexp-input? x)
(cons (%gexp-input (gexp-input-thing x)
(gexp-input-output x)
n?)
result))
((? interesting? x)
(cons (%gexp-input x "out" n?) result))
((? gexp? x)
(append (gexp-inputs x) result))
(_
result)))
result
lst))
(_
;; Ignore references to other kinds of objects.
result)))
@ -1258,20 +1277,20 @@ The other arguments are as for 'derivation'."
(cons name result))
(($ <gexp-input> (? gexp? exp))
(append (gexp-outputs exp) result))
(($ <gexp-input> (lst ...) output native?)
;; XXX: Automatically convert LST.
(add-reference-output (map (match-lambda
((? gexp-input? x) x)
(x (%gexp-input x "out" native?)))
lst)
result))
((lst ...)
(fold-right add-reference-output result lst))
(($ <gexp-input> (? pair? lst))
;; XXX: Scan LST for outputs.
(fold/tree (lambda (obj result)
(match obj
(($ <gexp-output> name) (cons name result))
((? gexp? x) (append (gexp-outputs x) result))
(_ result)))
result
lst))
(_
result)))
(delete-duplicates
(add-reference-output (gexp-references exp) '())))
(fold add-reference-output '() (gexp-references exp))))
(define (gexp->sexp exp system target)
"Return (monadically) the sexp corresponding to EXP for the given OUTPUT,
@ -1291,11 +1310,14 @@ and in the current monad setting (system type, etc.)"
(mapm %store-monad
(lambda (ref)
;; XXX: Automatically convert REF to an gexp-input.
(reference->sexp
(if (gexp-input? ref)
ref
(%gexp-input ref "out" n?))
(or n? native?)))
(if (or (symbol? ref) (number? ref)
(boolean? ref) (null? ref) (array? ref))
(return ref)
(reference->sexp
(if (gexp-input? ref)
ref
(%gexp-input ref "out" n?))
(or n? native?))))
refs))
(($ <gexp-input> (? struct? thing) output n?)
(let ((target (if (or n? native?) #f target)))