unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 49169@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#49169] [PATCH 10/11] utils: 'edit-expression' copies part of the original source map.
Date: Tue, 22 Jun 2021 11:08:29 +0200	[thread overview]
Message-ID: <20210622090830.15561-10-ludo@gnu.org> (raw)
In-Reply-To: <20210622090830.15561-1-ludo@gnu.org>

* guix/utils.scm (source-location-key/stamp): New procedure.
(go-to-location): Use it.
(move-source-location-map!): New procedure.
(edit-expression): Call it.
---
 guix/utils.scm | 37 ++++++++++++++++++++++++++++++++-----
 1 file changed, 32 insertions(+), 5 deletions(-)

diff --git a/guix/utils.scm b/guix/utils.scm
index e6d0761679..65d709a01f 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -34,6 +34,7 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-39)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 ftw)
   #:use-module (rnrs io ports)                    ;need 'port-position' etc.
   #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
@@ -344,14 +345,20 @@ a list of command-line arguments passed to the compression program."
   ;; 'go-to-location'.
   (make-hash-table))
 
-(define (go-to-location port line column)
+(define (source-location-key/stamp stat)
+  "Return two values: the key for STAT in %SOURCE-LOCATION-MAP, and a stamp
+used to invalidate corresponding entries."
+  (let ((key   (list (stat:ino stat) (stat:dev stat)))
+        (stamp (list (stat:mtime stat) (stat:mtimensec stat)
+                     (stat:size stat))))
+    (values key stamp)))
+
+(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)))
+         (key stamp  (source-location-key/stamp 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:
@@ -398,6 +405,20 @@ which can drastically speed up repetitive operations on large files."
     (set-port-line! port (- line 1))
     (set-port-column! port (- column 1))))
 
+(define (move-source-location-map! source target line)
+  "Move the source location map from SOURCE up to LINE to TARGET.  SOURCE and
+TARGET must be stat buffers as returned by 'stat'."
+  (let* ((source-key (source-location-key/stamp source))
+         (target-key target-stamp (source-location-key/stamp target)))
+    (match (hash-ref %source-location-map source-key)
+      (#f #t)
+      ((_ ... source-map)
+       ;; Strip the source map and update the associated stamp.
+       (let ((source-map (vlist-take source-map (max line 1))))
+         (hash-remove! %source-location-map source-key)
+         (hash-set! %source-location-map target-key
+                    `(,@target-stamp ,source-map)))))))
+
 (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
@@ -435,7 +456,13 @@ This procedure returns #t on success."
                   ;; post-bv maybe the end-of-file object.
                   (when (not (eof-object? post-bv))
                     (put-bytevector out post-bv))
-                  #t)))))))))
+                  #t))
+
+              ;; Due to 'with-atomic-file-output', IN and FILE no longer share
+              ;; the same inode, but we can reassign the source map up to LINE
+              ;; to the new file.
+              (move-source-location-map! (stat in) (stat file)
+                                         (+ 1 line)))))))))
 
 \f
 ;;;
-- 
2.32.0





  parent reply	other threads:[~2021-06-22  9:12 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   ` [bug#49169] [PATCH 08/11] utils: Add 'go-to-location' with source location caching Ludovic Courtès
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   ` Ludovic Courtès [this message]
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-10-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).