From: "Ludovic Courtès" <ludo@gnu.org>
To: 49169@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#49169] [PATCH 08/11] utils: Add 'go-to-location' with source location caching.
Date: Tue, 22 Jun 2021 11:08:27 +0200 [thread overview]
Message-ID: <20210622090830.15561-8-ludo@gnu.org> (raw)
In-Reply-To: <20210622090830.15561-1-ludo@gnu.org>
* 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(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index 4ac1624ce2..d15a17edc0 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))))
--
2.32.0
next prev parent reply other threads:[~2021-06-22 9:10 UTC|newest]
Thread overview: 40+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-06-22 9:02 [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 01/11] records: Support field sanitizers Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 02/11] packages: Allow inputs to be plain package lists Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 03/11] lint: Add 'input-labels' checker Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 04/11] packages: Add 'lookup-package-input' & co Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 05/11] packages: Add 'modify-inputs' Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 06/11] gnu: Change inputs of core packages to plain lists Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 07/11] utils: 'edit-expression' no longer leaks file ports Ludovic Courtès
2021-06-22 9:08 ` Ludovic Courtès [this message]
2021-06-22 9:08 ` [bug#49169] [PATCH 09/11] utils: 'edit-expression' modifies the file only if necessary Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 10/11] utils: 'edit-expression' copies part of the original source map Ludovic Courtès
2021-06-22 9:08 ` [bug#49169] [PATCH 11/11] Add 'guix style' Ludovic Courtès
2021-06-22 9:09 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Ludovic Courtès
2021-06-27 18:37 ` Christopher Baines
2021-06-28 9:54 ` Ludovic Courtès
2021-06-27 11:00 ` Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 00/16] " Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 01/16] records: Support field sanitizers Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 02/16] packages: Allow inputs to be plain package lists Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 03/16] lint: Add 'input-labels' checker Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 04/16] packages: Add 'lookup-package-input' & co Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 05/16] packages: Add 'modify-inputs' Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 06/16] gnu: Change inputs of core packages to plain lists Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 07/16] utils: 'edit-expression' no longer leaks file ports Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 08/16] utils: Add 'go-to-location' with source location caching Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 09/16] utils: 'edit-expression' modifies the file only if necessary Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 10/16] utils: 'edit-expression' copies part of the original source map Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 11/16] Add 'guix style' Ludovic Courtès
2021-07-01 14:13 ` zimoun
2021-06-30 20:48 ` [bug#49169] [PATCH v2 12/16] packages: 'hidden-package' inherits the original package location Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 13/16] import: pypi: Emit new-style package inputs Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 14/16] import: cran: " Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 15/16] import: print: Emit new-style package inputs when possible Ludovic Courtès
2021-06-30 20:48 ` [bug#49169] [PATCH v2 16/16] import: elpa: Emit new-style package inputs Ludovic Courtès
2021-07-10 4:53 ` [bug#49169] [PATCH 00/11] Removing input labels from package definitions Sarah Morgensen via Guix-patches via
2021-07-10 13:45 ` Ludovic Courtès
2021-07-10 23:15 ` Ludovic Courtès
2021-07-12 6:15 ` Sarah Morgensen via Guix-patches via
2021-07-12 8:47 ` Ludovic Courtès
2021-07-10 23:11 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210622090830.15561-8-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=49169@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).