01/08: packages: Store 'location' field as a literal vector.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 10c981b1355df694b277a812cd8beb7cd60d1ea6
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Sep 7 18:04:21 2021 +0200

    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.
---
 guix/packages.scm | 38 ++++++++++++++++++++++++++++++++++----
 1 file changed, 34 insertions(+), 4 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index c825f42..01de50e 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -360,6 +360,30 @@ name of its URI."
   ;; <https://lists.gnu.org/archive/html/guix-devel/2017-03/msg00790.html>.
   (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.
 (define-record-type* <package>
@@ -404,10 +428,9 @@ name of its URI."
 
   (properties package-properties (default '()))   ; alist for anything else
 
-  (location package-location
-            (default (and=> (current-source-location)
-                            source-properties->location))
-            (innate)))
+  (location package-location-vector
+            (default (current-location-vector))
+            (innate) (sanitize sanitize-location)))
 
 (set-record-type-printer! <package>
                           (lambda (package port)
@@ -425,6 +448,13 @@ name of its URI."
                                                        package)
                                                       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 ...)
   "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