packages: Reduce bloat induced by ‘sanitize-inputs’.

At -O1, peval does the bulk of the optimization work and it cannot
reduce things like (null? (list 1 2)), unlike what happens in CPS at
-O2.  Thus, reduce the part of ‘sanitize-inputs’ that’s inlined.

* guix/packages.scm (maybe-add-input-labels): New procedure.
(sanitize-inputs): Turn into a macro; use ‘maybe-add-input-labels’.

Change-Id: Id2283bb5a2f5d714722200bdcfe0b0bfa606923f
This commit is contained in:
Ludovic Courtès 2024-04-08 23:09:36 +02:00
parent 2f93e1682a
commit b011ef4378
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

View File

@ -429,15 +429,26 @@ from forcing GEXP-PROMISE."
;; <https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00790.html>. ;; <https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00790.html>.
(fold delete %supported-systems '("mips64el-linux" "powerpc-linux" "riscv64-linux"))) (fold delete %supported-systems '("mips64el-linux" "powerpc-linux" "riscv64-linux")))
(define-inlinable (sanitize-inputs inputs) (define (maybe-add-input-labels inputs)
"Sanitize INPUTS by turning it into a list of name/package tuples if it's "Add labels to INPUTS unless it already has them."
not already the case." (cond ((null? inputs)
(cond ((null? inputs) inputs) inputs)
((and (pair? (car inputs)) ((and (pair? (car inputs))
(string? (caar inputs))) (string? (caar inputs)))
inputs) inputs)
(else (map add-input-label inputs)))) (else (map add-input-label inputs))))
(define-syntax sanitize-inputs
;; This is written as a macro rather than as a 'define-inlinable' procedure
;; because as of Guile 3.0.9, peval can handle (null? '()) but not
;; (null? (list x y z)); that residual 'null?' test contributes to code
;; bloat.
(syntax-rules (quote)
"Sanitize INPUTS by turning it into a list of name/package tuples if it's
not already the case."
((_ '()) '())
((_ inputs) (maybe-add-input-labels inputs))))
(define-syntax current-location-vector (define-syntax current-location-vector
(lambda (s) (lambda (s)
"Like 'current-source-location' but expand to a literal vector with "Like 'current-source-location' but expand to a literal vector with