より CLtL2 Appendix A らしい素数列

• よりClojureらしい素数列 - OGINO Masanori@はてな
• Island Life - 「よりClojureらしい素数列」をGaucheで
• 「よりClojureらしい素数列」をSqueak Smalltalkで―のつもりがあらぬ方向へ - Smalltalkのtは小文字です

(series::install :implicit-map t)

(defun prime-p (x)
  (not (collect-or (zerop (rem x (scan-range :from 2 :below (1+ (/ x 2))))))))

(defun scan-prime-numbers ()
  (declare (optimizable-series-function))
  (producing (z) ((n 1))
    (loop
      (tagbody
         start
         (setq n (1+ n))
         (unless (prime-p n)
           (go start))
         (next-out z n)))))

(collect (until-if (lambda (x) (< 100 x))
                   (scan-prime-numbers)))
;;=> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)


(collect (until-if (lambda (x) (< 100 x))
                   (choose-if #'prime-p (scan-range :from 2))))
;;=> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)


(defun |scan-prime-numbers'| ()
  (declare (optimizable-series-function))
  (choose-if #'prime-p (scan-range :from 2)))

(collect (until-if (lambda (x) (< 100 x))
                   (|scan-prime-numbers'|)))
;;=> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)

それぞれマクロ展開すると

(macroexpand '(collect (until-if (lambda (x) (< 100 x))
                   (scan-prime-numbers))))
;;=> (COMMON-LISP:LET* ((#:N-1316 1)
;;                      #:Z-1317
;;                      (#:LASTCONS-1312 (LIST NIL))
;;                      (#:LST-1313 #:LASTCONS-1312))
;;     (DECLARE (TYPE CONS #:LASTCONS-1312)
;;              (TYPE LIST #:LST-1313))
;;     (TAGBODY
;;      #:LL-1318
;;       (SETQ #:N-1316 (1+ #:N-1316))
;;       (IF (PRIME-P #:N-1316)
;;           NIL
;;           (PROGN (GO #:LL-1318)))
;;       (SETQ #:Z-1317 #:N-1316)
;;       (IF ((LAMBDA (X) (< 100 X)) #:Z-1317)
;;           (GO SERIES::END))
;;       (SETQ #:LASTCONS-1312 (SETF (CDR #:LASTCONS-1312) (CONS #:Z-1317 NIL)))
;;       (GO #:LL-1318)
;;      SERIES::END)
;;     (CDR #:LST-1313))
;;   T

(macroexpand '(collect (until-if (lambda (x) (< 100 x))
                   (choose-if #'prime-p (scan-range :from 2)))))
;;=> (COMMON-LISP:LET* ((#:NUMBERS-1328 (SERIES::COERCE-MAYBE-FOLD (- 2 1) 'NUMBER))
;;                      (#:LASTCONS-1320 (LIST NIL))
;;                      (#:LST-1321 #:LASTCONS-1320))
;;     (DECLARE (TYPE NUMBER #:NUMBERS-1328)
;;              (TYPE CONS #:LASTCONS-1320)
;;              (TYPE LIST #:LST-1321))
;;     (TAGBODY
;;      #:LL-1331
;;       (SETQ #:NUMBERS-1328
;;               (+ #:NUMBERS-1328 (SERIES::COERCE-MAYBE-FOLD 1 'NUMBER)))
;;       (IF (NOT (PRIME-P #:NUMBERS-1328))
;;           (GO #:LL-1331))
;;       (IF ((LAMBDA (X) (< 100 X)) #:NUMBERS-1328)
;;           (GO SERIES::END))
;;       (SETQ #:LASTCONS-1320
;;               (SETF (CDR #:LASTCONS-1320) (CONS #:NUMBERS-1328 NIL)))
;;       (GO #:LL-1331)
;;      SERIES::END)
;;     (CDR #:LST-1321))
;;   T

(macroexpand '(collect (until-if (lambda (x) (< 100 x))
                        (|scan-prime-numbers'|))))
;;=> (COMMON-LISP:LET* ((#:NUMBERS-1337 (SERIES::COERCE-MAYBE-FOLD (- 2 1) 'NUMBER))
;;                      (#:LASTCONS-1333 (LIST NIL))
;;                      (#:LST-1334 #:LASTCONS-1333))
;;     (DECLARE (TYPE NUMBER #:NUMBERS-1337)
;;              (TYPE CONS #:LASTCONS-1333)
;;              (TYPE LIST #:LST-1334))
;;     (TAGBODY
;;      #:LL-1338
;;       (SETQ #:NUMBERS-1337
;;               (+ #:NUMBERS-1337 (SERIES::COERCE-MAYBE-FOLD 1 'NUMBER)))
;;       (IF (NOT (PRIME-P #:NUMBERS-1337))
;;           (GO #:LL-1338))
;;       (IF ((LAMBDA (X) (< 100 X)) #:NUMBERS-1337)
;;           (GO SERIES::END))
;;       (SETQ #:LASTCONS-1333
;;               (SETF (CDR #:LASTCONS-1333) (CONS #:NUMBERS-1337 NIL)))
;;       (GO #:LL-1338)
;;      SERIES::END)
;;     (CDR #:LST-1334))
;;   T

いまだにどう書くのがいいのかわからない。

Btrfs で RAID10

btrfs を試す 2 - Multiple Devices - ~fumi/ChangeLog に書かれているとおり。

近ごろは btrfs にコマンドが統合されつつある?

/sbin/btrfs --help
Usage:
	btrfs subvolume snapshot <source> [<dest>/]<name>
		Create a writable snapshot of the subvolume <source> with
		the name <name> in the <dest> directory.
	btrfs subvolume delete <subvolume>
		Delete the subvolume <subvolume>.
	btrfs subvolume create [<dest>/]<name>
		Create a subvolume in <dest> (or the current directory if
		not passed).
	btrfs subvolume list <path>
		List the snapshot/subvolume of a filesystem.
	btrfs subvolume find-new <path> <last_gen>
		List the recently modified files in a filesystem.
	btrfs filesystem defragment [-vcf] [-s start] [-l len] [-t size] <file>|<dir> [<file>|<dir>...]
		Defragment a file or a directory.
	btrfs subvolume set-default <id> <path>
		Set the subvolume of the filesystem <path> which will be mounted
		as default.
	btrfs filesystem sync <path>
		Force a sync on the filesystem <path>.
	btrfs filesystem resize [+/-]<newsize>[gkm]|max <filesystem>
		Resize the file system. If 'max' is passed, the filesystem
		will occupe all available space on the device.
	btrfs filesystem show [<uuid>|<label>]
		Show the info of a btrfs filesystem. If no <uuid> or <label>
		is passed, info of all the btrfs filesystem are shown.
	btrfs filesystem df <path>
		Show space usage information for a mount point
		.
	btrfs filesystem balance <path>
		Balance the chunks across the device.
	btrfs device scan [<device> [<device>..]
		Scan all device for or the passed device for a btrfs
		filesystem.
	btrfs device add <dev> [<dev>..] <path>
		Add a device to a filesystem.
	btrfs device delete <dev> [<dev>..] <path>
		Remove a device from a filesystem.

	btrfs help|--help|-h
		Show the help.

Btrfs Btrfs v0.19

RAID10 になっているかは次のように確認できる。

sudo btrfs filesystem df /mnt/btrfs
Data, RAID10: total=128.00MB, used=0.00
Data: total=8.00MB, used=0.00
System, RAID10: total=16.00MB, used=4.00KB
System: total=4.00MB, used=0.00
Metadata, RAID10: total=64.00MB, used=8.00KB
Metadata: total=8.00MB, used=16.00KB

今月から

昨日、7ヶ月間働いた社会を退職した。

今月からアクトインディに復帰する。

scan-file*

(defun remove-from-keyword-args (args &rest keywords)
  (loop for (a b) on args by #'cddr
        unless (member a keywords :test #'eq)
          append (list a b)))

(series::defS scan-file* (name &rest args-for-open &key (reader #'read-line) &allow-other-keys)
  "like scan-file. accept options for open."
  (series::fragl ((name) (reader) (args-for-open)) ; args
                 ((items t))            ; rets
                 ((items t)             ; aux
                  (lastcons cons (list nil))
                  (lst list))
                 ()                     ; alt
                 ((setq lst lastcons)   ; prolog
                  (with-open-stream (f (apply #'open name :direction
                                              :input (remove-from-keyword-args args-for-open :reader)))
                    (cl:let ((done (list nil)))
                      (loop
                        (cl:let ((item (cl:funcall reader f nil done)))
                          (when (eq item done)
                            (return nil))
                          (setq lastcons (setf (cdr lastcons) (cons item nil)))))))
                  (setq lst (cdr lst)))
                 ((if (null lst) (go series::end)) ; body
                  (setq items (car lst))
                  (setq lst (cdr lst)))
                 ()                     ; epilog
                 ()                     ; wraprs
                 :context)              ; impure
  :optimizer
  (series::apply-literal-frag
   (cl:let ((file (series::new-var 'file)))
     `((((reader))                      ; args
        ((items t))                     ; rets
        ((items t) (done t (list nil))) ; aux
        ()                              ; alt
        ()                              ; prolog
        ((if (eq (setq items (cl:funcall reader ,file nil done)) done) ; body
             (go series::end)))
        ()                              ; epilog
        ((#'(lambda (code)              ; wraprs
              (list 'with-open-file
                    '(,file ,name :direction :input ,@(remove-from-keyword-args args-for-open :reader))
                    code)) :loop))
        :context)                       ; impure
       ,reader))))                      ; これは何?

Heroku で Lokka するメモ

# rvm 関連
rvm use ruby-1.9.2
rvm gemset create sumire-lokka
rvm gemset use sumire-lokka
gem env
gem install bundler

# Lokka
gem install heroku bundler
git clone git://github.com/komagata/lokka.git
cd lokka
heroku create sumire
git push heroku master
heroku rake db:setup
heroku apps:open

# ローカルから Heroku を DB を反映
gem install taps
heroku db:push --confirm sumire sqlite://db/development.sqlite3

# メンテナンス画面のオン、オフ
heroku maintenance:on
heroku maintenance:off

「すごく簡単だ」

村上春樹「ダンス・ダンス・ダンス」より

Rails3 セットアップメモ

rvm と bundler 使うと綺麗にセットアップできるな。 Common Lisp にもこういうの欲しい。

# rvm 関連
rvm use ruby-1.9.2
rvm gemset create sumire
rvm gemset use sumire
gem env
gem install bundler

# プロジェクトディレクトリの作成
mkdir sumire
cd sumire

# Gemfile 作成
cat > Gemfile
source 'http://rubygems.org'
gem 'rails', '3.1.0'
C-d

# bundle
bundle install --path vendor/bundle
bundle exec rails new .
# ↑でエラーが出るが気にせず次へ
bundle install

# 起動 http://localhost:3000/
bundle exec rails s

Rucksack のパラレルなトランザクション

Rucksack はとても素敵なピュア Common Lisp のパーシステントシステムなんだけど、今の実装はトランザクションが全てシリアライズされて、同時に1トランザクションしか走ることがでない。

Rucksack のメーリングリストですでにパッチを持っている人がいるという話を出ていたけど、そのパッチが全然出てこない。素直に待てばいいかなと思いつつも、ついついなんとかできないかなと思っていじってしまった。

https://github.com/quek/rucksack/tree/parallel2

まず、再帰ロック sb-thread:with-recursive-lock を使っているので SBCL でしか動かない。

コミット時に他のトランザクションがすでに同じオブジェクトをコミットしてないか調べて、コミットされていたら transaction-conflict を投げる。次のように transaction-conflict で rucksack::retry をリスタートすれば、トランザクションがリトライされる。

(handler-bind ((transaction-conflict
                 (lambda (c)
                   (invoke-restart 'rucksack::retry))))
  (with-transaction ()
    ...))

Rucksack のコードはきれいだと思った。既にパラレルなトランザクションのためのコードが書かれていて、それを利用することができた。

とりあえず、ちゃんと動いているようだけど、正しいという自信がない。もう少し様子を見てからパッチを投げるとかしたい。