DouKaku?

(defpackage :doukaku-39 (:use :cl))
(in-package :doukaku-39)

(defvar *endp* nil)
(defvar *lock* (mp:make-process-lock))
(defvar *reader-queue* (make-instance 'mp:queue))
(defvar *writer-queue* (make-instance 'mp:queue))

(defmacro with-dequeue ((elem queue lock) &body body)
  "キューに要素があるなら、取り出す。なければ別スレッドへ切り換え"
  `(let ((,elem (mp:with-process-lock (,lock)
                  (unless (mp:queue-empty-p ,queue)
                    (mp:dequeue ,queue)))))
     (if (null ,elem)
         (mp:process-allow-schedule)
         (progn ,@body))))

(defun process/resolver ()
  "ひたすら名前解決"
  (loop
     (when (and (mp:queue-empty-p *reader-queue*) *endp*) (return))
     ;; キューが空なら待ち、要素があるなら読み出して処理し、結果を書き込みキューに入れる
     (with-dequeue (line *reader-queue* *lock*)
       (multiple-value-bind (match? whole ip rest)
           (excl:match-re "(\\d+.\\d+.\\d+.\\d+)(.*)" line)
         (declare (ignorable match? whole))
         ;; socket:ipaddr-to-hostname は Lisp レベルで名前のキャッシュを行ってる
         (mp:enqueue *writer-queue*
                     (concatenate 'string
                                  (or (socket:ipaddr-to-hostname ip) ip)
                                  rest))))))

(defun process/writer (output-file)
  "ひたすら結果を出力"
  (with-open-file (out output-file :direction :output :if-exists :supersede)
    (loop
       (when (and *endp* (mp:queue-empty-p *writer-queue*)
		         (mp:queue-empty-p *reader-queue*))
         (return))
       (with-dequeue (line *writer-queue* *lock*)
         (write-line line out)))))

(defun resolver (input-file output-file &aux processes)
  "ブロックする可能性のある名前解決をスレッド化して高速化"
  (with-open-file (in input-file :direction :input)
      ;; 並列化
      (setf *endp* nil)
      (loop for i from 1 to 5 do
           (push (mp:process-run-function (format nil "Resolver Process ~D" i)
                                          #'process/resolver) processes))
      (push (mp:process-run-function "Writer Process"
                                     #'process/writer output-file) processes)
      ;; ファイルからの読み込み
      (loop for line = (read-line in nil :eof)
            until (eql line :eof)  
            do (mp:enqueue *reader-queue* line) ; 読み込んだ行をリゾルバ用キューに入れる
            finally (mp:with-process-lock (*lock*) (setf *endp* t)))
      ;; 全プロセスの終了待ち
      (loop until (some #'mp:process-active-p processes)
            do (mp:process-allow-schedule))
      *endp*))