[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
08/11: utils: Add 'go-to-location' with source location caching.
From: |
guix-commits |
Subject: |
08/11: utils: Add 'go-to-location' with source location caching. |
Date: |
Tue, 22 Jun 2021 06:15:58 -0400 (EDT) |
civodul pushed a commit to branch wip-simplified-packages
in repository guix.
commit 1273100781532d3beabecd7fd0679a208ad6c74c
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Jun 21 12:21:19 2021 +0200
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(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index 4ac1624..d15a17e 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 a13b13c..f8f6672 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))))
- 01/11: records: Support field sanitizers., (continued)
- 01/11: records: Support field sanitizers., guix-commits, 2021/06/22
- 07/11: utils: 'edit-expression' no longer leaks file ports., guix-commits, 2021/06/22
- 11/11: Add 'guix style'., guix-commits, 2021/06/22
- 05/11: packages: Add 'modify-inputs'., guix-commits, 2021/06/22
- 10/11: utils: 'edit-expression' copies part of the original source map., guix-commits, 2021/06/22
- 09/11: utils: 'edit-expression' modifies the file only if necessary., guix-commits, 2021/06/22
- 06/11: gnu: Change inputs of core packages to plain lists., guix-commits, 2021/06/22
- 02/11: packages: Allow inputs to be plain package lists., guix-commits, 2021/06/22
- 03/11: lint: Add 'input-labels' checker., guix-commits, 2021/06/22
- 04/11: packages: Add 'lookup-package-input' & co., guix-commits, 2021/06/22
- 08/11: utils: Add 'go-to-location' with source location caching.,
guix-commits <=