packages: Store 'location' field as a literal vector.
This is slightly more efficient than storing an alist in terms of .go file size (< 1% smaller) and load time. * guix/packages.scm (current-location-vector): New macro. (sanitize-location): New procedure. (<package>)[location]: Change 'default' and add 'sanitize'. (package-location): New procedure.master
parent
53f54d4aa2
commit
10c981b135
|
@ -360,6 +360,30 @@ name of its URI."
|
||||||
;; <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")))
|
(fold delete %supported-systems '("mips64el-linux")))
|
||||||
|
|
||||||
|
(define-syntax current-location-vector
|
||||||
|
(lambda (s)
|
||||||
|
"Like 'current-source-location' but expand to a literal vector with
|
||||||
|
one-indexed line numbers."
|
||||||
|
;; Storing a literal vector in .go files is more efficient than storing an
|
||||||
|
;; alist: less initialization code, fewer relocations, etc.
|
||||||
|
(syntax-case s ()
|
||||||
|
((_)
|
||||||
|
(match (syntax-source s)
|
||||||
|
(#f #f)
|
||||||
|
(properties
|
||||||
|
(let ((file (assq-ref properties 'filename))
|
||||||
|
(line (assq-ref properties 'line))
|
||||||
|
(column (assq-ref properties 'column)))
|
||||||
|
(and file line column
|
||||||
|
#`#(#,file #,(+ 1 line) #,column)))))))))
|
||||||
|
|
||||||
|
(define-inlinable (sanitize-location loc)
|
||||||
|
;; Convert LOC to a vector or to #f.
|
||||||
|
(cond ((vector? loc) loc)
|
||||||
|
((not loc) loc)
|
||||||
|
(else (vector (location-file loc)
|
||||||
|
(location-line loc)
|
||||||
|
(location-column loc)))))
|
||||||
|
|
||||||
;; A package.
|
;; A package.
|
||||||
(define-record-type* <package>
|
(define-record-type* <package>
|
||||||
|
@ -404,10 +428,9 @@ name of its URI."
|
||||||
|
|
||||||
(properties package-properties (default '())) ; alist for anything else
|
(properties package-properties (default '())) ; alist for anything else
|
||||||
|
|
||||||
(location package-location
|
(location package-location-vector
|
||||||
(default (and=> (current-source-location)
|
(default (current-location-vector))
|
||||||
source-properties->location))
|
(innate) (sanitize sanitize-location)))
|
||||||
(innate)))
|
|
||||||
|
|
||||||
(set-record-type-printer! <package>
|
(set-record-type-printer! <package>
|
||||||
(lambda (package port)
|
(lambda (package port)
|
||||||
|
@ -425,6 +448,13 @@ name of its URI."
|
||||||
package)
|
package)
|
||||||
16)))))
|
16)))))
|
||||||
|
|
||||||
|
(define (package-location package)
|
||||||
|
"Return the source code location of PACKAGE as a <location> record, or #f if
|
||||||
|
it is not known."
|
||||||
|
(match (package-location-vector package)
|
||||||
|
(#f #f)
|
||||||
|
(#(file line column) (location file line column))))
|
||||||
|
|
||||||
(define-syntax-rule (package/inherit p overrides ...)
|
(define-syntax-rule (package/inherit p overrides ...)
|
||||||
"Like (package (inherit P) OVERRIDES ...), except that the same
|
"Like (package (inherit P) OVERRIDES ...), except that the same
|
||||||
transformation is done to the package P's replacement, if any. P must be a bare
|
transformation is done to the package P's replacement, if any. P must be a bare
|
||||||
|
|
Reference in New Issue