04/05: etc/committer: Speed up surrounding-sexp.

[guix-commits]

rekado pushed a commit to branch master
in repository guix.

commit 670fc6ee50a2882fba8004de7d9d24e80459add2
Author: Ricardo Wurmus <rekado@elephly.net>
AuthorDate: Thu Sep 21 16:03:50 2023 +0200

    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.
---
 etc/committer.scm.in | 46 ++++++++++++++++++++++++++++++++--------------
 1 file 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).