From ef1432f064abeb9f902c6917c540e143492a5de4 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 21 Jun 2021 12:21:19 +0200
Subject: utils: Add 'go-to-location' with source location caching.

* guix/utils.scm (%source-location-map): New variable.
(go-to-location): New procedure.
(edit-expression): Use it instead of custom loop.
* guix/packages.scm (package-field-location)[goto]: Remove.
Use 'go-to-location' instead of 'goto'.
---
 guix/packages.scm |  8 +------
 guix/utils.scm    | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 63 insertions(+), 11 deletions(-)

(limited to 'guix')

diff --git a/guix/packages.scm b/guix/packages.scm
index 2df4c79672..610683575c 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -514,12 +514,6 @@ object."
 (define (package-field-location package field)
   "Return the source code location of the definition of FIELD for PACKAGE, or
 #f if it could not be determined."
-  (define (goto port line column)
-    (unless (and (= (port-column port) (- column 1))
-                 (= (port-line port) (- line 1)))
-      (unless (eof-object? (read-char port))
-        (goto port line column))))
-
   (match (package-location package)
     (($ <location> file line column)
      (match (search-path %load-path file)
@@ -529,7 +523,7 @@ object."
             ;; In general we want to keep relative file names for modules.
             (call-with-input-file file-found
               (lambda (port)
-                (goto port line column)
+                (go-to-location port line column)
                 (match (read port)
                   (('package inits ...)
                    (let ((field (assoc field inits)))
diff --git a/guix/utils.scm b/guix/utils.scm
index a13b13c4fa..f8f6672bb1 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -49,6 +49,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module ((ice-9 iconv) #:prefix iconv:)
+  #:use-module (ice-9 vlist)
   #:autoload   (zlib) (make-zlib-input-port make-zlib-output-port)
   #:use-module (system foreign)
   #:re-export (<location>                         ;for backwards compatibility
@@ -117,6 +118,7 @@
             cache-directory
 
             readlink*
+            go-to-location
             edit-expression
 
             filtered-port
@@ -337,6 +339,65 @@ a list of command-line arguments passed to the compression program."
         (unless (every (compose zero? cdr waitpid) pids)
           (error "compressed-output-port failure" pids))))))
 
+(define %source-location-map
+  ;; Maps inode/device tuples to "source location maps" used by
+  ;; 'go-to-location'.
+  (make-hash-table))
+
+(define (go-to-location port line column)
+  "Jump to LINE and COLUMN (both one-indexed) in PORT.  Maintain a source
+location map such that this can boil down to seek(2) and a few read(2) calls,
+which can drastically speed up repetitive operations on large files."
+  (let* ((stat       (stat port))
+         (key        (list (stat:ino stat) (stat:dev stat)))
+         (stamp      (list (stat:mtime stat) (stat:mtimensec stat)
+                           (stat:size stat)))
+
+         ;; Look for an up-to-date source map for KEY.  The map is a vlist
+         ;; where each entry gives the byte offset of the beginning of a line:
+         ;; element 0 is the offset of the first line, element 1 the offset of
+         ;; the second line, etc.  The map is filled lazily.
+         (source-map (match (hash-ref %source-location-map key)
+                       (#f
+                        (vlist-cons 0 vlist-null))
+                       ((cache-stamp ... map)
+                        (if (equal? cache-stamp stamp) ;invalidate?
+                            map
+                            (vlist-cons 0 vlist-null)))))
+         (last       (vlist-length source-map)))
+    ;; Jump to LINE, ideally via SOURCE-MAP.
+    (if (<= line last)
+        (seek port (vlist-ref source-map (- line 1)) SEEK_SET)
+        (let ((target line)
+              (offset (vlist-ref source-map (- last 1))))
+          (seek port offset SEEK_SET)
+          (let loop ((source-map (vlist-reverse source-map))
+                     (line last))
+            (if (< line target)
+                (match (read-char port)
+                  (#\newline
+                   (loop (vlist-cons (ftell port) source-map)
+                         (+ 1 line)))
+                  ((? eof-object?)
+                   (error "unexpected end of file" port line))
+                  (chr (loop source-map line)))
+                (hash-set! %source-location-map key
+                           `(,@stamp
+                             ,(vlist-reverse source-map)))))))
+
+    ;; Read up to COLUMN.
+    (let ((target column))
+      (let loop ((column 1))
+        (when (< column target)
+          (match (read-char port)
+            (#\newline (error "unexpected end of line" port))
+            (#\tab (loop (+ 8 column)))
+            (chr (loop (+ 1 column)))))))
+
+    ;; Update PORT's position info.
+    (set-port-line! port (- line 1))
+    (set-port-column! port (- column 1))))
+
 (define* (edit-expression source-properties proc #:key (encoding "UTF-8"))
   "Edit the expression specified by SOURCE-PROPERTIES using PROC, which should
 be a procedure that takes the original expression in string and returns a new
@@ -350,10 +411,7 @@ This procedure returns #t on success."
     (call-with-input-file file
       (lambda (in)
         (let* ( ;; The start byte position of the expression.
-               (start  (begin (while (not (and (= line (port-line in))
-                                               (= column (port-column in))))
-                                (when (eof-object? (read-char in))
-                                  (error (format #f "~a: end of file~%" in))))
+               (start  (begin (go-to-location in (+ 1 line) (+ 1 column))
                               (ftell in)))
                ;; The end byte position of the expression.
                (end    (begin (read in) (ftell in))))
-- 
cgit v1.2.3