From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Sun, 9 Jan 2022 00:39:04 +0000 (+1100)
Subject: speed up by using batch lookups
X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=4112d84d6cfd188daeff79d64a86e1b4d02248b8;p=rrq%2Fnewlisp-ftw.git

speed up by using batch lookups
---

diff --git a/autorecommended.lsp b/autorecommended.lsp
index 7551236..43252cb 100755
--- a/autorecommended.lsp
+++ b/autorecommended.lsp
@@ -7,33 +7,35 @@
 (setf INSTALLED (map noarch (exec "apt-mark showinstall")))
 (write-line 2 (format "There are %d installed packages" (length INSTALLED)))
 
-; Determine the list of "manually installed"
-(setf MANUAL (map noarch (exec "apt-mark showmanual")))
-(write-line 2 (format "There are %d manual packages" (length MANUAL)))
+; Returns list of parsed result lines
+(define (dpkg-exec FMT) (map (fn (S) (parse S " ")) (exec FMT)))
 
 ; Set up hash table of provided packages by currently installed. This
 ; is needed for following up dependencies, which for an option
 ; dependency only automatically resolves the first of options.
 (write 2 "Initializing 'provided-by' ")
-(setf PROVFMT "dpkg-query -W -f '${Provides}' %s")
+(setf PROVFMT "dpkg-query -W -f '${Package} ${Provides}\\n' %s")
 (define PROV:PROV nil)
-(dolist (P INSTALLED)
-  (if (= (% (inc COUNT) 100)) (write 2 "."))
-  (if (PROV P) (push P (PROV P)) (PROV P (list P)))
-  (let (PV (if (exec (format PROVFMT P)) ($it 0)))
-    (when PV (if (PROV PV) (push P (PROV PV)) (PROV PV (list P))))))
+(dolist (P INSTALLED) (if (PROV P) (push P (PROV P)) (PROV P (list P))))
+(dolist (PL (explode INSTALLED 1000))
+  (write 2 ".")
+  (dolist (PPV (dpkg-exec (format PROVFMT (join PL " "))))
+    (let ((P (PPV 0)))
+      (dolist (PV (1 PPV))
+        (when PV (if (PROV PV) (push P (PROV PV)) (PROV PV (list P))))))))
 (dolist (P (PROV)) (PROV (P 0) (sort (unique (P 1)))))
 (write-line 2 " done")
 
 ; set up a hashtable of recommenders
 (write 2 "Initializing 'recommended-by' ")
-(setf COUNT 0)
-(setf RECFMT "dpkg-query -W -f '${Recommends}' %s")
+(setf RECFMT "dpkg-query -W -f '${Package} ${Recommends}' %s")
 (define REC:REC nil)
-(dolist (P INSTALLED)
-  (if (= (% (inc COUNT) 100)) (write 2 "."))
-  (dolist (R (exec (format RECFMT P)))
-    (if (REC R) (push P (REC R)) (REC R (list P)))))
+(dolist (PL (explode INSTALLED 1000))
+  (write 2 ".")
+  (dolist (RR  (dpkg-exec (format RECFMT (join PL " "))))
+    (let ((P (RR 0)))
+      (dolist (R (1 RR))
+        (if (REC R) (push P (REC R)) (REC R (list P)))))))
 (dolist (P (REC)) (REC (P 0) (sort (unique (P 1)))))
 (write-line 2 " done")
 
@@ -67,17 +69,22 @@
   (clean null? (map depends-choices (clean empty? (map trim (parse X ","))))))
 
 (write 2 "Initializing actual 'depends' ")
-(setf COUNT 0)
-(setf DEPFMT "dpkg-query -W -f '${Pre-Depends} ${Depends}' %s")
+(setf DEPFMT "dpkg-query -W -f '${Package} ${Pre-Depends} ${Depends}\\n' %s")
 (define DEP:DEP nil)
-(dolist (P INSTALLED)
-  (if (= (% (inc COUNT) 100)) (write 2 "."))
-  (DEP P (flat (map depends-fix (exec (format DEPFMT P))))))
+(dolist (PL (explode INSTALLED 1000))
+  (write 2 ".")
+  (dolist (RR (exec (format DEPFMT (join PL " "))))
+    (when (regex "([^ ]+) (.*)" RR)
+      (let ((P $1) (RL (flat (depends-fix $2))))
+        (DEP P RL)))))
 (write-line 2 " done")
 
 ; Return the dependencies for installed package of empty list otherwise
 (define (depends P) (or (DEP P) '()))
 
+; Determine the list of "manually installed"
+(setf MANUAL (map noarch (exec "apt-mark showmanual")))
+
 ; Expands a list of packages to include the closure of its dependencies
 (define (closure L)
   (let ((P (sort L)))