Chat (Lingr.com)
Informaiton
Daily
Column
- MySQL日本語の旅(5/1)
- アクセス向上秘伝(5/9)
- 一風変ったHaskellλ門(6/13)
- SICP Answer Book (5/31) 問題3.26追加
Zope Solution
Extra
アーカイブ
OSS案内所
Site Info
関連リンク
- 2004: 01 02 03 04 05 06 07 08 09 10 11 12
- 2005: 01 02 03 04 05 06 07 08 09 10 11 12
- 2006: 01 02 03 04 05 06 07 08 09 10 11 12
今月の一行
- 2006-06-30 [misc] CVSからSubversionに移行する
- 2006-06-29 [Gauche] リスト構築時にreverseしないですませる方法
- 2006-06-28 [Gauche] 他方のリストにある要素をマークする
- 2006-06-27 [quiz] 他方のリストにある要素をマークする
- 2006-06-26 [Gauche] Curlみたいな(?)プログラム
- 2006-06-23 [misc] screenから呼び出されたシェルのプロンプトを変更する
- 2006-06-22 [misc] screenで呼び出すシェルをログインシェルにする
- 2006-06-21 [MySQL] テーブルの数をcountするSQL
- 2006-06-20 [Mac OS X] daemontoolsを使う時の注意
- 2006-06-19 [Mac OS X] Intel Macでpkgsrcを使う
- 2006-06-16 [Gauche] スロットのオーバーライドを禁止する
- 2006-06-15 [misc] quitコマンド
- 2006-06-14 [Haskell] 連続した欠番
- 2006-06-13 [misc] slコマンドのオプション
- 2006-06-12 [Gauche] 空いているUIDの最小値を得る
- 2006-06-09 [Haskell] 空いているUIDの最小値を得る
- 2006-06-08 [Tips] 空いているUIDの最小値を得る
- 2006-06-07 [Tips] find+xargsで空白を含むファイル名を処理する
- 2006-06-06 [Tips] cronologの過去ログを圧縮
- 2006-06-05 [Haskell] here
- 2006-06-02 [Tips] 内蔵無線LAN on NetBSD on ThinkPad T43p
- 2006-06-01 [Haskell] I/O も Lazy ゆえに ．．．つづき．
2006-06-30 [misc] CVSからSubversionに移行する
1年くらい前から、新たにリビジョン管理するものには全てSubversionを使っているのだけど、 それ以前からCVSで管理しているものについても、Subversionに移行したくなった。
CVSからSubversionへの移行ツールには、cvs2svnがあるので これを使わせてもらうことにする。このツールはPythonで書かれており、dbmmoduleが必要と なる。また、移行元のCVSリポジトリ、移行先のSubversionリポジトリにローカルアクセス できなければならない。
インストールは個人のリポジトリをおいてあるNetBSDマシン上で、pkgsrc で行った。
% cd /usr/pkgsrc/devel/cvs2svn % make % make install
これで、python、py23-bsddb、subversion-base、cvs2svnがインストールされる。
で、肝心の変換だが、この情報に従って 1プロジェクトごとにダンプファイルに落とし、それを既存のSubversionリポジトリに 突っ込んでいくことにした。なお、CVSリポジトリ、Subversionリポジトリともに必ずバックアップを 取ってから作業しよう。
% cd ~/ % mkdir -p backup % tar cpf - cvsroot |tar xpf - -C backup % cvs2svn --dump-only --dumpfile=Gauche-mcrypt.dump cvsroot/Gauche-mcrypt ----- pass 1 ----- Examining all CVS ',v' files... /home/bizenn/cvsroot/Gauche-mcrypt/mcrypt_port.c,v /home/bizenn/cvsroot/Gauche-mcrypt/config.guess,v /home/bizenn/cvsroot/Gauche-mcrypt/config.sub,v /home/bizenn/cvsroot/Gauche-mcrypt/configure.ac,v /home/bizenn/cvsroot/Gauche-mcrypt/install-sh,v /home/bizenn/cvsroot/Gauche-mcrypt/Makefile.in,v /home/bizenn/cvsroot/Gauche-mcrypt/mcrypt.scm,v /home/bizenn/cvsroot/Gauche-mcrypt/mcrypt.stub,v /home/bizenn/cvsroot/Gauche-mcrypt/mcrypt_if.c,v /home/bizenn/cvsroot/Gauche-mcrypt/mcrypt_if.h,v /home/bizenn/cvsroot/Gauche-mcrypt/test.scm,v /home/bizenn/cvsroot/Gauche-mcrypt/autogen.sh,v Done ----- pass 2 ----- Checking for blocked exclusions... Checking for forced tags with commits... Checking for tag/branch mismatches... Re-synchronizing CVS revision timestamps... Done ----- pass 3 ----- Sorting CVS revisions... Done ----- pass 4 ----- Copying CVS revision data from flat file to database... Finding last CVS revisions for all symbolic names... Done ----- pass 5 ----- Mapping CVS revisions to Subversion commits... Creating Subversion r2 (commit) Creating Subversion r3 (closing tag/branch 'bizenn') Creating Subversion r4 (commit) Creating Subversion r5 (closing tag/branch 'initial') Creating Subversion r6 (commit) Creating Subversion r7 (commit) Creating Subversion r8 (commit) Creating Subversion r9 (commit) Creating Subversion r10 (closing tag/branch 'RELEASE_0_1') Creating Subversion r11 (commit) Creating Subversion r12 (commit) Creating Subversion r13 (commit) Creating Subversion r14 (commit) Creating Subversion r15 (commit) Done ----- pass 6 ----- Sorting symbolic name source revisions... Done ----- pass 7 ----- Determining offsets for all symbolic names... Done. ----- pass 8 ----- Starting Subversion Dumpfile. Starting Subversion r1 / 15 Starting Subversion r2 / 15 Starting Subversion r3 / 15 Starting Subversion r4 / 15 Starting Subversion r5 / 15 Starting Subversion r6 / 15 Starting Subversion r7 / 15 Starting Subversion r8 / 15 Starting Subversion r9 / 15 Starting Subversion r10 / 15 Starting Subversion r11 / 15 Starting Subversion r12 / 15 Starting Subversion r13 / 15 Starting Subversion r14 / 15 Starting Subversion r15 / 15 Done. cvs2svn Statistics: ------------------ Total CVS Files: 12 Total CVS Revisions: 40 Total Unique Tags: 2 Total Unique Branches: 1 CVS Repos Size in KB: 118 Total SVN Commits: 15 First Revision Date: Mon May 16 15:00:35 2005 Last Revision Date: Tue Aug 2 06:17:43 2005 ------------------ Timings: ------------------ pass 1: 0 seconds pass 2: 0 seconds pass 3: 0 seconds pass 4: 0 seconds pass 5: 0 seconds pass 6: 0 seconds pass 7: 0 seconds pass 8: 0 seconds total: 1 second
で、これをsvnadminでリポジトリに読み込む。あらかじめ リポジトリ内にこのプロジェクトを格納するディレクトリを掘っておくことに注意。
% svn mkdir file:///home/bizenn/repos/Gauche-mcrypt -m "Import from CVS repository."
Committed revision 432.
% svnadmin --parent-dir Gauche-mcrypt load ~/repos <Gauche-mcrypt.dump
<<< Started new transaction, based on original revision 1
* adding path : Gauche-mcrypt/trunk ... done.
* adding path : Gauche-mcrypt/branches ... done.
* adding path : Gauche-mcrypt/tags ... done.
------- Committed new rev 433 (loaded from original rev 1) >>>
<<< Started new transaction, based on original revision 2
* adding path : Gauche-mcrypt/trunk/install-sh ... done.
* adding path : Gauche-mcrypt/trunk/mcrypt_if.c ... done.
* adding path : Gauche-mcrypt/trunk/config.sub ... done.
* adding path : Gauche-mcrypt/trunk/config.guess ... done.
* adding path : Gauche-mcrypt/trunk/mcrypt.scm ... done.
* adding path : Gauche-mcrypt/trunk/test.scm ... done.
* adding path : Gauche-mcrypt/trunk/mcrypt_if.h ... done.
* adding path : Gauche-mcrypt/trunk/Makefile.in ... done.
* adding path : Gauche-mcrypt/trunk/mcrypt.stub ... done.
* adding path : Gauche-mcrypt/trunk/configure.ac ... done.
* adding path : Gauche-mcrypt/trunk/autogen.sh ... done.
------- Committed new rev 434 (loaded from original rev 2) >>>
<<< Started new transaction, based on original revision 3
* adding path : Gauche-mcrypt/branches/bizenn ...COPIED... done.
------- Committed new rev 435 (loaded from original rev 3) >>>
<<< Started new transaction, based on original revision 4
------- Committed new rev 436 (loaded from original rev 4) >>>
<<< Started new transaction, based on original revision 5
* adding path : Gauche-mcrypt/tags/initial ...COPIED... done.
------- Committed new rev 437 (loaded from original rev 5) >>>
<<< Started new transaction, based on original revision 6
* editing path : Gauche-mcrypt/trunk/mcrypt.scm ... done.
* editing path : Gauche-mcrypt/trunk/test.scm ... done.
------- Committed new rev 438 (loaded from original rev 6) >>>
<<< Started new transaction, based on original revision 7
* adding path : Gauche-mcrypt/trunk/mcrypt_port.c ... done.
* editing path : Gauche-mcrypt/trunk/mcrypt_if.h ... done.
* editing path : Gauche-mcrypt/trunk/Makefile.in ... done.
* editing path : Gauche-mcrypt/trunk/mcrypt.stub ... done.
* editing path : Gauche-mcrypt/trunk/mcrypt.scm ... done.
* editing path : Gauche-mcrypt/trunk/test.scm ... done.
------- Committed new rev 439 (loaded from original rev 7) >>>
<<< Started new transaction, based on original revision 8
* editing path : Gauche-mcrypt/trunk/mcrypt_port.c ... done.
* editing path : Gauche-mcrypt/trunk/mcrypt.scm ... done.
* editing path : Gauche-mcrypt/trunk/test.scm ... done.
------- Committed new rev 440 (loaded from original rev 8) >>>
<<< Started new transaction, based on original revision 9
* editing path : Gauche-mcrypt/trunk/configure.ac ... done.
------- Committed new rev 441 (loaded from original rev 9) >>>
<<< Started new transaction, based on original revision 10
* adding path : Gauche-mcrypt/tags/RELEASE_0_1 ...COPIED... done.
* deleting path : Gauche-mcrypt/tags/RELEASE_0_1/autogen.sh ... done.
* adding path : Gauche-mcrypt/tags/RELEASE_0_1/autogen.sh ...COPIED... done.
* deleting path : Gauche-mcrypt/tags/RELEASE_0_1/config.guess ... done.
* adding path : Gauche-mcrypt/tags/RELEASE_0_1/config.guess ...COPIED... done.
* deleting path : Gauche-mcrypt/tags/RELEASE_0_1/config.sub ... done.
* adding path : Gauche-mcrypt/tags/RELEASE_0_1/config.sub ...COPIED... done.
* deleting path : Gauche-mcrypt/tags/RELEASE_0_1/install-sh ... done.
* adding path : Gauche-mcrypt/tags/RELEASE_0_1/install-sh ...COPIED... done.
* deleting path : Gauche-mcrypt/tags/RELEASE_0_1/mcrypt_if.c ... done.
* adding path : Gauche-mcrypt/tags/RELEASE_0_1/mcrypt_if.c ...COPIED... done.
------- Committed new rev 442 (loaded from original rev 10) >>>
<<< Started new transaction, based on original revision 11
* editing path : Gauche-mcrypt/trunk/test.scm ... done.
* editing path : Gauche-mcrypt/trunk/mcrypt.scm ... done.
------- Committed new rev 443 (loaded from original rev 11) >>>
<<< Started new transaction, based on original revision 12
* editing path : Gauche-mcrypt/trunk/mcrypt.scm ... done.
------- Committed new rev 444 (loaded from original rev 12) >>>
<<< Started new transaction, based on original revision 13
* editing path : Gauche-mcrypt/trunk/Makefile.in ... done.
------- Committed new rev 445 (loaded from original rev 13) >>>
<<< Started new transaction, based on original revision 14
* editing path : Gauche-mcrypt/trunk/mcrypt.scm ... done.
------- Committed new rev 446 (loaded from original rev 14) >>>
<<< Started new transaction, based on original revision 15
* editing path : Gauche-mcrypt/trunk/mcrypt.stub ... done.
------- Committed new rev 447 (loaded from original rev 15) >>>
%
ちゃんと取り込めたか確認する。
% svn ls file:///home/bizenn/repos/Gauche-mcrypt branches/ tags/ trunk/ % svn ls file:///home/bizenn/repos/Gauche-mcrypt/trunk Makefile.in autogen.sh config.guess config.sub configure.ac install-sh mcrypt.scm mcrypt.stub mcrypt_if.c mcrypt_if.h mcrypt_port.c test.scm % svn ls file:///home/bizenn/repos/Gauche-mcrypt/tags RELEASE_0_1/ initial/ % svn ls file:///home/bizenn/repos/Gauche-mcrypt/branches bizenn/
タグやブランチもちゃんと取り込まれてていい感じ。
--び
2006-06-29 [Gauche] リスト構築時にreverseしないですませる方法
最近更新が滞っていますが、ぼちぼちと追いついていきます。ご容赦のほどを。
さて、Lisp系言語でconsを使ってリストを組み上げていくようなコードを書いていると、 最後にreverseやreverse!で作ったリストをひっくり返すことがよくある。
例:
(define ls '(1 2 3 4 5))
;; simple copy
(define ls2
(let loop ((ls ls)
(res '()))
(if (null? ls)
(reverse! res)
(loop (cdr ls) (cons (car ls) res)))))
appendは効率が悪いし、どうすればひっくり返さずに済むのかなぁと思っていたけど、 ふと、util.queueを使うことを思いついた。
(use util.queue)
(define ls3
(let loop ((ls ls)
(q (make-queue)))
(if (null? ls)
(dequeue-all! q)
(loop (cdr ls) (enqueue! q (car ls))))))
理屈の上では効率よさそうだけど、本当のところはどうなんだろ。
#!/usr/bin/env gosh
;;; -*- mode: scheme; coding: utf-8 -*-
(use srfi-1)
(use util.queue)
(define (simple-copy ls)
(let loop ((ls ls)
(res '()))
(if (null? ls)
(reverse! res)
(loop (cdr ls) (cons (car ls) res)))))
(define (queue-copy ls)
(let loop ((ls ls)
(q (make-queue)))
(if (null? ls)
(dequeue-all! q)
(loop (cdr ls) (enqueue! q (car ls))))))
(define (main args)
((case (string->symbol (cadr args))
((simple) simple-copy)
((queue) queue-copy))
(iota (x->number (caddr args))))
0)
こんなのを作って試してみた
% time gosh copy-list.scm simple 1000000 gosh normal-list.scm simple 1000000 0.52s user 0.03s system 99% cpu 0.554 total % time gosh copy-list.scm queue 1000000 gosh normal-list.scm queue 1000000 0.82s user 0.03s system 99% cpu 0.856 total
あれれ。reverse!した方が速い。小細工せず reverse! した方がいいってことですかね。
--び
すくなくとも計算オーダーは同じだから、reverse! vs dequeue-all! と cons vs euqueue! ということになるのかしらん。予想にすぎませんが、T(reverse!) ≒ T(dequeue-all!) で、T(cons) < T(enqueue!) じゃないかしらん。
dequeue-all! はreverse!と違ってリストのサイズに依存しないので、数個以上の 要素のリストならdequeue-all!の方がはるかに速いです。 このケースは T(inlined cons) << T(call enqueue!) だと思います。 consは直接VMインストラクションに展開されるので。simple-copyと queue-copyをdisasmしてみて下さい。
gosh> (disasm simple-copy)
main_code (name=simple-copy, code=0x393d70, size=19, const=1, stack=16):
args: #f
0 LREF0-PUSH ; ls
1 CONSTN-PUSH
2 LOCAL-ENV(2)
3 LREF1 ; ls
4 BNNULL 9 ; (null? ls)
6 LREF0-PUSH-GREF-TAIL-CALL(1) #<identifier user#reverse!>; (reverse! res)
8 RET
9 LREF1 ; ls
10 CDR-PUSH ; (cdr ls)
11 LREF1 ; ls
12 CAR-PUSH ; (car ls)
13 LREF0 ; res
14 CONS-PUSH ; (cons (car ls) res)
15 LOCAL-ENV-JUMP(1) 3 ; (loop (cdr ls) (cons (car ls) res))
17 RET
18 RET
#<undef>
gosh> (disasm queue-copy)
main_code (name=queue-copy, code=0x37ebd0, size=26, const=3, stack=24):
args: #f
0 LREF0-PUSH ; ls
1 PRE-CALL(0) 5
3 GREF-CALL(0) #<identifier user#make-queue>; (make-queue)
5 PUSH-LOCAL-ENV(2)
6 LREF1 ; ls
7 BNNULL 12 ; (null? ls)
9 LREF0-PUSH-GREF-TAIL-CALL(1) #<identifier user#dequeue-all!>; (dequeue-all! q)
11 RET
12 LREF1 ; ls
13 CDR-PUSH ; (cdr ls)
14 PRE-CALL(2) 21
16 LREF0-PUSH ; q
17 LREF1 ; ls
18 CAR-PUSH ; (car ls)
19 GREF-CALL(2) #<identifier user#enqueue!>; (enqueue! q (car ls))
21 PUSH
22 LOCAL-ENV-JUMP(1) 6 ; (loop (cdr ls) (enqueue! q (car ls)))
24 RET
25 RET
#<undef>
gosh>
こんな感じです。
2006-06-28 [Gauche] 他方のリストにある要素をマークする
リスト1とリスト2がある。リスト1の各要素について、リスト2に存在しない要素を#f、リスト2に存在する要素をそれ自身とするリストを得よ。
例:
リスト1: '(1 2 3 4 5 6 7) リスト2: '(3 4 6) 結果: '(#f #f 3 4 #f 6 #f)
Gaucheの例:
(use gauche.collection)
(use srfi-1)
(map-accum
(lambda (x s) (values (find (cut eq? x <>) s)
(drop-while (cut > x <>) s)))
'(3 4 6)
'(1 2 3 4 5 6 7))
--yasuyuki
(map (lambda(x) (and (member x '(3 4 6)) x )) '(1 2 3 4 5 6 7))
2006-06-27 [quiz] 他方のリストにある要素をマークする
リスト1とリスト2がある。リスト1の各要素について、リスト2に存在しない要素を#f、リスト2に存在する要素をそれ自身とするリストを得よ。
例:
リスト1: '(1 2 3 4 5 6 7) リスト2: '(3 4 6) 結果: '(#f #f 3 4 #f 6 #f)
--yasuyuki
There is no comment.
2006-06-26 [Gauche] Curlみたいな(?)プログラム
Gaucheでは{}[]は()と同様に扱われる。
$ gosh
gosh> {define {square x} {* x x}}
square
gosh> [define x 5]
x
gosh> {square x}
25
gosh> {exit}
$
...何とも複雑な心境。
--yasuyuki
There is no comment.
2006-06-23 [misc] screenから呼び出されたシェルのプロンプトを変更する
んで、めでたくログインシェルにしたのはいいのだが、 screenの中にいるのかそうでないのか、 ぱっと見でわからなくなるのは困る。
KAKKO="["
KOKKA="]"
if [ "$TERM" = "screen" ]; then
KAKKO="[["
KOKKA="]]"
fi
PROMPT="$KAKKO$USER@%m:%~$KOKKA
%# "
こんなのを~/.profile(筆者の場合は~/.zprofile)に入れている。 こうすると、素の状態では
[bizenn@raven:~] %
screenの中では
[[bizenn@raven:~]] %
てな感じになる。派手好きな方はエスケープシーケンスで彩ってもいいかも。
--び
There is no comment.
2006-06-22 [misc] screenで呼び出すシェルをログインシェルにする
サーバ運用には欠かせない(よね?) GNU screen だが、 普通に起動すると、起動されたシェルはログインシェルにならない。つまり、sh系であれば/.profile を読んでくれない。ログインシェルにするにはどうするか。 標準的な方法がどうなのか知らないのだが、筆者は次の一行を~/.screenrcに入れている。
shell -/usr/local/bin/zsh
言うまでもなく、シェルのパスの先頭に入っている"-"がキモ。
--び
There is no comment.
2006-06-21 [MySQL] テーブルの数をcountするSQL
select count(*) from information_schema.tables;
ただしMySQLバージョン5以上でないと不可。
--yasuyuki
There is no comment.
2006-06-20 [Mac OS X] daemontoolsを使う時の注意
以前から何度か書いているように、筆者はdaemontoolsの愛用者で、 Macにも当然のようにdaemontoolsをインストールしている。 新しいMacBookにもインストールしたのだが、ハマりどころがあるのを思い出した。
daemontoolsを普通にコンパイルしてインストールして動かし始めると、 superviseプロセスが異常にCPUを喰っていることに気づく。 この現象、以前にも遭遇したことがあるのを憶えていたので、 手許のChangeLog形式のメモをひっくり返してみると、 Mac OS X 10.4 に移行した際に全く同じ経験をしていた。
Mac OS Xは、10.3までpoll(2)がなく、10.4から使えるようになったのだが、 どうもこいつの挙動が世の中の他のOSのものとは違うらしい。 だが、daemontoolsはコンパイル時にpoll(2)があるとselect(2)ではなく poll(2)を使おうとする。すると、CPUを異常に喰うという現象となるのだ。
ということで、poll(2)ではなくselect(2)を使うようにコンパイルし直せばよい。 具体的には、1回通常通りコンパイルした後、
% cd /package/admin/daemontools-0.76/compile % sudo cp iopause.h1 iopause.h % cd .. % sudo package/compile % sudo rm -rf /service % sudo package/install
あとは2006-05-16を参考に自動起動の設定をすればよい。
--び
参考になりました。 cd /package/admin/daemontools-0.76/compile じゃなくて cd /package/admin/daemontools-0.76/src でした。
すみません。 cd /package/admin/daemontools-0.76/compile であってました。 お手数ですが、可能なら、Mon Dec 11 23:28:56 2006 のコメントと、 このコメントは消してしまってください。
2006-06-19 [Mac OS X] Intel Macでpkgsrcを使う
黒のMacBookを手に入れた。 もちろんUNIX的に使うので、何かのパッケージングシステムを使いたいのだが、 NetBSDユーザである筆者が選択するのは、当然 pkgsrcということになる。 NetBSD用のパッケージングシステムだったpkgsrcは、 今やさまざまなOSで使うことができるようになっている。
まず、NetBSDの配布物を置いているFTPサイトなどから、pkgsrc.tar.gz取ってきて 展開する。筆者の場合、ext60という名前をつけた外付けHDD(case-sensitiveなHFS+ としてフォーマットしてある)に展開している。次に
% cd /Volumes/ext60/pkgsrc/bootstrap
% sudo ./bootstrap --prefix=/usr/pkg --pkgdbdir=/usr/pkg/var/db/pkg \
--varbase=/usr/pkg/var --ignore-case-check
上記のオプションをつけている理由は、pkgsrcでインストールするファイルを全て /usr/pkgの下に集めるためだ。こうしておくと、他のマシンに /usr/pkg をコピー すれば、0からインストールしなくてもそれまで使っていた環境を持っていけて便利なのだ。
次に、/etc/mk.conf を書く。/Volumes/ext60/pkgsrc/bootstrap/workにサンプルファイルが 作られているはず。筆者が使っているのはこんな感じ。
PKGSRCDIR=/Volumes/ext60/pkgsrc .ifdef BSD_PKG_MK # begin pkgsrc settings VARBASE=/usr/pkg/var PKG_DBDIR=/usr/pkg/var/db/pkg LOCALBASE=/usr/pkg FETCH_CMD=/usr/pkg/bin/ftp PAX=/usr/pkg/bin/pax GTAR=/usr/pkg/bin/tar USE_MAKEINFO=yes MAKEINFO=/usr/bin/makeinfo ACCEPTABLE_LICENSES+=fee-based-commercial-use ACCEPTABLE_LICENSES+=no-commercial-use ACCEPTABLE_LICENSES+=djb-nonlicense USE_IPV6= YES USE_ARES= YES PKG_OPTIONS.gnupg= curl idea USE_BUILTIN.zlib= yes USE_BUILTIN.bzip2= yes USE_BUILTIN.libpcap= yes USE_BUILTIN.tcp_wrappers= yes APACHE_MPM= worker .endif # end pkgsrc settings
このあたりは好み全開。詳しい情報は上記のサイトか、 pkgsrc/doc にあるドキュメントを読むべし。
これで基本的な準備はできたので、
% bmake % bmake install
でインストールできるはず。Intel MacはPowerPC Macに比べて、 コンパイルが非常に速いので、たくさんコンパイルしてもストレスが少ない(笑)。
--び
There is no comment.
2006-06-16 [Gauche] スロットのオーバーライドを禁止する
Javaなんかだと final 修飾子をつけるだけなんだけど、CLOS系OOPL(って言っていいのか?)の場合は 「そういう仕組みを自分で作るための仕組み」が提供されている。
(use srfi-1)
(use gauche.collection)
(define-method find-final-slot-violation ((c <class>))
(fold2 (lambda (c v r)
(values (fold (lambda (s v)
(if (memq (slot-definition-name s) r)
(lset-adjoin eq? v (slot-definition-name s))
v))
v
(class-direct-slots c))
(fold (lambda (s r)
(if (slot-definition-option s :final #f)
(lset-adjoin eq? r (slot-definition-name s))
r))
r
(class-direct-slots c))))
'() '() (reverse (slot-ref c 'cpl))))
(define-class <hoge-meta> (<class>)
())
(define-method initialize ((self <hoge-meta>) initargs)
(next-method)
(let1 violated-slots (values-ref (find-final-slot-violation self) 0)
(unless (null? violated-slots)
(errorf "Final slot violation: ~s: ~a"
self
(string-join (map symbol->string violated-slots) ", ")))))
こんなのを定義しといて
(define-class <hoge-base> () ((id :init-keyword :id :final #t) (data-A :init-keyword :data-A :init-value 'a) (data-B :init-keyword :data-B :init-value 'b :final #t) (data-C :init-keyword :data-C :init-value 'c :final #t)) :metaclass <hoge-meta>) (define-class <moke-base> () ((data-X :init-keyword :data-X :init-value 'x) (data-Y :init-keyword :data-Y :init-value 'y) (data-Z :init-keyword :data-Z :init-value 'z) (data-C :init-keyword :data-C :init-value 'C)))
こんなのが定義されていたとすると(:finalってオプションがオーバーライド禁止を指定している)、
(define-class <hoge> (<hoge-base> <moke-base>) ( (id :init-keyword :id) (data-A :init-keyword :data-A :init-value 'A) (data-B :init-keyword :data-B :init-value 'B) (data-Z :init-keyword :data-Z :init-value 'Z)))
こんなのを定義しようとした時、
*** ERROR: Final slot violation: #<class <hoge>>: data-B, id
Stack Trace:
_______________________________________
0 (make (%get-default-metaclass (list <hoge-base> <moke-base>)) :nam ...
[unknown location]
てな感じで怒られる。こういうのを「柔軟でステキ」と思うか「メンドクセ」と 思うかで道は分かれる、かもしれない(笑)。まぁ :final オプションくらいあっても 罰は当たらない気はする。
なお、この案に対して、「compute-slotsをオーバーライドする方がMOP的には美しい」 というアドバイスをいただいた。
(define-method compute-slots ((self <hoge-meta>))
(receive (slots vs)
(fold2 (lambda (class slots vs)
(fold2 (lambda (s slots vs)
(if (assq (slot-definition-name s) slots)
(if (slot-definition-option s :final #f)
(values slots (cons s vs))
(values slots vs))
(values (cons s slots) vs)))
slots
vs
(class-direct-slots class)))
'()
'()
(class-precedence-list self))
(unless (null? vs)
(errorf "Final slot violation: ~s: ~a"
self
(string-join
(reverse! (map (lambda (s) (symbol->string (slot-definition-name s))) vs)) ", ")))
(reverse! slots)))
この場合は当然 initialize のオーバーライドや find-final-slot-violation は不要となる。
--び%MOP勉強中
There is no comment.
2006-06-15 [misc] quitコマンド
slコマンドから派生したのがquit。
実行するとこんなのが通過する。
┏━┓
┃も┃
┃う┃
┃来┃
┃ね┃
┃ぇ┃
┃よ┃
┃!!┃
プン ┣━┛ バカ
(Д´ ) ヽ(`Д´)ノヽ(`Д´)ノヽ(`Д´)ノ
U┌/ ）□─|‾‾‾|─|‾‾‾|──|‾‾‾|
◎┗<━◎ ‾◎‾ ‾◎‾ ‾◎‾ 〜〜
slのようなオプションはなさげ。
--yasuyuki
There is no comment.
2006-06-14 [Haskell] 連続した欠番
2006-06-08 連続した欠番が欲しいときがある．
missings low n xs は整数のリスト xs で low を超える n 個の連続した 欠番を求める．
これを使って，minuids を作る．
module Main where
import System.Environment
import Data.List
usage :: String -> IO ()
usage pgn = putStrLn ("Usage : "++pgn++" lowerlimit number")
main = do { pg <- getProgName
; args <- getArgs
; case args of
[lim,num]
-> getContents >>= putStrLn . show
. missings (read lim) (read num)
. sort . map (read . (!!3) . wordsBySep ':')
. lines
_ -> usage pg
}
missings :: Int -> Int -> [Int] -> [Int]
missings l n xs = misseds [] 0 (l+1) (dropWhile (l >=) xs)
where misseds ys m y zzs@(z:zs)
| m == n = reverse ys
| y == z = misseds [] 0 (y+1) zs
| y < z = misseds (y:ys) (m+1) (y+1) zzs
wordsBySep :: Char -> String -> [String]
wordsBySep c "" = []
wordsBySep c s = case break (c==) s of
(xs,_:ys) -> xs : wordsBySep c ys
_ -> [s]
runhaskell minuids.hs 100 10 < /etc/passed [112,113,114,115,116,117,118,119,120,121]
--nobsun
missings :: Int -> Int -> [Int] -> [Int]
missings low n [] = take n [low+1..]
missings low n (x:xs)
| low + n < x = take n [low+1..]
| otherwise = missings x n xs
2006-06-13 [misc] slコマンドのオプション
lsコマンドを打ち間違えたときにコンソールをSLが走るslコマンド。オプションがあるのを知ってましたか?
$ man sl
SL(1) SL(1)
名称
sl - キータイプを矯正します。
形式
sl [ -alF ]
解説
sl は、高度に発展した、キータイプ矯正を目的とするアニメーションプログラムです。
次のようなオプションがあります。
-a なにかアクシデントがあったようですね。助けを求める人々が悲痛です。
-l 小さくなります。
-F 飛びます。
-e Ctrl+C で途中で止めることを許します。
関連事項
ls(1)
バグ
カレントディレクトリの内容が表示されることがあります。
著者
豊田 正史（toyoda@isea.is.titech.ac.jp）
Jan 24, 2001 SL(1)
sl -alFなどと起動すると、助けを求めながら小くなって飛びます。w
slコマンドについては作者の豊田氏のWebページが参考になります。
http://www.tkl.iis.u-tokyo.ac.jp/~toyoda/
--yasuyuki
知らなかった… slって最近はダメージ少ないけれど、2400baudのモデムで大学に つないでた時代はずいぶんいらいらさせられたものだ。 ところで私が覚えているslの初期バージョンって、単に (各画面 + 画面クリアエスケープシーケンス)*フレーム数、 のキャラクタデータをgzipしたものの先頭に 「自分自身を一行読み捨ててからzcatに渡す」という コマンド行を追加しただけのシェルスクリプトだったような 覚えがあるんだけれど、作者のページを見ると最初からCで 書かれてたのかな? 当時中身を覗いて感心した記憶があったの だが何かとごっちゃになっているのかな?
15日にもslの派生バージョン(?)を紹介する予定です。 (び)さんに教えてもらったのですが、 slのHaskellバージョンもあるらしいです。
http://kzk9.net/software/hasl/ これですね。ja.reddit.com 経由で知りました。 最近のマシンだと本当に爆速で駆け抜けます。
最近のマシンだと速すぎて、教育的効果がないですよね。 だって、わざわざ、インストールして、オプション覚えて、 鑑賞しようというのだもの :p
2006-06-12 [Gauche] 空いているUIDの最小値を得る
さらに引っ張ります(笑)。 2006-06-08 の課題(課題だったのか?)をGaucheでもやってみた。 アカウント情報の源は /etc/passwd とは限らないので、passwd形式のデータを 読み出せる入力ポートを渡せるようにした方がつぶしがきく。 2006-06-08 のもそういう関数にすればよかったと思い直した。
(define (get-minuid min in)
(fold (lambda (uid min) (if (= min uid) (+ min 1) min))
min
(sort!
(map (lambda (l)
(x->integer (list-ref (string-split l #\:) 2)))
(port->list read-line in))
<)))
簡単といえばまぁ簡単だけど、単に fold を使ってみせたかっただけとも言う。
--び
おっ。foldがあったか。
2006-06-09 [Haskell] 空いているUIDの最小値を得る
2006-06-08 の課題をHaskellでもやってみた． さすがにちょっと面倒．．．ゥム
module Main where
-- 空いているUIDの最小値を得る
import System
import Data.List
usage :: IO ()
usage = putStrLn "Usage: minuid lowerlimit"
main :: IO ()
main = do { args <- getArgs
; case args of
[lim] -> readFile "/etc/passwd"
>>= putStrLn . show . head . subt [n+1..] . dropWhile (n >=) . sort
. map ((read::String->Int) . (!!3) . wordsBySep ':') . lines
where n = read lim :: Int
_ -> usage
}
subt :: Ord a => [a] -> [a] -> [a]
subt [] _ = []
subt xxs [] = xxs
subt xxs@(x:xs) yys@(y:ys) = case compare x y of LT -> x:subt xs yys; EQ -> subt xs ys; GT -> subt xxs ys
wordsBySep :: Char -> String -> [String]
wordsBySep c "" = []
wordsBySep c s = case break (c==) s of (xs,_:ys) -> xs : wordsBySep c ys; _ -> [s]
--nobsun
There is no comment.
2006-06-08 [Tips] 空いているUIDの最小値を得る
ある値より上で、空いているUIDの最小値を得たいことがある。 例えば、あるデーモンを実行するためのアカウントを作る場合だ。 いろいろなやり方があると思うが、インストールshスクリプトの中でよく使うのは 次のようなコード。
:
get_minuid () {
sort -t: +2 -n /etc/passwd|\
awk "BEGIN{FS=\":\";min=$1}\$3==min{min++}END{print min}"
}
:
NEWUID=`get_minuid 400`
たいていのUNIX系OSならうまくいくと思うが、 NISやpam_*を使ってユーザを管理しているような環境だと、 ユーザ一覧を得るのに工夫がいる。Mac OS XはユーザIDを netinfo上で管理していて、/etc/passwdはダミーだから、 上記の方法では嘘を教えられるハメになる。
get_minuid () {
nidump passwd .|\
sort -t: +2 -n |\
awk "BEGIN{FS=\":\";min=$1}\$3==min{min++}END{print min}"
}
:
NEWUID=`get_minuid 400`
こんな感じでやっている。もっとエレガントな方法はないものだろうか。
ちなみに、最近のNetBSDのuseradd/groupaddでは、 -rで使用するUID/GIDの範囲が指定できるから、上記のようなコードは不要になる。
--び
There is no comment.
2006-06-07 [Tips] find+xargsで空白を含むファイル名を処理する
UNIX系OSの上で生活をしていると、findとxargsの組み合わせで大量のファイルを処理する場面がよくある。
% find ~/ -name '*.log.*' -a ! -name '*.gz' -mtime +0|xargs gzip
これはたいていうまいくし、findだけで処理する場合
% find ~/ -name '*.log.*' -a ! -name '*.gz' -mtime +0 -exec gzip {} \;
よりもずっと速い。ただし、findの条件にマッチするファイル名が空白を含んでいる場合はうまく動かない。 だから、本当は以下のようにやるのが正しい。
% find ~/ -name '*.log.*' -a ! -name '*.gz' -mtime +0 -print0|xargs -0 gzip
Linuxや*BSDでは空白を含むファイル名を使う機会なぞほとんどないだろうが、 Mac OS Xでは当たり前のように使われているため、意外にハマる機会が多い。 また、ファイル名に日本語(を始めとするマルチバイト文字)が含まれる場合も、 このコマンドラインでないと
xargs: unterminated quote
と言われてしまってうまくいかない。
--び
There is no comment.
2006-06-06 [Tips] cronologの過去ログを圧縮
cronologはログの出力先の切り替えをしてはくれるが、過去のログを圧縮してくれない。 ということで以下の行をrootユーザのcrontabに加えておこう。
30 4 * * * find /var/log/apache2 -name '*.log.*' -a ! -name '*.gz' -mtime +0|xargs gzip
該当するログファイルが存在しない場合でもエラーにならないようにするとか、 もっとエラー処理をちゃんとしたければshスクリプトか他の言語でスクリプトを書くのが吉。 ディスクフルは突然やってくる。「そのうちやっときゃいいや」と 思っていると痛い目を見るよ(いや実際見たのだが...)。
--び
There is no comment.
2006-06-05 [Haskell] here
結城さんの here:「ここにあとで来る」ためのバッチファイルを作るスクリプト のHaskell版，他でも書いた やつを少し改良(上書きしない というだけだけど．．．)
#!/usr/bin/env runhaskell
\begin{code}
module Main where
import System
import System.Directory
usage :: IO ()
usage = getProgName >>= \ pg -> putStrLn ("Usage: "++pg++" projectname")
main :: IO ()
main = flip catch ioError
(
do args <- getArgs
case args of
[] -> usage
pj:_ -> do cd <- getCurrentDirectory
home <- getUserDocumentsDirectory
let h = "#!/bin/sh"; c = "cd "++cd; f = home++"/bin/"++pj
exist <- doesFileExist f
if exist
then putStrLn $ pj++" already exists!"
else do writeFile f $ unlines [h,c]
p <- getPermissions f
setPermissions f (p {executable = True})
)
\end{code}
--nobsun
There is no comment.
2006-06-02 [Tips] 内蔵無線LAN on NetBSD on ThinkPad T43p
めちゃめちゃ局所ネタ。 ThinkPad T43pにNetBSD currentを入れているんだけど、 内蔵の無線LANを使うには次のようにする。
- pkgsrc で sysutils/iwi-firmware をmake; make install
- /usr/pkg/libdata/if_iwi 以下に iwi-bss.fw のようなファイルが install されてることを確認
- iwictl -i iwi0 -d /usr/pkg/libdata/if_iwi -m bss
- ifconfig iwi ssid "xxxx" nwkey "yyyyyyyyy" up
こんな感じです。 私の今いる環境だと dhclient を走らせてやれば、ping が通るようになるのでした。
-cut-sea.
There is no comment.
2006-06-01 [Haskell] I/O も Lazy ゆえに ．．．つづき．
2006-05-31の最後のコードで正しいように見えるが， これは入力がブロックバッファリングモードで動作しておりたまたま そのバッファの大きさより小さいファイルだったからうまくいったのである．
ためしに非バッファリングモードにしてみると，
import Data.Char
import System.IO
main = do { r <- openFile "humuhumu.txt" ReadMode
; hSetBuffering r NoBuffering
; s <- hGetContents r
; s `seq` hClose r
; w <- openFile "humuhumu.txt" WriteMode
; hPutStr w (foo s)
; hClose w
}
foo = map toUpper
実行してみると，
% runhaskell foo.hs % cat humuhumu.txt H
1文字だけしか処理されていない．これは，「s を評価」するとき，s の データコンストラクタが分るまでしか評価しないからである．
この場合は文字列が1文字以上か空かを判定できるまでしか評価しない． したがって，1文字以上であることが判るところまでしか読みこまれないという わけである．
さてどうすればよいか．もっとも安直な方法は，
s `seq` hClose r
のかわりに
length s `seq` hClose r
とすることである．なぜこれで上手くいくかは宿題．^^;
--nobsun
There is no comment.
There is no comment.