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:
parent
5027bc19d8
commit
670fc6ee50
@ -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).
|
||||
|
Loading…
Reference in New Issue
Block a user