GNU bug report logs - #66138
[PATCH 1/4] etc/committer: Do not recompute changes when there are no definitions.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 66138 in the body.
You can then email your comments to 66138 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <rekado <at> elephly.net>
To: guix-patches <at> gnu.org
Cc: Ricardo Wurmus <rekado <at> elephly.net>
Subject: [PATCH 1/4] etc/committer: Do not recompute changes when there are no
 definitions.
Date: Thu, 21 Sep 2023 16:12:41 +0200

* etc/committer.scm.in (main): Reuse previously computed changes if there are
no changes to the number of definitions.
---
 etc/committer.scm.in | 75 +++++++++++++++++++++++---------------------
 1 file changed, 40 insertions(+), 35 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index e7f1ca8c45..cc3b572710 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -388,41 +388,46 @@ (define (main . args)
               (unless (eqv? 0 (status:exit-val (close-pipe port)))
                 (error "Cannot commit"))))
           (usleep %delay))
-        definitions))
+        definitions)
 
-     ;; Changes.
-     (for-each
-      (match-lambda
-        ((new old . hunks)
-         (for-each (lambda (hunk)
-                     (let ((port (open-pipe* OPEN_WRITE
-                                             "git" "apply"
-                                             "--cached"
-                                             "--unidiff-zero")))
-                       (hunk->patch hunk port)
-                       (unless (eqv? 0 (status:exit-val (close-pipe port)))
-                         (error "Cannot apply")))
-                     (usleep %delay))
-                   hunks)
-         (define copyright-line
-           (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line)
-                                      (const line)))
-                (hunk-diff-lines (first hunks))))
-         (cond
-          (copyright-line
-           (add-copyright-line copyright-line))
-          (else
-           (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
-             (change-commit-message* (hunk-file-name (first hunks))
-                                     old new)
-             (change-commit-message* (hunk-file-name (first hunks))
-                                     old new
-                                     port)
-             (usleep %delay)
-             (unless (eqv? 0 (status:exit-val (close-pipe port)))
-               (error "Cannot commit")))))))
-      ;; XXX: we recompute the hunks here because previous
-      ;; insertions lead to offsets.
-      (new+old+hunks (diff-info))))))
+       ;; Changes.
+       (for-each
+        (match-lambda
+          ((new old . hunks)
+           (for-each (lambda (hunk)
+                       (let ((port (open-pipe* OPEN_WRITE
+                                               "git" "apply"
+                                               "--cached"
+                                               "--unidiff-zero")))
+                         (hunk->patch hunk port)
+                         (unless (eqv? 0 (status:exit-val (close-pipe port)))
+                           (error "Cannot apply")))
+                       (usleep %delay))
+                     hunks)
+           (define copyright-line
+             (any (lambda (line) (and=> (string-prefix? "+;;; Copyright ©" line)
+                                   (const line)))
+                  (hunk-diff-lines (first hunks))))
+           (cond
+            (copyright-line
+             (add-copyright-line copyright-line))
+            (else
+             (let ((port (open-pipe* OPEN_WRITE "git" "commit" "-F" "-")))
+               (change-commit-message* (hunk-file-name (first hunks))
+                                       old new)
+               (change-commit-message* (hunk-file-name (first hunks))
+                                       old new
+                                       port)
+               (usleep %delay)
+               (unless (eqv? 0 (status:exit-val (close-pipe port)))
+                 (error "Cannot commit")))))))
+        (new+old+hunks (match definitions
+                         ('() changes) ;reuse
+                         (_
+                          ;; XXX: we recompute the hunks here because previous
+                          ;; insertions lead to offsets.
+                          (let-values (((definitions changes)
+                                        (partition hunk-type (diff-info))))
+                            changes)))))))))
 
 (apply main (cdr (command-line)))

base-commit: 4bdb8bd2674c2b630626be43a5cd3c2b65401b52
-- 
2.41.0

Message #8 received at 66138 <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <rekado <at> elephly.net>
To: 66138 <at> debbugs.gnu.org
Cc: Ricardo Wurmus <rekado <at> elephly.net>
Subject: [PATCH 2/4] etc/committer: Do not record positions when reading from
 git files.
Date: Thu, 21 Sep 2023 16:46:15 +0200

This gives us a slight performance boost.

* etc/committer.scm.in (main): Disable recording of positions.
---
 etc/committer.scm.in | 1 +
 1 file changed, 1 insertion(+)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index cc3b572710..45efb68be2 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -358,6 +358,7 @@ (define (main . args)
         (_
          (apply change-commit-message file-name old new rest)))))
 
+  (read-disable 'positions)
   (match (diff-info)
     (()
      (display "Nothing to be done.\n" (current-error-port)))
-- 
2.41.0

Message #11 received at 66138 <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <rekado <at> elephly.net>
To: 66138 <at> debbugs.gnu.org
Cc: Ricardo Wurmus <rekado <at> elephly.net>
Subject: [PATCH 3/4] etc/committer: Avoid reading original files more than
 once.
Date: Thu, 21 Sep 2023 16:46:16 +0200

* etc/committer.scm.in (%original-file-cache): New variable.
(read-original-file): New procedure.
(read-original-file*): New procedure.
(old-sexp): Use it.
---
 etc/committer.scm.in | 35 ++++++++++++++++++++++++-----------
 1 file changed, 24 insertions(+), 11 deletions(-)

diff --git a/etc/committer.scm.in b/etc/committer.scm.in
index 45efb68be2..eb8865513e 100755
--- a/etc/committer.scm.in
+++ b/etc/committer.scm.in
@@ -196,21 +196,34 @@ (define (lines-to-first-change hunk)
                 (string-ref line 0)))
              (hunk-diff-lines hunk))))
 
-(define (old-sexp hunk)
-  "Using the diff information in HUNK return the unmodified S-expression
-corresponding to the top-level definition containing the staged changes."
-  ;; TODO: We can't seek with a pipe port...
+(define %original-file-cache
+  (make-hash-table))
+
+(define (read-original-file file-name)
+  "Return the contents of FILE-NAME prior to any changes."
   (let* ((port (open-pipe* OPEN_READ
                            "git" "cat-file" "-p" (string-append
-                                                  "HEAD:"
-                                                  (hunk-file-name hunk))))
+                                                  "HEAD:" file-name)))
          (contents (get-string-all port)))
     (close-pipe port)
-    (call-with-input-string contents
-      (lambda (port)
-        (surrounding-sexp port
-                          (+ (lines-to-first-change hunk)
-                             (hunk-old-line-number hunk)))))))
+    contents))
+
+(define (read-original-file* file-name)
+  "Caching variant of READ-ORIGINAL-FILE."
+  (or (hashv-ref %original-file-cache file-name)
+      (let ((value (read-original-file file-name)))
+        (hashv-set! %original-file-cache file-name value)
+        value)))
+
+(define (old-sexp hunk)
+  "Using the diff information in HUNK return the unmodified S-expression
+corresponding to the top-level definition containing the staged changes."
+  ;; TODO: We can't seek with a pipe port...
+  (call-with-input-string (read-original-file* (hunk-file-name hunk))
+    (lambda (port)
+      (surrounding-sexp port
+                        (+ (lines-to-first-change hunk)
+                           (hunk-old-line-number hunk))))))
 
 (define (new-sexp hunk)
   "Using the diff information in HUNK return the modified S-expression
-- 
2.41.0

Message #14 received at 66138 <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <rekado <at> elephly.net>
To: 66138 <at> debbugs.gnu.org
Cc: Ricardo Wurmus <rekado <at> elephly.net>
Subject: [PATCH 4/4] etc/committer: Speed up surrounding-sexp.
Date: Thu, 21 Sep 2023 16:46:17 +0200

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 @@ (define (read-excursion port)
     (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).
-- 
2.41.0

Message #19 received at 66138-done <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <rekado <at> elephly.net>
To: 66138-done <at> debbugs.gnu.org
Subject: Re: [PATCH 1/4] etc/committer: Do not recompute changes when there
 are no definitions.
Date: Sun, 24 Sep 2023 14:12:28 +0200

I just pushed this series.

-- 
Ricardo

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.