Proof-of-concept parallelized fetching.

Author: orivej

misc.lisp

@@ -177,12 +177,12 @@
   (flet ((action (stream)
            (call-with-skipping
             (lambda ()
-              (map-sources (lambda (source)
-                             (force-output stream)
-                             (format t "~&Updating ~S from ~A~%"
-                                     (project-name source)
-                                     (location source))
-                             (update-source-cache source))))
+              (pmap-sources (lambda (source)
+                              (force-output stream)
+                              (format t "~&Updating ~S from ~A~%"
+                                      (project-name source)
+                                      (location source))
+                              (update-source-cache source))))
             :stream stream)))
     (if file
         (with-open-file (stream file :direction :output

quicklisp-controller.asd

@@ -10,7 +10,8 @@
                #:cl-ppcre
                #:alexandria
                #:drakma
-               #:ironclad)
+               #:ironclad
+               #:lparallel)
   :serial t
   :components ((:file "tarhash")
                (:file "package")

upstream.lisp

@@ -130,6 +130,24 @@
         (with-simple-restart (skip "Skip ~A source" project-name)
           (funcall fun (load-source-file project-name source-file)))))))
 
+(defun pmap-sources (fun)
+  (let ((dependency-tree (lparallel:make-ptree))
+        (host-dependency (make-hash-table :test 'equal))
+        (i 0))
+    (map-sources (lambda (source)
+                   (let ((host (source-host source)))
+                     (lparallel:ptree-fn i (gethash host host-dependency)
+                               (lambda (&optional arg)
+                                 (declare (ignore arg))
+                                 (funcall fun source))
+                               dependency-tree)
+                     (setf (gethash host host-dependency) (list i))
+                     (incf i))))
+    (lparallel:ptree-fn 'everything (loop for j below i collect j)
+                        (constantly nil) dependency-tree)
+    (lparallel:call-ptree 'everything dependency-tree)
+    nil))
+
 (defun find-source (name)
   (block nil
     (map-sources (lambda (source)