summaryrefslogtreecommitdiff
path: root/etc
diff options
context:
space:
mode:
authorRicardo Wurmus <rekado@elephly.net>2023-09-21 16:03:50 +0200
committerRicardo Wurmus <rekado@elephly.net>2023-09-24 13:49:53 +0200
commit670fc6ee50a2882fba8004de7d9d24e80459add2 (patch)
treeb5a780ca2df3f37345506841fdc9dd3ea68891f2 /etc
parent5027bc19d8a3c7bac1d89d80fc3c717ae3ec399a (diff)
etc/committer: Speed up surrounding-sexp.
The old surrounding-sexp procedure would read all S-expressions from the beginning of the file up to the given line number and then return the last encountered S-expression. This is quite wasteful. Instead we can record all lines that begin with an S-expression and jump straight to the offset closest to the desired line number to read the S-expression there. * etc/committer.scm.in (lines+offsets-with-opening-parens): New procedure. (surrounding-sexp): Use it.
Diffstat (limited to 'etc')
-rwxr-xr-xetc/committer.scm.in46
1 files changed, 32 insertions, 14 deletions
diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index eb8865513e..0705b29fd9 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -85,21 +85,39 @@ the expression."
(seek port start SEEK_SET)
result))
-(define (surrounding-sexp port line-no)
+(define (lines+offsets-with-opening-parens port)
+ "Record all line numbers (and their offsets) where an opening parenthesis is
+found in column 0. The resulting list is in reverse order."
+ (let loop ((acc '())
+ (number 0))
+ (let ((line (read-line port)))
+ (cond
+ ((eof-object? line) acc)
+ ((string-prefix? "(" line)
+ (loop (cons (cons number ;line number
+ (- (ftell port)
+ (string-length line) 1)) ;offset
+ acc)
+ (1+ number)))
+ (else (loop acc (1+ number)))))))
+
+(define (surrounding-sexp port target-line-no)
"Return the top-level S-expression surrounding the change at line number
-LINE-NO in PORT."
- (let loop ((i (1- line-no))
- (last-top-level-sexp #f))
- (if (zero? i)
- last-top-level-sexp
- (match (peek-char port)
- (#\(
- (let ((sexp (read-excursion port)))
- (read-line port)
- (loop (1- i) sexp)))
- (_
- (read-line port)
- (loop (1- i) last-top-level-sexp))))))
+TARGET-LINE-NO in PORT."
+ (let* ((line-numbers+offsets
+ (lines+offsets-with-opening-parens port))
+ (closest-offset
+ (or (and=> (list-index (match-lambda
+ ((line-number . offset)
+ (< line-number target-line-no)))
+ line-numbers+offsets)
+ (lambda (index)
+ (match (list-ref line-numbers+offsets index)
+ ((line-number . offset) offset))))
+ (error "Could not find surrounding S-expression for line"
+ target-line-no))))
+ (seek port closest-offset SEEK_SET)
+ (read port)))
;;; Whether the hunk contains a newly added package (definition), a removed
;;; package (removal) or something else (#false).