モチベーション 3.0

ダニエル・ピンクの「モチベーション 3.0」を読んだ。よかった。「自律」について私が感じていることを、見事に説明してくれた。

しかし、一つだけわからないことが。何でこの本借りたんだろう? 私があまり読まなさそうなタイプの本なのに。

usocket の使い方をすっかり忘れてしまっていた

サーバ側

(defparameter *port* 1958)

(defgeneric server-start (server))
(defgeneric server-stop (server))


(defclass* server ()
  ((host usocket:*wildcard-host*)
   (port *port*)
   (listen-thread nil)))

(defmethod server-start ((server server))
  (setf (listen-thread-of server)
        (sb-thread:make-thread
         (lambda ()
           (usocket:with-socket-listener (socket (host-of server) (port-of server) :reuse-address t)
             (loop (usocket:with-connected-socket (connected-socket
                                                   (usocket:socket-accept socket))
                     (let ((stream (usocket:socket-stream connected-socket)))
                       (print (eval (read stream)) stream)
                       (force-output stream))))))
         :name "nunumo:server")))

(defmethod server-stop ((server server))
  (sb-thread:terminate-thread (listen-thread-of server))
  (setf (listen-thread-of server) nil))

クライアント側

(defgeneric client-open (client))
(defgeneric client-close (client))
(defgeneric client-read (client))
(defgeneric client-write (client object))
(defgeneric client-flush (client))

(defclass* client ()
  ((host "localhost")
   (port *port*)
   (socket nil)
   (stream nil)))

(defmethod client-open ((client client))
  (setf (socket-of client)
        (usocket:socket-connect (host-of client) (port-of client))
        (stream-of client)
        (usocket:socket-stream (socket-of client)))
  client)

(defmethod client-close ((client client))
  (force-output (stream-of client))
  (usocket:socket-close (socket-of client))
  client)

(defmethod client-read ((client client))
  (read (stream-of client)))

(defmethod client-write ((client client) object)
  (print object (stream-of client)))

(defmethod client-flush ((client client))
  (force-output (stream-of client))
  client)

はい。RPC システム完成!

(let ((server (make-instance 'server))
      (client (make-instance 'client)))
  (server-start server)
  (unwind-protect
       (progn
         (client-open client)
         (client-write client '(format nil "(+ 1 2) => ~a" (+ 1 2)))
         (client-flush client)
         (client-read client))
    (server-stop server)))
;;=> "(+ 1 2) => 3"

sb-concurrency:queue

sb-concurrency:queue を使ってみる。

(defstruct (thread-pool (:constructor %make-thread-pool))
  (queue)
  (name)
  (stop)
  (sleep-time)
  (threads))

(defun make-thread-pool (number-of-thread &key
                                            name
                                            (sleep-time 0.1))
  (let ((stop (cons nil nil))
        (queue (sb-concurrency:make-queue)))
    (%make-thread-pool
     :name name
     :queue queue
     :stop stop
     :sleep-time sleep-time
     :threads (collect 'bag
                (sb-thread:make-thread
                 (lambda ()
                   (loop until (car stop)
                         do (multiple-value-bind (job ok)
                                (sb-concurrency:dequeue queue)
                              (if ok
                                  (funcall job)
                                  (sleep sleep-time)))))
                 :name (format nil "~a worker thread ~d" name
                               (scan-range :from 1 :upto number-of-thread)))))))

(defun stop-thread-pool (thread-pool)
  (setf (car (thread-pool-stop thread-pool)) t))

(defun join-thread-pool (thread-pool)
  (stop-thread-pool thread-pool)
  (collect-ignore (sb-thread:join-thread (scan (thread-pool-threads thread-pool)))))

(defun add-job (thread-pool job)
  (sb-concurrency:enqueue job (thread-pool-queue thread-pool)))

(defun wait-thread-pool (thread-pool)
  (loop until (sb-concurrency:queue-empty-p (thread-pool-queue thread-pool))
        do (sleep (thread-pool-sleep-time thread-pool))))

(defmacro with-thread-pool ((var number-of-thread
                             &key
                               (name "nunumo::thread-pool")
                               (sleep-time 0.1) )
                            &body body)
  `(let ((,var (make-thread-pool ,number-of-thread
                                :name ,name
                                :sleep-time ,sleep-time)))
     (unwind-protect
          (progn ,@body)
       (stop-thread-pool ,var))))

#|
(labels ((fib (n)
           (if (<= n 2)
               1
               (+ (fib (1- n))
                  (fib (- n 2))))))
  (let ((q (sb-concurrency:make-queue)))
    (with-thread-pool (pool 4)
      (dotimes (i 10)
        (add-job pool (let ((n (+ 31 i)))
                        (lambda ()
                          (sb-concurrency:enqueue (cons n (fib n)) q)))))
      (wait-thread-pool pool)
      (join-thread-pool pool))
    (sb-concurrency:list-queue-contents q)))
;;=> ((31 . 1346269) (32 . 2178309) (33 . 3524578) (34 . 5702887) (35 . 9227465) (36 . 14930352) (37 . 24157817) (38 . 39088169) (39 . 63245986) (40 . 102334155))
|#

Paiprolog の出番だ

某問題を解こうと思って Paiprolog の出番だ、と思ったがうまく行かなかった。

(ql:quickload  :paiprolog)

(defpackage :dropquest2012
  (:use :cl :paiprolog))

(in-package dropquest2012)

(<-- (member ?item (?item . ?rest)))
(<- (member ?item (?x . ?rest)) (member ?item ?rest))
(<-- (d ?x) (member ?x (0 1 2 3 4 5 6 7 8 9)))

(prolog-collect (?n1 ?n2 ?n3 ?n4 ?n5)
  (d ?n1)
  (d ?n2)
  (d ?n3)
  (d ?n4)
  (d ?n5)
  (is 24 (* ?n1 ?n2))
  (is ?n4 (/ ?n2 2))
  (is 26 (+ ?n1 ?n2 ?n3 ?n4 ?n5))
  (is ?n5 (+ ?n2 ?n3))
  (is (+ ?n4 ?n5) (+ ?n1 ?n3)))
;;=> NIL

でも、こうすると動く。

(prolog-collect (?n1 ?n2 ?n3 ?n4 ?n5)
  (d ?n1)
  (d ?n2)
  (d ?n3)
  (d ?n4)
  (d ?n5)
  (is 24 (* ?n1 ?n2))
  (is ?n4 (/ ?n2 2))
  (is 26 (+ ?n1 ?n2 ?n3 ?n4 ?n5))
  (is ?n5 (+ ?n2 ?n3))
  ;; (is (+ ?n4 ?n5) (+ ?n1 ?n3))
  (is ?x (+ ?n4 ?n5))
  (is ?x (+ ?n1 ?n3)))
;;=> ((6 4 5 2 9))

なんだろうね。

Series でも解きたくて scan-combination を実装した。

(ql:quickload  :info.read-eval-print.series-ext)

(info.read-eval-print.series-ext:sdefpackage :dropquest2012
                                             (:use :cl))

(in-package dropquest2012)

(collect-first
 (choose-if
  (lambda (xs)
    (destructuring-bind (n1 n2 n3 n4 n5) xs
      (and (= (* n1 n2) 24)
           (= n4 (/ n2 2))
           (= (+ n4 n5) (+ n1 n3))
           (= 26 (+ n1 n2 n3 n4 n5))
           (= n5 (+ n2 n3)))))
  (scan-combination 5 (collect (scan-range :upto 9)))))
;;=> ((6 4 5 2 9))

MySQL でフェッチしながら他の SQL を実行

MySQL でフェッチしながら他の SQL を実行しようとするとよく "Commands out of sync; you can't run thiscommand now" というエラーになる。

大きな検索結果のときどうすりゃいいんだろう? というのがかねてからの疑問だった。

MySQL のクライレアント API を理解するために SWIG を使って Common Lisp から API をたたいてみた。

;; swig でコードを生成する。
(quicklisp:quickload :trivial-shell)
(with-open-file (out "/tmp/input.i" :direction :output :if-exists :supersede)
  (write-string "%module input
%include \"/usr/include/mysql/mysql.h\"" out))
(trivial-shell:shell-command "swig -cffi /tmp/input.i")

;; libmysqlclient をロードする
(quicklisp:quickload :cffi)
(cffi:define-foreign-library libmysqlclient
  ((:not :windows) (:default "libmysqlclient"))
  (:windows (:default "libmysql")))
(cffi:use-foreign-library libmysqlclient)

;; swig で生成したコードをロード
(load "/tmp/input.lisp")

;; MySQL に接続
(mysql_server_init -1 (cffi-sys:null-pointer) (cffi-sys:null-pointer))
(setf mysql (mysql_init (cffi-sys:null-pointer)))
(setf connection (mysql_real_connect mysql "localhost" "root" "" "outing_development" 0 "/var/run/mysqld/mysqld.sock" 0))
(mysql_set_character_set mysql "utf8")

;; クエリー行実 mysql_store_result
(mysql_query connection "select * from regions")
(setf result (mysql_store_result connection))
(loop for row = (mysql_fetch_row result)
      until (cffi-sys:null-pointer-p row)
      do (loop for i below (mysql_num_fields result)
               do (format t "~a " (cffi:mem-aref row :string i))
               finally (terpri)))
(mysql_free_result result)

;; クエリー行実 mysql_use_result
(mysql_query connection "select * from regions")
(setf result (mysql_use_result mysql))
(loop for row = (mysql_fetch_row result) ; このループを最後まで回らないと "Commands out of sync; you can't run this command now"
      until (cffi-sys:null-pointer-p row)
      do (loop for i below (mysql_num_fields result)
               do (format t "~a " (cffi:mem-aref row :string i))
               finally (terpri)))
(mysql_free_result result)

;; おしまい
(mysql_close connection)
(mysql_server_end)

mysql_fetch_row を使った場合は最後(null が返っくる)まで mysql_fetch_row をしないと "Commands out of sync; you can't run this command now" というエラーになる。ここに書いてある。

Common Lisp でコード書かなくてもマニュアルを読めばよかったんだけど、隠れた動機というやつかな。

で、結局のところフェッチしながら他の SQL を実行するにはどうすればいいか? よくわからん。

Rails の find_each なんかは何回かに分けて mysql_store_result している感じなんだろうか?

そんなことより、SWIG 使えば C のコードを一行も書かずに Common Lisp だけで C の API をたたけて実にすばらしい。

ここしばらく

GW 対策でバタバタしていた。 GW に入る前はプログラマで GW に入ってからはインフラ屋さんな感じ。そろそろちょっとのんびりしたい。

今年の誕生日はジューサーを買った。3千円と安かったけど、ちゃんと動く。しぼりたてのジュースは美味しい。

娘は GW 前の一週間風邪でダウン。インフルエンザではないとの診断だったが高熱が3,4日続く質の悪い風邪だった。そしてまた今日も体調悪くてダウン。あわれ。四月末に一回遠出できたのはよかった。楽しそうだったし。回復したら今日行く予定だった映画に連れて行こう。

「さくらのVPS」ご利用中のお客様の新プラン乗り換え優遇施策

こどもの体調がわるく予定キャンセルで時間ができたので、新プランに乗り換えてた。 実施期間延長されててよかった。

すんなり Debian sid が入った。これでメモリ 1G で HD 100G だ。