me
/
guix
Archived
1
0
Fork 0
Code

records: Do not inline the constructor. 

Struct initialization uses one instruction per field, which contributes
to code bloat in the case of package modules.  With this change, the
‘.rtl-text’ section of ‘gnu/packages/tex.go’ goes from 7,334,508 B to
6,356,592 B (-13%; -7% on the whole file size), which alone is still
larger than the source file (4,2 MB).

* guix/records.scm (make-syntactic-constructor)[record-inheritance]: Use
CTOR instead of ‘make-struct/no-tail’.
Pass ABI-COOKIE as the first argument to CTOR.
(define-record-type*): Define CTOR-PROCEDURE and pass it to
‘make-syntactic-constructor’.

Change-Id: Ifd7b4e884e9fbf21c43fb4c3ad963126ef5cb476
master
Ludovic Courtès 2024-04-11 09:17:43 +02:00
parent b011ef4378
commit c14b8636fb
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 33 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
guix/records.scm
View File

@ -164,16 +164,16 @@ of TYPE matches the expansion-time ABI."
(record-error 'name s "extraneous field initializers ~a" (record-error 'name s "extraneous field initializers ~a"
unexpected))) unexpected)))
#`(make-struct/no-tail type #`(ctor #,abi-cookie
#,@(map (lambda (field index) #,@(map (lambda (field index)
(or (field-inherited-value field) (or (field-inherited-value field)
(if (innate-field? field) (if (innate-field? field)
(wrap-field-value (wrap-field-value
field (field-default-value field)) field (field-default-value field))
#`(struct-ref #,orig-record #`(struct-ref #,orig-record
#,index)))) #,index))))
'(expected ...) '(expected ...)
(iota (length '(expected ...)))))) (iota (length '(expected ...))))))
(define (thunked-field? f) (define (thunked-field? f)
(memq (syntax->datum f) 'thunked)) (memq (syntax->datum f) 'thunked))
@ -249,8 +249,8 @@ of TYPE matches the expansion-time ABI."
(cond ((lset= eq? fields '(expected ...)) (cond ((lset= eq? fields '(expected ...))
#`(let* #,(field-bindings #`(let* #,(field-bindings
#'((field value) (... ...))) #'((field value) (... ...)))
#,(abi-check #'type abi-cookie) (ctor #,abi-cookie
(ctor #,@(map field-value '(expected ...))))) #,@(map field-value '(expected ...)))))
((pair? (lset-difference eq? fields ((pair? (lset-difference eq? fields
'(expected ...))) '(expected ...)))
(record-error 'name s (record-error 'name s
@ -435,7 +435,13 @@ inherited."
(sanitizers (filter-map field-sanitizer (sanitizers (filter-map field-sanitizer
#'((field properties ...) ...))) #'((field properties ...) ...)))
(cookie (compute-abi-cookie field-spec))) (cookie (compute-abi-cookie field-spec)))
(with-syntax (((field-spec* ...) (with-syntax ((ctor-procedure
(datum->syntax
#'ctor
(symbol-append (string->symbol " %")
(syntax->datum #'ctor)
'-procedure/abi-check)))
((field-spec* ...)
(map field-spec->srfi-9 field-spec)) (map field-spec->srfi-9 field-spec))
((field-type ...) ((field-type ...)
(map (match-lambda (map (match-lambda
@ -502,7 +508,20 @@ of a record instantiation"
#'id))))))) #'id)))))))
thunked-field-accessor ... thunked-field-accessor ...
delayed-field-accessor ... delayed-field-accessor ...
(make-syntactic-constructor type syntactic-ctor ctor
(define ctor-procedure
;; This procedure is *not* inlined, to reduce code bloat
;; (struct initialization takes at least one instruction per
;; field).
(case-lambda
((cookie field ...)
(unless (eq? cookie #,cookie)
(record-abi-mismatch-error type))
(ctor field ...))
(_
(record-abi-mismatch-error type))))
(make-syntactic-constructor type syntactic-ctor ctor-procedure
(field ...) (field ...)
#:abi-cookie #,cookie #:abi-cookie #,cookie
#:thunked #,thunked #:thunked #,thunked