03/05: etc/committer: Avoid reading original files more than once.

[guix-commits]

rekado pushed a commit to branch master
in repository guix.

commit 5027bc19d8a3c7bac1d89d80fc3c717ae3ec399a
Author: Ricardo Wurmus <rekado@elephly.net>
AuthorDate: Thu Sep 21 16:02:44 2023 +0200

    etc/committer: Avoid reading original files more than once.
    
    * 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 @@ LINE-NO in PORT."
                 (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