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.
This commit is contained in:
Ricardo Wurmus 2023-09-21 16:03:50 +02:00
parent 5027bc19d8
commit 670fc6ee50
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
1 changed files with 32 additions and 14 deletions

View File

@ -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).