Hatena::ブログ(Diary)

純粋関数型雑記帳 このページをアンテナに追加 RSSフィード Twitter

このページはHaskellを愛でるページです。
日刊形式でHaskellなどについての記事をだらだらと掲載しとります。
2004 | 07 | 08 | 09 | 10 | 11 | 12 |
2005 | 01 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2006 | 01 | 02 | 03 | 04 | 06 | 07 | 08 | 09 | 11 |
2007 | 03 | 04 | 05 | 07 | 08 | 09 | 12 |
2008 | 02 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 03 | 05 | 06 | 09 | 10 | 11 | 12 |
2010 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 12 |
2011 | 01 | 02 | 05 |
本体サイト

2004年07月31日(土) まずは基本的なことを

[][]Parser Combinatorというもの(その2) Parser Combinatorというもの(その2)を含むブックマーク Parser Combinatorというもの(その2)のブックマークコメント

このページにはいわゆる解説記事を載せるつもりは無かったのだが、

(たいていは他にもっとうまい説明のページがあるだろうから…)

どうやらこれがそうなってしまいそうである。

もっとまともな解説は

http://sky.zero.ad.jp/~zaa54437/programming/clean/CleanBook/part2/Chap5.html

こちらをどうぞ。(って人のページなんだけどな…)

  • 概要

パーザコンビネータはプリミティブパーザと

パーザ同士を組み合わせるコンビネータとからなる。

小さいパーザを組み立てて最終的なパーザを作り上げるのである。


  • パーザ

パーザはいろいろなものが考えられるが、

ここでは単純に、文字列を引数にとり、

解析したもの+残りの文字列を返す関数であるとする。

type Parser a = String -> (a,String)

Stringもパラメータ化すると、もっと抽象的になる。

type Parser s a = [s] -> (a,[s])

これだと確定的なパーザであるが、

文法によってはいつも解析が一通りに決まるとは限らない。

そのような文法を解析できるように解析結果として全候補を返すようにする。

type Parser s a = [s] -> [(a,[s])]

これで多分十分である。

  • プリミティブパーザ

プリミティブなものとなるパーザを考える。

まず、一文字を解析するパーザ

symbol :: Eq s => s -> Parser s s
symbol c (x:xs) | c==x      = [(x,xs)]
symbol _ _                  = []

symbol 'a' とすると'a'という文字を解析するパーザとなる。

Main> (symbol 'a') "abc"
[('a',"bc")]
Main> (symbol 'a') "dab"
[]

このような挙動を示す。

このパーザを一般的にしたもの、

satisfy :: (s -> Bool) -> Parser s s
satisfy p (x:xs) | p x = [(x,xs)]
satisfy _ _            = []

が考えられる。これを用いるとsymbolは

symbol c = satisfy (==c)

と定義できる。


便利のためにトークン列を解析するパーザ

token :: Eq s => [s] -> Parser s [s]
token t ls | t == take n ls = [(t,drop n ls)]
           | otherwise      = []
  where n = length t

組み合わせるために使う物として、

常に成功する/失敗するパーザを定義する。

success :: a -> Parser s a
success v xs = [(v,xs)]

failure :: Parser s a
failure _ = []

successは入力を消費せずに与えられたものを解析結果とする。

コンビネータとは自由項を持たない関数というぐらいの意味であるが、

ここではパーザを組み合わせてパーザを組み立てるような関数のことである。

まずは直列化。

infixr 6 <&>
(<&>) :: Parser s a -> Parser s b -> Parser s (a,b)
p <&> q = \ls -> [((r1,r2),s2) | (r1,s1) <- p ls, (r2,s2) <- q s1]

symbol 'a' <&> symbol 'b' で、abを解析するパーザとなる

Main> (symbol 'a' <&> symbol 'b') "abcde"
[(('a','b'),"cde")]
Main> (symbol 'a' <&> symbol 'b') "adcde"
[]

次に選択。

infixr 4 <|>
(<|>) :: Parser s a -> Parser s a -> Parser s a
p <|> q ls = p ls ++ q ls

symbol 'a' <|> symbol 'b' でaかbを解析するパーザになる。

Main> (symbol 'a' <|> symbol 'b') "adcde"
[('a',"dcde")]
Main> (symbol 'a' <|> symbol 'b') "bdcde"
[('b',"dcde")]
Main> (symbol 'a' <|> symbol 'b') "dcde"
[]

解析結果はこれまでトークンそのものとか、

<&>によって作られたペアとかであったが、

これではやりにくいし何より再帰的なパーザに型が付かない。

そこで、解析結果を変換するようなものを考える。

infixl 5 <@
(<@) :: Parser s a -> (a -> b) -> Parser s b
p <@ f = \ls -> [(f r,s) | (r,s) <- p ls]

これを用いて

Main> (satisfy isDigit <@ \d -> ord d - ord '0') "123"
[(1,"23")]

このようなものが作れる。


あまり重要ではないが、<&>のバリエーションとして

どちらかの解析結果を捨てるようなものを考えると便利である。

infixr 6 <&
(<&) :: Parser s a -> Parser s b -> Parser s a
p <& q = p <&> q <@ fst

infixr 6 &>
(&>) :: Parser s a -> Parser s b -> Parser s b
p &> q = p <&> q <@ snd

括弧で囲われた文字を解析するパーザが次のようになる。

Main> (symbol '(' &> satisfy (const True) <& symbol ')') "(a)cde"
[('a',"cde")]

ここまでで大体のことは出来るのであるが、

利便性を考えてもっと色々なバリエーションを考える。

与えられたパーザの0回以上の出現。

many :: Parser s a -> Parser s [a]
many p = p <&> many p <@ (\(x,xs) -> x:xs)
     <|> success []

与えられたパーザの1回以上の出現もつくれる。

many1 :: Parser s a -> Parser s [a]
many1 p = p <&> many p <@ \(x,xs) -> x:xs

これを用いると数字のパーザは次のようになる。

natural :: Parser Char Int
natural = many1 (satisfy isDigit) <@ read
Main> natural "123abc"
[(123,"abc"),(12,"3abc"),(1,"23abc")]

manyが<|>でつながれているので、1文字以上の解析すべてが結果として出てきている。

最初のもの以外は欲しくないので、最初のものだけを

返すようにする物を考える。

first :: Parser s a -> Parser s a
first p = take 1 . p

これで解析できる最長のものを返すmanyが作れる。

manyf  p = first (many  p)
many1f p = first (many1 p)

naturalでつかっているのをmany1fに変えると、

Main> natural "123abc"
[(123,"abc")]

このようになる。


もうこの辺で正規表現程度ならすべて直接表現できるのであるが、

正規表現やBNFにとらわれる必要は全く無い。

更なるコンビネータを考える。

まず、区切りで区切られたリスト

listOf :: Parser s a -> Parser s b -> Parser s [a]
listOf p s = p <&> many (s &> p) <@ (\(l,ls) -> l:ls)
         <|> success []

カンマで区切られたリストなどが簡単に作れる。

commaSep :: Parser Char a -> Parser Char [a]
commaSep p = listOf p (symbol ',')

例、カンマで区切られた数字の和を求めるパーザ

Main> (commaSep natural <@ sum) "123,456,789"
[(1368,""),(579,",789"),(123,",456,789"),(0,"123,456,789")]

listOfにて、区切り文字が意味を持つ場合がある。

四則演算などにおける演算子などである。

このような場合について、次のようなものを考えると

式の解析でとても便利である。

chainl :: Parser s a -> Parser s (a->a->a) -> Parser s a
chainl p s = p <&> many (s <&> p) <@ (\(e0,l) -> foldl (\x (op,y) -> op x y) e0 l)

chainr :: Parser s a -> Parser s (a->a->a) -> Parser s a
chainr p s = many (p <&> s) <&> p <@ (\(l,e0) -> foldr (\(x,op) y -> op x y) e0 l)

chainlが左結合、chainrが右結合で解析する。

加減算が次のように書ける。

Main> (chainl natural (symbol '+' <@ const (+) <|> symbol '-' <@ const (-))) "1-2-3+4"
[(0,""),(-4,"+4"),(-1,"-3+4"),(1,"-2-3+4")]
  • 応用例

先の式にて、演算子の優先順位は1レベルであったが、

多レベルのものも考えられる。

たとえば四則演算なら*/が+-よりも高い順位を持つ。

まず、次の補助関数を定義する。

opr :: String -> (a->a->a) -> Parser Char (a->a->a)
opr str f = token str <@ const f

choice :: [Parser s a] -> Parser s a
choice (x:xs) = foldl (<|>) x xs

四則演算のBNFは

Expr = Term { (+|-) Term }
Term = Fact { (*|/) Fact }
Fact = natural | '(' Expr ')'

このような感じ。

これを元に適当に実装すると、

expr = chainl term (opr "+" (+) <|> opr "-" (-))
term = chainl fact (opr "*" (*) <|> opr "/" div)
fact = natural <|> symbol '(' &> expr <& symbol ')'

このようになる。

演算子の部分をくくりだすと

expr = chainl term $ choice $ map (\(s,f) -> opr s f) add_op
term = chainl fact $ choice $ map (\(s,f) -> opr s f) mul_op
add_op = [("+",(+)),("-",(-))]
mul_op = [("*",(*)),("/",div)]

さらに共通部分をくくりだす。

expr = chainl term (makeOplist add_op)
term = chainl fact (makeOplist mul_op)
makeOplist = choice . map (\(s,f) -> opr s f)

exprとtermを一行にまとめると

expr = chainl (chainl fact (makeOplist mul_op)) (makeOplist add_op)

これは、foldのパターンである。

よってfoldを使って書き直せる。

expr = foldr (\op f -> chainl f (makeOplist op)) fact [mul_op,add_op]

さらにここからfact及び演算子のリストパラメータ化すると、

汎用の式解析パーザ生成関数を作ることが出来る。

buildExpr p tbl = foldl (\f op -> chainl f (makeOplist op)) p tbl

十分に汎用化された。これでexprを定義すると

expr = buildExpr fact oprTbl where
  oprTbl =
    [ [("*",(*)),("/",div)]
    , [("+",(+)),("-",(-))] ]

最後の定義に対しては演算子の追加などが非常に簡単である。

  • パーザでは無い部分

上で書いてきたパーザは結果を解析候補のリストで返す。

内部的にはともかく、これを外部的には使いにくいのである。

そこで、次のような関数を用意する。

parse :: Parser s a -> [s] -> a
parse p = fst . head . p

解析はこのように行う

Main> parse expr "1-(2-3)"
2
  • モナディック

パーザコンビネータを見て何かに似ていると思われなかったであろうか?

そう、モナドである。

実際のところ、パーザを要素、bind演算を<&>、

returnをsuccessと考えると、

(<&> の型は Parser s a -> (a -> Parser s b) -> Parser s b に変更)

パーザはモナドとなる。

実際、Haskellの標準的なライブラリについているText.ParserCombinators.Parsecは

モナディックなパーザコンビネータになっている。

(というか、昨日使ったやつ)


ということで、今日はなんだか長くなってきたので

Parsecについては次回。

今回、オリジナル要素はほぼ無しなんだけどな…

2004年07月30日(金) 最強のパーザー、Parser Combinator

実は昨日の話題はこれから書こうとする話とつながりがあるのだ。

(直接的には無いけど)

[][]Yaccと正規表現とParser Combinatorと Yaccと正規表現とParser Combinatorとを含むブックマーク Yaccと正規表現とParser Combinatorとのブックマークコメント

(序)

突然であるが、Haskellは文字列処理が強力だと思う。

それも最強レベルに。

他のいわゆる文字列処理が得意であるとされる言語のように

正規表現による置換が可能であるとか、文字列がオブジェクト

有用なメソッドがたくさん使えるとかそういった

小手先のものではなくてもっと根本的なレベルで強力なのである。


それはHaskellに於いて文字列が文字のリストであらわされていることに

起因する。わからない人から見ると文字列がリストであるということは

Cにおいて文字列が配列で表されているのとかぶるかもしれない。

Haskellが文字列をリストとして持っていてうれしいというのは

Haskellが全言語中でもほとんど最強のリスト操作能力を持っているからである。

Cで文字列が配列になっていても何もうれしくないのは、

Cが配列操作が大して得意ではないためである。


たとえば、単純置換なら (文字xを文字列yに置換)

str >>= (\c -> if c == x then y else [c])

置換対象が文字列→文字列も

replace x y str = inner str where
  inner  = 
  inner str@(s:ss)
    | isPrefixOf x s = y:inner (drop lx)
    | otherwise = s:inner ss
  lx = length x

このように定義すれば行える。(定義しなければならんのだけど)

定義さえすれば複数の置換を一度に行うのもなんのそのである。

replaceMultiple = foldl (\f (x,y) -> f . replace x y) id
...
replaceMultiple [("foo","bar"),("hello","world")] str

もちろんこのようなケースは非常に単純で、

現実にはもう少し複雑なマッチングが必要になることが多いだろう。

単純比較では無理だけど、CFG*1を持ち出すほどでも…

といった場合、多くの言語では正規表現の力を借りる。

正規表現は確かに便利である。

便利なのだが、正規表現は大体の場合において全く言語とは独立である。

プログラマは"特定の正規表現の文法"に従って"文字列"でそれを

指定することになる。

これは言語とは別に正規表現の文法を覚える必要があることを意味し、

さらに言語理系と独立なので実行時まで正規表現が正しいかどうかを

確かめられない。


Haskellだとこういった場合、Parser combinatorを使う。

Parser combinatorはHaskellにとっては普通の関数であり、

別段特殊なものではないことを一応断っておく。

普通のプログラムなので、正規表現言語クラスにとらわれることなく

BNFで表現できる文法もパーズできる。

(BNFで表現できないクラスの文法(0型言語チューリングマシンと等価)

も解析できるけど…)


とりあえず一例を書いてみる。

与えられた文字列からY/M/Dの形で与えられた文字列を

M.D,Yに置換するようなプログラムである。

なお、以下のプログラムではパーザコンビネータの"実装の一例"である

Text.ParserCombinators.Parsecを使っている。

main = putStrLn $ repl "today is 2004/07/30 desu."

repl str =
  case parse p "" str of
    Left err -> error "え〜っ?!エラー?ありえなぁ〜い!!"
    Right ls -> ls
  where
    p = do
      ls <- many $ (try date) <|> (anyChar >>= \c -> return [c])
      return $ concat ls

    date = do
      y <- many1 digit
      char '/'
      m <- many1 digit
      char '/'
      d <- many1 digit
      return $ m ++ "." ++ d ++ "," ++ y
$ ./a.out
today is 07.30,2004 desu.

正規表現を使う場合に比べてコードは長くなっていると思われるが、

エラーはコンパイル時にチェックできるし、

何よりパーザーがオブジェクトとして存在しているのである。

上記ソースだと"date"がY/M/Dを認識しM,D.Yを返すパーザーである。


このことはパーザーに関する演算を定義できることを意味する。

先のソース中でパーザーは、pとdateである。

dateはまさにこの問題のために作成したものであるが、

pが行っているのはdateで解析できるかどうかをチェックし続けているだけで、

これはこの問題固有の処理ではない。

dateを抽象化し、もっと一般的に使用できるのである。

main = putStrLn $ replaceBy date "today is 2004/07/30 desu."
  where
    date = do
      y <- many1 digit
      char '/'
      m <- many1 digit
      char '/'
      d <- many1 digit
      return $ m ++ "." ++ d ++ "," ++ y

replaceBy :: Parser String -> String -> String
replaceBy p str = 
  case parse (repAll p) "" str of
    Left err -> error "え〜っ?!(略"
    Right ls -> ls

repAll :: Parser String -> Parser String
repAll p = do
  ls <- many $ (try p) <|> (anyChar >>= \c -> return [c])
  return $ concat ls

replaceByはパーザーを引数にとり、変換関数を返す関数となる。

ここで、"today"という文字列を"yesterday"にも変える、

と動作を変更したい場合、

main = putStrLn $ replaceBy (date <|> today) "today is 2004/07/30 desu."
  where
    date  = ...
    today = string "today" >> return "yesterday"

と変更すればよい。

最初に書いたreplaceもreplaceByを用いて

replace x y = replaceBy (string x >> return y)

と書きなおすことが出来る。


string x >> return y という部分も複数回出てきたので、

replaceParser :: String -> String -> Parser String
replaceParser x y = string x >> return y

これもこのように抽象化するのがよいかも知れない。


とまぁ、なんかいろいろ出来るという話で今回はまだ

具体的なところまで突っ込むつもりは無かったのだが…

取り留めのない話になってきたので、今回はこの辺で。

次あたりにParser Combinatorというものについてを

書こうと思う。(私が書く必要も無いような気もするけど)

実践的プログラムはさらにその先にでも。

*1:文脈自由文法

2004年07月29日(木) interleaveされたIOのゆくえ

[]続・遅延IO 続・遅延IOを含むブックマーク 続・遅延IOのブックマークコメント

少し前に遅延IOの話を書いたと思う。

そのときはgetContentsなどの遅延する関数

実はモナドの法則(bind演算の結合法則)に従っておらず、

ちょっぴりunsafeで、でも入力を根こそぎ持っていくような

ケースだと大して問題にならないどころか有用にもなりえる…

のような結論に達したのであるが(そうだったっけ?)、

よくよく考えると遅延IOが遅延するが故に実現可能な

アルゴリズム(例としては、私が初期のころに書いた数当て

ゲームなどを参照されたし)などは設計にあたり細心の

注意が必要で、ある程度の複雑さになってくると

SICPでも指摘されている通りに人間には制御しきれなくなってしまう

のでは無かろうかとも思えてくる。そこで、

今回はそんなバリエーションの一つについて考察してみることにする。


ここで例として簡単なアキュームレータープログラムを考える。

インタラクティブなインターフェースを持ち、

最初にコマンドの入力を受け付ける。

コマンドは4つ、

  • add - さらに数値の入力を求め、その数値を加算する。
  • sub - 〃 、その数値を減算する。
  • view - 現在のアキュームレーターの値を表示する。
  • exit - プログラムを終了する。

まず、以下のようなプログラムを作成した。

main = getContents >>= loop 0 . lines

loop acc (s:ss) = case s of
  "add" -> do
    str <- getLine
    loop (acc+read str) ss
  "sub" -> do
    str <- getLine
    loop (acc-read str) ss
  "view" -> do
    print acc
    loop acc ss
  "exit" -> return ()

最初にaddなどと入力すると、

getContentsの処理がgetLineに割り込まれることを期待している。

その後getContentsは何事も無かったかのように数値が抜かれた

入力を吸い上げる。

getLineで引っ張ってこられる入力であるが、

最初のgetContentsの入力はまずlinesに掛けられ、

それから、その先頭が"add"と比較され、この時点ではssについて

何も評価は行われないからadd\nと入力された、まさに次の文字から

になると予想している。

(このような予測が可能なのはプログラムが簡単なうちだけかもしれないが…)


しかし、プログラムを実行してみるとうまく動かなかった。

$ ghc test.hs
$ ./a.out
view
0
add

Fail: <stdin>: hGetLine: illegal operation (handle is closed)

どうやら、getContentsは他の入力に割り込まれないように

先立ってハンドルクローズしているようなのである。

(GHCの人もこのようなやり方は良くないとお考えなのか)


しかし、ここでは引き下がれない。

getContentsを自分で定義して再実行する。

import System.IO.Unsafe
import Control.Monad

getcon = unsafeInterleaveIO $ liftM2 (:) getChar getcon

main = getcon >>= loop 0 . lines

loop acc (s:ss) = case s of
  "add" -> do
    str <- getLine
    loop (acc+read str) ss
  "sub" -> do
    str <- getLine
    loop (acc-read str) ss
  "view" -> do
    print acc
    loop acc ss
  "exit" -> return ()

これでハンドルクローズされる心配が無くなった。

$ ./a.out
add
123
add
456
view
579
sub
123
view
456
exit

想定した結果を出すことが出来た。


ということで入力を入力にinterleaveすることが出来たのであるが、

こういうのはシロなのだろうか?。


ちなみにこのプログラムは作為的に書いたので

(ちがうインタラクティブシステムの叩き台として)

もっと安全に簡単に

main = interact $ unlines . loop 0 . lines

loop acc (s:ss) = case s of
  "add"  -> loop (acc+read (head ss)) (tail ss)
  "sub"  -> loop (acc-read (head ss)) (tail ss)
  "view" -> show acc:loop acc ss
  "exit" -> []

こうとか、

普通にimperativeに

main = loop 0

loop acc = do
  cmd <- getLine
  case cmd of
    "add" -> do
      str <- getLine
      loop (acc+read str)
    "sub" -> do
      str <- getLine
      loop (acc-read str)
    "view" -> do
      print acc
      loop acc
    "exit" -> return ()

こう書けるとかいう苦情は受け付けませんのであしからず。

トラックバック - http://d.hatena.ne.jp/tanakh/20040729

2004年07月28日(水) 今月の情報処理

ネタが無い…

いや、ネタが無いのではなくて文章を書くのが遅いというべきか。

まだ一つ書きたいHaskellネタがあったんだけど。

[]プログラム・プロムナード(7月号) プログラム・プロムナード(7月号)を含むブックマーク プログラム・プロムナード(7月号)のブックマークコメント

久々に情報図書館に行ってきたので読んできた。

テスト勉強に行ったついでなので、キーワード拾ったぐらいなのだが。


今月の問題は

m本のコードの長さ(実数)が与えられて、

それらのコードから同じ長さをn本切り取るとき、

切り取れるコードの最長値はいくつか?

(0<=m,n<=1000)


時間が無かったので最後のほうしか読んでないけど、

  • 動的計画法
  • 二分探索
  • ドント方式

の解法が書かれていたようである。

  • 動的計画法

わからん…もうちょっと考えます

  • 二分探索

0から長さの最大値までの間のどこかに切り取れる/切り取れないの

境界があるのだから、二分探索で解ける。

計算量は、切り取れるかどうかの判定はてきとうにやってもO(m)だから、

長さの最大値をlとするとO(mlogl)ぐらいか。

問題無さそうである。

  • ドント方式

これは思いついた人すごいなぁ。

選挙でおなじみの方式である。

最終的に当選候補者が同じ得票数で当選したとして

もっとも死票が少なくなる方法なのであるが、

この問題にも使える。

各コードの長さを政党の得票数と考え、

n人の当選者を出したとき、最後の候補者を選んだときの

値が答えになる。

計算量は、n回最大値を見つけるので、2分木を使うとO(nlogm)か。

馬鹿サーチでもO(mn)なので、大丈夫そうである。

[]今気づいたけど… 今気づいたけど…を含むブックマーク 今気づいたけど…のブックマークコメント

これ、PDFになってるのね…

http://www.ipsj.or.jp/07editj/promenade/index.html

こんなの去年は無かったぞ。

トラックバック - http://d.hatena.ne.jp/tanakh/20040728

2004年07月27日(火) 実装のシンプルさと実行速度の微妙な関係

[]遅延評価の落とし穴 遅延評価の落とし穴を含むブックマーク 遅延評価の落とし穴のブックマークコメント

http://www.bagley.org/~doug/shootout/

このページ、言語の比較ページなのであるが、

Haskellスコアが不当に低いように感じた。

全体のスコアは未実装のテストが有ると大幅に低下してしまうようなのだが、

LOC(コードの長さ)でもあまり芳しくないのはどうしたものかと思った。

いや、全体的には順位が高いのだが、

一部のテストが長くなりすぎている。

それで、適当に長くなっているのを見てみると、

http://www.bagley.org/~doug/shootout/bench/wc/

この「Count Lines/Words/Chars」のコードを見て唖然とさせられた。

勝手に貼っていいのかわからないが…

 -- $Id: wc.ghc,v 1.2 2001/05/24 14:05:53 doug Exp $
 -- http://www.bagley.org/~doug/shootout/
 -- from Brian Gregor

module Main where

 -- compile with:  ghc -O -o wc -package lang wc.hs

import IO
import IOExts
import PackedString

main = do
         -- set buffer to 4k
         hSetBuffering stdin (BlockBuffering (Just 4096))
         -- these are mutable variables
         nL <- newIORef 0
         nW <- newIORef 0
	 nC <- newIORef 0
         (nl,nw,nc) <- countAll nL nW nC
	 putStrLn ( (show nl)++" "++(show nw)++" "++(show nc) )

countAll :: IORef Int -> IORef Int -> IORef Int -> IO (Int,Int,Int)
countAll nL nW nC = do 
         end <- hIsEOF stdin
         nl <- readIORef nL
   	 nw <- readIORef nW
         nc <- readIORef nC
         if (not end) 
            then (do  
              inStr <- hGetLine stdin
              -- using a packed string is a small speed win
              let str = packString inStr
              -- using IORefs makes it easy to force strict
              -- evaluation - how to easily do this without
              -- IORefs?
              writeIORef nL $! (nl + 1)
              writeIORef nW $! (nw + (length (wordsPS str)))
              writeIORef nC $! (nc + 1 + (lengthPS str))
              countAll nL nW nC)
            else  return (nl,nw,nc)

これはひどい。

何でこんなにImperativeに書かれているのだろうか。

このテスト、"same thing"タイプテストになっていて、

同じことが出来るソースならどんな実装でも良いはずなので、

適当に簡潔に書き直してみた。

main = interact $ \d ->
  tail $ concat $ map ( (" "++).show.($d) ) [length.lines,length.words,length]

二行である。

下のコードで問題になりそうなのは実行速度とメモリ消費量である。

入力は遅延するとはいえ、最終的に全域を3回なめるので

結局完全なリストが保持されてしまう。

入力ファイルは2MB以上あるので、(おとといぐらいの考察より

id:tanakh:20040725)おそらく50MB以上のメモリを消費する。

そこで、実際に実行してみた。

$ ghc -O2 count.hs
$ time ./a.out < Input500
12500 68500 3048000
real    0m5.068s
user    0m0.010s
sys     0m0.020s

これだけでは如何ともなので、

最初のソースでも計測してみる。

$ ghc -O2 count.hs
$ time ./a.out < Input500
12500 68500 3048000

real    0m9.187s
user    0m0.010s
sys     0m0.020s

なんと、2行のソースのほうが実行時間が短い。

じゃあ、やっぱり最初のソースは駄目駄目かというと

メモリを5MBほどしか使わない。

2行のやつは90MB近く消費するのである。


しかし、いくらなんでもあれではなぁ、

ということで、高速で簡潔なコードを模索することにした。

import System.IO

main = do
  (l,w,c) <- count (0,0,0)
  putStrLn $ show l ++ " " ++ show w ++ " " ++ show c

count cs@(l,w,c) = do
  eof <- hIsEOF stdin
  if eof then return cs
    else do
      d <- getLine
      let nw = length $ words d
          nc = length d
      seq nw $ seq nc $ count $! (l+1,w+nw,c+nc)

その結果得られたのがこのコードである(簡潔じゃないけど)。

(このコード、出来上がるまで5時間ぐらいかかったんだけど…)

要するに2行のやつを行ごとの処理に分けただけなのであるが、

これ、

count cs@(l,w,c) = do
  eof <- hIsEOF stdin
  if eof then return cs
    else do
      d <- getLine
      count (l+1,w+(length $ words d),c+(length d))

のような直接的なコードだと駄目である。

遅延してしまうので結局同じぐらいのメモリを食ってしまう。

なので、ところどころに正格性評価を行うための処理を織り込んでいる。


気になる速度とメモリ消費量であるが、

$ ghc -O2 count.hs
$ time ./a.out < Input500
12500 68500 3035500

real    0m2.257s
user    0m0.010s
sys     0m0.020s

こんな感じ。

メモリ消費量は4MBほどである。

これだとコードの長さも12行だし、

うちのマシンの性能とから考えるとスピードでもpython〜bigloo〜se

あたりには食い込めそうである。

pythonレベルといっても、主に入出力+文字列処理なので、

g++の3分の一ほどの速度である。

(gcc/ocamlは相変わらず信じられないほど速いけど)


一つ大きな問題は、

こんな直感的ではない処理をはさまなければならないということか。

Haskellでは大きなデータを扱うのは鬼門のようである…

[]追記 追記を含むブックマーク 追記のブックマークコメント

行ごとに処理するだけならこんなのでも良かった。

import Data.List

main = interact $ \d -> let (l,w,c) = calc d in show l ++ " " ++ show w ++ " " ++ show c
  where calc = foldl' sadd (0,0,0) . map wccc . lines
        wccc str = (length $ words str,length str)
        sadd (l,w,c) (wc,cc) = seq wc $ seq cc $ (l+1,w+wc,c+cc)

実行時間が3秒ぐらいになったけど、

行数は縮んだ。

トラックバック - http://d.hatena.ne.jp/tanakh/20040727

2004年07月26日(月) 落胆

最近内容が薄いなぁ。

でも、一応毎日書いとくか。

[][]SDL AUDIO にしてやられる SDL AUDIO にしてやられるを含むブックマーク SDL AUDIO にしてやられるのブックマークコメント

HSDL(http://fxp.infoseek.ne.jp/haskell/HSDL/)だが、音楽関係、

昨日書いたメモリの問題で大き目のWAVを鳴らすことが不可能だったり

まともにミックスするのが大変だったり、

フォーマット変換が出来なかったりいろいろ作りかけだったので

その辺の実装をまともにしたりした。

とりあえず、使いたいところで実装できてないところは

無いような感じだなぁ。


しかし、音楽周りでなんか落ちる。

再生中にでかいWAV読み込んだりすると不確定に落ちる。

それもSDLのSegmentation Faultで。

どうもMixスレッドがプリエンプションされて、その途中に

読み込みなどをすると落ちるようなのだが…

SDL自体の問題じゃなかったらHaskellスレッド周りが

おかしいんだろうか。

とりあえず、読み込み中にミックスしないことを保障しないといかん。

これはlockAudio/unlockAudioではだめである。

そもそも読み込みはじめるときがMix中かもしれないので。

Mixスレッド自体がプリエンプションされないようには出来ないので、

現実的にはセマフォで制御すべきである。


で、セマフォを使ってみたが、直らない。

原因自体が全然違うのか?

まぁ、もう、WAV読み込み前に音楽止めるとかでいいかなぁ

という気がしてきたから、もういいかなぁ。

[]IPA:未踏ユース IPA:未踏ユースを含むブックマーク IPA:未踏ユースのブックマークコメント

公募結果が出ていた。

http://www.ipa.go.jp/jinzai/esp/2004youth/koubokekka.html

かく言う私も実は応募していたりしたのだが、

見事にはずれたっぽい。

Declarative game library とかいうテーマで出したのだが、

PMの方はその意義がオワカリになられなかったのか、

あるいは私の日本語サッパリだったのか。

(もしかして、テーマ自体が客観的に見てしょーもないのか???)

他にP2P型並列計算インフラストラクチャーとか、

P2P型超大規模向けリアルタイムネットワークゲームフレームワークとか

継続ベースのウェブアプリケーションフレームワークとか

考えていたんだけど、近頃はWeb一辺倒だし、

そっちにしたほうが良かったか知らん。

(でも、そういうのだとなんか被りそうなんだよなぁ…

というか、去年の未踏に似たようなのがあったからやめたんだけど)


そういうことで、採択されなかったので今回は吠えてみるのだ。

採択されなかった私にはその権利がある!(…?)

幸い、このページ見てる人ほとんどおらんし…

最近ありがちだけど、需要はあるかもね。

グリッドコンピューティングを利用したゲームというのだろうか?

題だけではなんともかんとも。

独創的なテーマだと思った。私にはこういうのは思いつけない。

これも題からはなんともかんとも。

最終的な出来次第だろうなぁ。

透過的な、という意味がわからんけど、

データがちゃんと届くとかの意味ならもうすでに出来ていると思った。

私も昔やろうとしたことがある…

結局やってないけど、アニメーションに特化するのであれば

最悪でもWMVとかDivX以上のものを出す必要があるわな。

  • ブレインストーミング支援ツール 「BSE -Brain Storming Engine-」

去年石田PMの発表会で似たようなものを見た。

まぁ、具体的なものは全然違うと思うけど。

デバイスですか??

そりゃすごいです。

グリゲーとテーマ一緒?

こっちのが題名の抽象度が高いけど。

見張ってコピーするだけ…ではないよなぁ。

これも最終的なできばえで判断だろう。

えっ?

こんなんWeb系のとこでアルバイトしたら

何ぼでもやらされますがな。

そういうのとは違うってことなのか?

題名だけだと何も未踏なことは無いですな…

どこか差別化が図られているのだろうか。

本家のインタプリタが何であんなに遅いのか?

それが問題だ。

これも独創的だと思った。こういうのを思いつける人はうらやましい。

こういうのはどうなんだろ…

ほっといても病院がどっかの会社に発注しそうなもんだが。

アイデアがいいなぁ。

技術的には難しく無さそうだけど。

  • 人間の第六感を模倣した夢見る計算機の開発

なんかすごい題名だ…

ぜひ完成させてください。おねがいします。

こういうのって既にあるよね…?

これもどこで差別化を図るのかがわからんからなんともかんとも。

  • 携帯アプリのビジュアル開発環境

ビジュアル開発環境をあんまり使わんから意義がわからない。

Eclipseiアプリとかの実行環境をインテグレーションするのとは

訳が違うのだろうか。

  • Ruby.NET コンパイラの開発

PMRuby好きと。

正直な話、.NET用コンパイラは難しくないと思うんだが…

ただ、.NETのクラスRubyクラスを制約なしに一対一対応付けするのは

難しいかもしれない。

  • 情報教育に特化した視覚表現豊かな統合開発環境「双葉」の構築

題名が具体的でよい感じである。

しかし、情報教育とかのキーワードには個人的にあまりピンと来ない…

ありゃ、もっとぼろくそに書こうと思ったのだが、

結構肯定的意見が多くなってしまった。

とりあえず、題名に未踏な要素が入っていないものが多いので、

判断しかねる。

トラックバック - http://d.hatena.ne.jp/tanakh/20040726

2004年07月25日(日) Brainfuck

[]Brainfuck Brainfuckを含むブックマーク Brainfuckのブックマークコメント

今更ながらにBrainfuckを実装してみた。

いつもどおりHaskellで…

http://www.muppetlabs.com/~breadbox/bf/

言語仕様的にどっちかと言うとコンパイラのほうが簡単である。

main = interact $ (header++).(++footer).(>>= cvt).(filter (`elem` "><+-.,[]")) where
  cvt '>' = "++p;"
  cvt '<' = "--p;"
  cvt '+' = "++*p;"
  cvt '-' = "--*p;"
  cvt '.' = "putchar(*p);"
  cvt ',' = "*p=getchar();"
  cvt '[' = "while(*p){"
  cvt ']' = "}"
  cvt _   = ""

  header = "#include <stdio.h>\n"++
	   "int main(){ static char dat[30000],*p=dat; "
  footer = "}\n"

Cへのコンパイラ。

文字列の置換しかやっていない。

まぁ、こんなコードには何の面白みも無いのだが。

import Text.ParserCombinators.Parsec
import Data.Array.MArray
import Data.Array.IO
import Data.Word
import Data.Char
import Control.Monad
import System

type State = (IOUArray Int Word8,Int)

bfp :: Parser (State -> IO State)
bfp = many p >>= \pp -> return (\st -> foldM (flip ($)) st pp) where
  p   = (char '>' >> return (\(a,i) -> return (a,i+1)))
    <|> (char '<' >> return (\(a,i) -> return (a,i-1)))
    <|> (char '+' >> return (\(a,i) -> modifyArray i (+1) a >> return (a,i)))
    <|> (char '-' >> return (\(a,i) -> modifyArray i (flip (-)1) a >> return (a,i)))
    <|> (char '.' >> return (\(a,i) -> readArray a i >>= putChar.chr.fromEnum >> return (a,i)))
    <|> (char ',' >> return (\(a,i) -> getChar >>= writeArray a i.toEnum.ord >> return (a,i)))
    <|> (between (char '[') (char ']') bfp >>= return.while)
  while b (a,i) = do
    n <- readArray a i
    if (n/=0) then b (a,i) >>= while b else return (a,i)

modifyArray i f a = readArray a i >>= writeArray a i . f

main = do
  [f] <- getArgs
  c   <- readFile f
  case parse bfp "" (filter (`elem` "><+-.,[]") c) of
    Left err -> putStrLn "error at " >> print err
    Right f  -> newArray (0,29999) (0::Word8) >>= \a -> f (a,0) >> return ()

これがインタプリタ。

思ったより小さくない。

パーズにParsecを使ったから多少冗長になっている気もする。

パーザーが返すものが計算だというのがミソといえばミソか。

動作速度は、Unboxed Mutable Arrayを使って、

計算の構築も一回だけなはずなのにあまり速くない。

どうしたものか。

[]メモリ食い メモリ食いを含むブックマーク メモリ食いのブックマークコメント

リストHaskellのデータの中でもっとも基本的なものだが、

とてもたくさんメモリを食うようである。

20MBのファイルをstrictに読み込んだら256MBのヒープ制限を越えてしまった。

それで、2MBのファイルを読み込んだらメモリ使用量が50MBと出た。


…1バイトあたり20バイトほどですか。

他の部分で10MBぐらい食ってるはずなのでそんなもんだと思う。


Boxedなデータの単方向リストはどれぐらいメモリを使うのだろうか。

まず、リストのセルにdataへのポインタとnextへのポインタが絶対必要。

ポイントされてるデータがいくらほどメモリを食ってるのかはわからないが、

data本体が4バイト(Char型でも…)使うと仮定すると

残りは20-12=8バイトほどなわけで、

遅延する式を保持しておくにはこれぐらい要るんでないかな〜

とも思う。


今日の結論。

Haskellリストは1要素あたり本体データ+16バイト(ぐらい)。

大きなデータをstrictに扱いたいときはIOUArrayあたりを使わざるを得ないか?

使いたくないけど。

トラックバック - http://d.hatena.ne.jp/tanakh/20040725

2004年07月24日(土) ghc 6.4...

[]続・OpenGL 続・OpenGLを含むブックマーク 続・OpenGLのブックマークコメント

現在の安定リリース版GHC(6.2.1)にはOpenGLライブラリから

テクスチャサポートがはずされているらしい。

http://www.haskell.org/pipermail/hopengl/2004-May/000489.html

これは参った。

テクスチャが張れないと2DゲームOpenGL使えへんやん?

メインブランチにはOpenGL1.5のフルサポートが含まれてるらしいけど、

それ、ソース持ってきてコンパイルせんなんやん。

というかそれ以前に、なんでライブラリが完全にコンパイラの一部と

化しているのだろうか。単独で配ってくれてもいいやん。


CVSスナップショットが毎晩取られているようなので

http://www.haskell.org/ghc/dist/current/dist/

この辺からソースはゲットできるのだが、

うちの環境が特殊なもんで(Windows版GHC+Cygwin…って

Windows環境なら特殊でもなんでもないかもしれない)

コンパイルできない。Posixライブラリがあらへんとか言われる。

OpenGLの部分だけコンパイルしようとしても出来ないし、

どうすればいいんだ…


リリースプランによると次に6.2.2が出てそれで6.2系は終わりで

それから6.4がリリースされるようなのだが、

6.0が2003年5月、6.0.1が2003年7月、6.2が2003年12月、6.2.1が2004年5月ということで、この調子で行くと6.4は今年の12月ごろ…?はあ…


まぁ、しかし、次期ライブラリはすごいことになってるなあ。

http://www.haskell.org/HOpenGL/newAPI/

こんな感じになるのか?

http://www.haskell.org/~simonmar/lib-hierarchy.html

Haskellライブラリがどんどん巨大に。


それはともかく、テクスチャを何とかしないとゲームには使えないから、

  • 頑張ってGHCをコンパイルする
  • とりあえずテクスチャ周りの関数FFIする
  • あきらめて待つ…

うーむ…誰か新しいGHCのWindows向けバイナリをくれたりしないだろうかなぁ…

トラックバック - http://d.hatena.ne.jp/tanakh/20040724

2004年07月23日(金) はじめてのOpenGL

[]HaskellOpenGL HaskellでOpenGLを含むブックマーク HaskellでOpenGLのブックマークコメント

昨日までOpenGLのおの字も知らなかったのだが、

気が向いたのでやってみることにした。

なんというか、思いのほか簡単である。

もっと初期化とかめんどくさいと思っていた。

とりあえず、初期化のコード

main = do
  True <- sdlInit [VIDEO]

  glSetAttribute GL_RED_SIZE   5
  glSetAttribute GL_GREEN_SIZE 5
  glSetAttribute GL_BLUE_SIZE  5
  glSetAttribute GL_DEPTH_SIZE 16
  glSetAttribute GL_DOUBLEBUFFER 1

  setCaption "OpenGL" ""
  sur <- setVideoMode 640 480 16 [OPENGL]

  loop
  sdlQuit

loop = do
  quit <- checkEvent
  when (not quit) $ do
    threadDelay 16666
    loop

あとは普通にOpenGLを呼び出すだけなので、

http://www.wakayama-u.ac.jp/~tokoi/opengl/libglut.html

この辺を読んで勉強してみた。

で、最後まで読んで出来上がったのがこれ。

import Graphics.UI.SDL as SDL hiding (color)
import Graphics.Rendering.OpenGL as GL
import Graphics.Rendering.OpenGL.GLU
import Control.Concurrent
import Control.Monad
import Data.IORef

----------------------------

initialize = do
  clearColor $= Color4 0.0 0.0 0.0 1.0
  depthFunc  $= Just Less
  lighting  $= Enabled
  light (Light 0) $= Enabled
  light (Light 1) $= Enabled

initVar = 0.0

setupMat = do
  viewport $= (Position 0 0,GL.Size 640 480)
  matrixMode $= Projection
  loadIdentity
  perspective 30.0 (640.0/480.0) 1.0 100.0

  matrixMode $= Modelview 0
  loadIdentity
  translate $ Vector3 0.0 0.0 (-5.0 :: GLdouble)
  lookAt (Vertex3 3.0 4.0 5.0) (Vertex3 0.0 0.0 0.0) (Vector3 0.0 1.0 0.0)

setupLight = do
  position (Light 0) $= Vertex4 0.0 3.0 5.0 1.0
  position (Light 1) $= Vertex4 5.0 3.0 0.0 1.0
  diffuse  (Light 1) $= Color4  0.0 1.0 0.0 1.0
  specular (Light 1) $= Color4  0.0 1.0 0.0 1.0

cube = do
  renderPrimitive Quads $
    mapM_ (\(n,v) -> do
        normal $ uncurry3 Normal3 n
        mapM_ (\n -> vertex $ Vertex3 (vert!!n!!0) (vert!!n!!1) (vert!!n!!2)) v
      ) $ zip norm face
  where
    vert :: GLdouble?
    vert =
      0.0,0.0,0.0]
      ,[1.0,0.0,0.0]
      ,[1.0,1.0,0.0]
      ,[0.0,1.0,0.0]
      ,[0.0,0.0,1.0]
      ,[1.0,0.0,1.0]
      ,[1.0,1.0,1.0]
      ,[0.0,1.0,1.0

    edge =
      [(0,1),(1,2),(2,3),(3,0)
      ,(4,5),(5,6),(6,7),(7,4)
      ,(0,4),(1,5),(2,6),(3,7)]

    face =
      0,1,2,3] ,[1,5,6,2] ,[5,4,7,6]
      ,[4,0,3,7] ,[4,5,1,0] ,[3,2,6,7

    col :: [(GLdouble,GLdouble,GLdouble)]
    col =
      [(1.0,0.0,0.0)
      ,(0.0,1.0,0.0)
      ,(0.0,0.0,1.0)
      ,(1.0,1.0,0.0)
      ,(1.0,0.0,1.0)
      ,(0.0,1.0,1.0)]

    norm :: [(GLdouble,GLdouble,GLdouble)]
    norm =
      [( 0.0, 0.0,-1.0)
      ,( 1.0, 0.0, 0.0)
      ,( 0.0, 0.0, 1.0)
      ,(-1.0, 0.0, 0.0)
      ,( 0.0,-1.0, 0.0)
      ,( 0.0, 1.0, 0.0)]

    fromInt = fromInteger . toInteger
    uncurry3 f (a,b,c) = f a b c

render var = do
  r <- readIORef var
  modifyIORef var (+1)
  clear [ColorBuffer,DepthBuffer]

  setupMat
  setupLight

  preservingMatrix $ do
    rotate r $ Vector3 0.0 1.0 (0.0 :: GLdouble)
    materialDiffuse   FrontAndBack $= Color4 0.8 0.2 0.2 1.0
    cube
  preservingMatrix $ do
    translate $ Vector3 2.0 0.0 (0.0 :: GLdouble)
    rotate (r*2) $ Vector3 0.0 1.0 (0.0 :: GLdouble)
    materialDiffuse   FrontAndBack $= Color4 0.0 0.8 0.2 1.0
    cube

  glSwapBuffers

----------------------------

main = do
  True <- sdlInit [VIDEO]

  glSetAttribute GL_RED_SIZE   5
  glSetAttribute GL_GREEN_SIZE 5
  glSetAttribute GL_BLUE_SIZE  5
  glSetAttribute GL_DEPTH_SIZE 16
  glSetAttribute GL_DOUBLEBUFFER 1

  setCaption "OpenGL" ""
  sur <- setVideoMode 640 480 16 [OPENGL]

  var <- newIORef initVar
  initialize
  loop $ render var

  sdlQuit

loop f = do
  quit <- checkEvent
  when (not quit) $ do
    f
    threadDelay 16666
    loop f

checkEvent = do
  ev <- pollEvent
  case ev of
    Just QuitEvent -> return True
    Nothing        -> return False
    _              -> checkEvent

テクスチャ周りが何も書いてなかった…

トラックバック - http://d.hatena.ne.jp/tanakh/20040723

2004年07月22日(木) getContentsの謎 〜遅延IOは死のかほり〜

はてなダイアリーHaskellのページ制覇達成。

今回は少し趣を変えて。

[]遅延IO 遅延IOを含むブックマーク 遅延IOのブックマークコメント

Haskell勉強したてのころ、interact*1という関数にひどくおどろかされたものである。

たとえば、

main = interact $ map toUpper

などと書けば入力を大文字に変換して出力するプログラムとなる。

こう書くといたって普通なのであるが、なんとこれ、遅延するのである。

つまり、入力が確定した時点で出力が少しづつ出てくるのである。

WinHugsならまさに一文字づつ大文字に変換されながら出てくるし、

GHCiでも一ラインづつ出てくる。


このときは遅延評価すげー、とかそのぐらいにしか考えていなかった。

しかしちょっと待てよ、これは遅延評価処理系ならば当然のことなのだろうか?


ここでIOモナドを考えてみる。

IOモナドにおいてその要素は(副作用を伴うかもしれない)計算、

bind演算は逐次実行を意味する。

つまり、m1 >> m2 と書けば、m1が実行され、その次にm2

実行されるという意味になる。

さらに、モナドは代数の半群が元になっており、この演算には結合法則

成り立っていなければならない。

つまり、(m1 >> m2) >> m3 は m1 >> (m2 >> m3) と等価である。

このことから考えると、m1 >> m2 と書くと、m1m2の順に

計算が実行されるだけではなく、いかなる計算もm1m2間には

割り込めないということになる。


で、interactを再度考える。

interactは入力を引っこ抜いてそれを渡された関数を通して出力

する関数になるので、ふつうに考えると

interact f = getContents >>= putStr . f

のように実装できる。

確かにこのように実装しても最初のコードはちゃんと遅延してくれるので

これは問題無さそうである。

次にgetContentsを考えてみる。

これは

getContents = do
  c  <- getChar
  cs <- getContents
  return (c:cs)

あるいはリフト関数を用いて

getContents = liftM2 (:) getChar getContents

のように実装できるはずである。

(EOFの検知は実装してないけど)

で、このように実装したところ、最初のコードは遅延しなくなってしまった。

それもそのはずである。getCharの直後にgetContentsが実行されるので

その途中に割り込んでputStrが実行されるはずは無いのである。


じゃあ、遅延する関数が書けるのかというと、無理そうである。

IO Stringの型を持つ関数で、その返す値が遅延ストリームに

なるなんて、モナド則を破ってしまっているではないか。


ここにきて全くわからなくなってしまった。

Hugsのライブラリソースを見てみると、

なんとgetContentsはprimitive扱いになっていた。

これはなんか悪いことしてるんと違うかなと思い

色々探していると

http://www.haskell.org/pipermail/haskell/2003-October/012895.html

このようなページを発見した。

どうやら同じことで悩んでいる人がいたようである。

で、それに対する答えは非常に明快であった。


unsafeInterleaveIO


これを使うというのである。

unsafeInterleaveIO は IO a -> IO a の型を持つ関数で、

これを通すと必要になるまで計算されない計算が作れる。

これを用いてgetContentsは

getContents = unsafeInterleaveIO $ liftM2 (:) getChar getContents

と定義することが出来る。

モナド則を破ってしまっているgetContentsは

やはり普通には実装できなかったのである。


でも、unsafeって…?

なんか気持ち悪い…?

しかし、これはそれもそのはずである。

一般に副作用を伴う計算が遅延してしまうと良くないのである。

詳しくはSICP*2あたりを読んでもらうとして、

たとえば、変数に書き込むなどといった処理を

好き勝手タイミングで実行されると収集がつかなくなってしまう

というのは直感的に理解してもらえると思う。

しかし、getContentsなどといった一部の関数に対しては

その限りではない。表示に対して入力は人間が用意するものであるが、

むしろ実行タイミングによって人間が表示に反応して

入力を行うのを期待するわけである。(以前に書いた数当てゲームを参照)

(あと、入力が遅延することによって、入力が大きいなどの場合には

メモリ消費量などの点で有利となる)


というわけで、unsafeInterleaveIOなどというちょっと危ない関数

有るとわかったのであるが、このunsafeInterleaveIO、

unsafeInterleaveIO = return . unsafePerformIO

このように定義できるのである。

unsafePerformIO はIO a -> aという型を持つ関数で、

なんと外せない筈のIOモナドがはずせてしまう。まさにunsafe。

要するに、いつの間にやら計算が実行されているのである。

Haskellの多くの初学者が犯す誤り(?)、

main = putChar getChar

これも

main = putChar $ unsafePerformIO getChar

unsafePerformIOでこの通りである。

もう、ほとんど反則であるが、かろうじて参照透明性だけは保っている

ような感じなのか。


ちなみに、unsafePerformIO をつかうと

gver = unsafePerformIO $ newIORef 0

main = do
  fact n
  ans <- readIORef gver
  print ans

fact n = writeIORef gver $ product [1..n]

グローバル変数みたいなものが出来てしまう。

もはやocamlのmutable並である。

乱用すべきではないなと思った…

[]Haskell/SDL版テトリス Haskell/SDL版テトリスを含むブックマーク Haskell/SDL版テトリスのブックマークコメント

wsTetlisをSDL向けに移植した。

http://fxp.hp.infoseek.co.jp/haskell/HSDL/

サンプルに追加。

移植自体は非常に潤滑に進行したので

今回もデバッグ作業をしなくて済んだ。

[]国内予選の問題の解答 国内予選の問題の解答を含むブックマーク 国内予選の問題の解答のブックマークコメント

http://ccserv.adm.ehime-u.ac.jp/ICPC/jp/

なんと出力例が公開されているではないか。

問題Eと問題Fについては正解していなかったので、

公開している解答が合ってるかわからんかったんだよなぁ。


ということで、チェックしてみたところ、

サイトにアップしたプログラムはEとFどっちとも4つの入力

すべてに対して正しい答えが出せていた。

これで安心して公開しておくことが出来るのである。


ところで、問題Eは解答が実数値で、誤差が0.001を超えなければOK

な問題なので、チェックにdiffが使えなかった。

Haskell適当にチェックプログラムを作ったのだが、

PerlでもRubyでもなく、Haskell

もはや私の中でデフォルト言語となりつつある…

import System

main = do
  args@[f1,f2] <- getArgs
  cs           <- mapM readFile args
  let d = map (map read . words) cs
  let diffs = [t | t@(_,[r,s]) <- zip [1..] d, abs (r-s) > 0.001]
  if null diffs then putStrLn "Congratulations!!! correct answer."
    else mapM_ (\(l,[r,s]) -> do
      putStrLn $ "Differnt at line " ++ show l ++ ":"
      putStrLn $ adjast 20 f1 ++ show r
      putStrLn $ adjast 20 f2 ++ show s
      putStrLn "") diffs
  where
    adjast n s = take n $ s ++ replicate n ' '

*1: (String -> String) -> IO () という型を持つ関数

*2:Structure and Interpretation of Computer Programs : 計算機プログラムの構造と解釈

トラックバック - http://d.hatena.ne.jp/tanakh/20040722

2004年07月21日(水) 初版リリース 〜イバラの道入り口〜

[][]FFI (その6) FFI (その6)を含むブックマーク FFI (その6)のブックマークコメント

ついにこの連載(?)も6回目になった。

6回目ということは6日目ということで、

もうかれこれ一週間もFFI漬けだということなのだが。


昨日の終わりからどばーっとコード書いて、

どばーっとMakefileの勉強して、どばーっとHaddockで

ドキュメント作ってwxHaskellからGHCのパッケージ周りの

処理をぱくって参考にさせてもらって、

ようやくHaskell/SDLが形になった。

なんというか、ちょっとうれしい。

こういう形でソフトを公開するのはもうかれこれ2年ぶり

ぐらいなような気がする。


というわけで、

http://fxp.hp.infoseek.co.jp/haskell/HSDL/

こんな感じに。

なんかサンプル作ろうと思ったけど、余力が無かった。

何か適当につくっちゃるぜ!という方がおられたら大歓迎なのでぜひに。

泣いて喜びます。

あと、Makefileとかほとんどいじったこと無いので、

とてもしょぼい出来になっているとは思うけど、

恥ずかしいので黙殺して欲しい…


そんなこんなで、ライブラリ作成も一段落したので、

この前のwxTetlisを移植でもしてみるかな。

[]malloc new malloc newを含むブックマーク malloc newのブックマークコメント

Foreign.Marshal.Alloc.mallocとか、GCしてくれないのね…

メモリだだ漏れ。

トラックバック - http://d.hatena.ne.jp/tanakh/20040721

2004年07月20日(火) もうすこし、あとすこし。

[][]FFI (その5) FFI (その5)を含むブックマーク FFI (その5)のブックマークコメント

Audio周りを実装。

今回も考えるところが多くて大変。

とりあえずミキサーをどうするかということなのだが、

やっぱりこれもHaskell側で書くことにした。

コールバックはもともとの仕様と同じ

Ptr() -> Ptr Word8 -> Int -> IO ()

関数で受け取り、Haskellがわのインターフェースとして

Int -> IO [Word8] な関数で処理をさせるようにした。

音波データが[Word8]になっているが、これは良くないかもしれない。

[Word8] [Int8] [Word16] [Int16] の中から選べて然るべきである。

まぁ、とりあえず、今のところは[Word8]で何とかすることにする。

ミックスしなければ大丈夫…ミックスできないと大丈夫じゃないんだけど。


使用例。

main :: IO ()
main = do
  True <- sdlInit[VIDEO,AUDIO]
  sur  <- sdlSetVideoMode 640 480 32 [SWSURFACE,ANYFORMAT]
  True <- sdlOpenAudio 22050 AUDIO_U8 1 1024 mixAudio
  sdlPauseAudio 0

  loop

  sdlCloseAudio
  sdlQuit

mixAudio :: Int -> IO [Word8]
mixAudio num = do
  putStrLn $ "require "++show num++"bytes."
  return $ take num dat
  where
    dat  = cycle $ [0,2..255]++[255,253..0]

loop = do
  ev <- sdlWaitEvent
  case ev of
    Just QuitEvent ->
      return ()
    _ -> loop

とりあえず、三角波を出力してみる。

三角波が簡単に書けたのでちょっとうれしかった。

気になる実行速度であるが、この程度だとほとんどCPUパワーを使わなかった。

しかし、どれぐらいミックスできるかは不明だが…


とりあえずの成果物。

http://fxp.infoseek.ne.jp/haskell/sdltest3.zip

トラックバック - http://d.hatena.ne.jp/tanakh/20040720

2004年07月19日(月) 寝ても覚めても

テスト前でも関係なし、関係なし…

[][]FFI (その4) FFI (その4)を含むブックマーク FFI (その4)のブックマークコメント

こっちも作り始めて3日目、そろそろ形になりつつある。

今日はEvent周りを作ったのであと大きな課題はAudioぐらいか。

Audioもパフォーマンスを考えなかったらミックスルーチンを

適当Haskellで書くだけなのだが…


それにしてもEvent周りは大変だった。

何が大変って、構造体のマーシャリングが。

ひたすらコードを書いて書いて書きまくり。

こういうの久しぶりだなぁ。

それとは別に技術的課題も一つあった。

CからHaskellのコールバックである。

HaskellからCに関数ポインタを渡してCがその関数

呼び出すということなのだが、今までの技術では

関数ポインタが扱えなかったのだ。

練習のためにCのqsortをHaskellから

呼び出してみることにした。


まず、Haskell関数をCから呼び出せる関数ポインタに

変換する必要がある。

type Compare = Ptr Int -> Ptr Int -> IO Int
foreign import ccall "wrapper" mkFun :: Compare -> IO (FunPtr Compare)

foreign import ccall "wrapper" を用いる。

こうすると、特定の型の関数をその型の関数ポインタに変換する

処理が作れるようである。

最初、必死になって a -> IO (FunPtr a) な型の関数がないか

探していたのだが、処理の内容を考えるとそのような

ものは作れなさそうである。

上のような記述をするとクロージャ→関数ポインタ変換をおこなう

スタブコードが生成される。

比較関数だが、qsortのコールバックの型が

int (*compare)(const void *p,const void *q)

なので、Haskell側は Ptr Int -> Ptr Int -> IO ()

にしておいた。


で、あとは適当に周りのコードを書く。

cmp p q = do
  a <- peek p
  b <- peek q
  return $ a-b

extSort :: Compare -> [Int] -> IO [Int]
extSort f dat = do
  fp <- mkFun f

  ap <- newArray dat
  foo ap (length dat) fp
  peekArray (length dat) ap

main = do
  dest <- extSort cmp [3,7,2,9,1,8]
  print dest

C側。

typedef int (*sp)(const void *p1,const void *p2);

void foo(HsPtr dat,HsInt elem,HsFunPtr fp)
{
  qsort(dat,elem,4,(sp)fp);
}

こんな感じでちゃんと動く。

HaskellFFIって結構しっかりしてるなぁ。


ということで、SDLのEvent周りを実装した。

これで漸くちゃんとWindowを閉じられるようになった。

で、やはりチュートリアルを移植。

{
    SDL_Event event;

    SDL_WaitEvent(&event);

    switch (event.type) {
        case SDL_KEYDOWN:
            printf("The %s key was pressed!\n",
                   SDL_GetKeyName(event.key.keysym.sym));
            break;
        case SDL_QUIT:
            exit(0);
    }
}

これを移植することにする。

main :: IO()
main = do
  ret <- sdlInit [VIDEO]
  when (not ret) $ fail "init failed."
  sur <- sdlSetVideoMode 640 480 32 [SWSURFACE,ANYFORMAT]
  loop
  sdlQuit

  where
    loop = do
      Just ev <- sdlWaitEvent
      case ev of
        KeyboardEvent { kbPress=True, kbKeysym = Keysym { ksSym = sym }} -> do
          kname <- sdlGetKeyName sym
          putStrLn $ "The "++kname++" key was pressed!"
          loop
        QuitEvent ->
          return ()
        _ -> loop

毎度のことながらほとんどCのコードとかわらんなぁ。

一応この時点で音なしならゲーム作れるかな。

http://fxp.infoseek.ne.jp/haskell/sdltest2.zip

トラックバック - http://d.hatena.ne.jp/tanakh/20040719

2004年07月18日(日) Haskell/SDL計画発動?

[][]FFI (その3) FFI (その3)を含むブックマーク FFI (その3)のブックマークコメント

前回までで大体FFIの方法がわかったので、

とりあえずVideoのラッパを作成した。

本当にうすうすなラッパなんだけど…

しかし、ポインタのやり取りが多いのでどうすればいいのか結構悩んだ。

結局Surface以外はStorableなデータとしてあらわすことにした。

Foreign.Marshalな関数とかでごりごりメモリの読み書き。

ああ、なんなんだこれは。

(逆に、Haskell学習当初の印象とは違ってHaskellだけでも

なんでもできるんだなぁとしみじみ…)


で、とりあえず何か適当に作ってみた。

やはりまだEventが使えないのでたいしたことは出来ない。

module Main(main) where

import Control.Concurrent
import Control.Monad
import SdlInit
import SdlVideo

main :: IO ()
main = do
  ret <- sdlInit [VIDEO]
  when (not ret) $ fail "init failed."

  sur <- sdlSetVideoMode 640 480 32 [SWSURFACE,ANYFORMAT]
  img <- sdlLoadBMP "sample.bmp"

  let (width,height) = (surfaceWidth img, surfaceHeight img)
  let speed  = 5
      right  = 640-width
      bottom = 480-height
      move1  = zip [0,0+speed .. right] [0,0..]
      move2  = zip [right,right ..] [0,speed .. bottom]
      move3  = zip [right,right-speed .. 0] [bottom,bottom .. ]
      move4  = zip [0,0..] [bottom,bottom-speed .. 0]
      moveAll = move1 ++ move2 ++ move3 ++ move4

  mapM_ (\(x,y) -> do
    sdlFillRect sur Nothing 0x000000
    sdlBlitSurface img Nothing sur $ Just $ Rect x y width height
    sdlFlip sur
    threadDelay 16666
    ) moveAll

  sdlFreeSurface img
  sdlQuit

sample.bmpが画面をぐるりと回って終了。

まぁ、外界に対してはそれっぽいインターフェースが提供できた

ような感じではある。

とりあえず、全体のソースWindowsバイナリをアップしておく。

wxHaskellから考えるとバイナリのサイズの小ささに感動。

http://fxp.infoseek.ne.jp/haskell/sdltest1.zip

[]uva online contest uva online contestを含むブックマーク uva online contestのブックマークコメント

今日の02:00から06:00まで http://acm.uva.es/

オンラインコンテストがあったので、とりあえず参加した。

というか、参加しようと思っていたのだが、すっかり忘れていて

気づいたのは5時。しかしまぁ、一時間だけ頑張った。

簡単そうな問題を適当に。


問題Aを適当に読んで、10分ぐらいで解いて、

問題Dをこれまた適当に10分ほどで解いて

問題Eをさらに適当に10分ほどで解いて、

解いてる以外の時間を入れてこの時点で5:50。

もう無理っぽいのでこの辺でギブアップ。

ジャッジシステムがとんでもなく込んでて、終了時点でも

まだ問題Aの実行も開始されず。

結局全部の結果がわかったのは6:40ごろ。


結果。

  • 問題A Wrong Answer
  • 問題D Accepted
  • 問題E SIGSEGV

ぎゃふん。

問題Eはデータ数限界5000を500と間違えて

コード書いてしまったせいだと思うんだがなぁ…

トラックバック - http://d.hatena.ne.jp/tanakh/20040718

2004年07月17日(土) Darkside of Haskell

[][]FFI (その2) FFI (その2)を含むブックマーク FFI (その2)のブックマークコメント

前回の続き。

今日はコードがひときわ多い。


CからHaskellは呼び出せたので、

今度はHaskellからCコードを呼び出してみようと思う。


…しっかし、マニュアルが全然読めない。英語なので…

どうでもいいがForeignモジュールHaskellの暗黒方面っぽい。

メモリ確保とかメモリの読み書きとか、見ていて眩暈が…

 -- foo.c
#include "HsFFI.h"
#include <stdio.h>

HsInt foo(HsInt n)
{
  int i,sum=0;
  for (i=1;i<=n;i++){
    printf("%d\n",i);
    sum+=i;
  }
  return sum;
}
 -- main.hs
foreign import ccall "foo" foo :: Int -> IO Int

main :: IO ()
main = do
  n <- foo 10
  putStrLn ("sigma 10 = "++show n)

コンパイル方法

ghc foo.c main.hs -fglasgow-exts -o foo

なんかすごい簡単だったのですが。

CからHaskell呼ぶより簡単。

IntとDoubleならHsIntとかHsFloatとかで関数を宣言すればいいらしい。

で、問題になるのがカスタムなデータタイプ

IntとDoubleで表現できるもの以外は全部ポインタで受け渡しをする模様。

とりあえず配列を受け渡ししてみることにする。

 -- array_test.c
#include "HsFFI.h"
#include <stdio.h>
#include <malloc.h>

HsPtr alloc_array(int size)
{
  int *ret=malloc(size*sizeof(int)),i;
  for (i=0;i<size;i++)
    ret[i]=i;
  return ret;
}

void free_array(HsPtr arr)
{
  free(arr);
}

void show_array(int size,HsPtr arr)
{
  int *ref=(int*)arr,i;
  for (i=0;i<size;i++)
    printf("%d: %d\n",i,ref[i]);
}
 -- arrayTest.hs
import Control.Monad
import Foreign

main = do
  arr <- allocArray 10
  putStrLn "init value:"
  showArray 10 arr

  n <- peekElemOff arr 5
  putStrLn $ "5th value = " ++ show n

  mapM_ (\(a,b) -> f arr a b) $ zip [0..8] [1..]

  putStrLn "final value:"
  showArray 10 arr

  n <- peekElemOff arr 5
  putStrLn $ "5th value = " ++ show n

  freeArray arr

  where
    f arr a b = do
      v <- liftM2 (+) (peekElemOff arr a) (peekElemOff arr b)
      pokeElemOff arr a v

foreign import ccall "alloc_array" allocArray :: Int -> IO (Ptr Int32)
foreign import ccall "free_array"  freeArray  :: Ptr Int32 -> IO ()
foreign import ccall "show_array"  showArray  :: Int -> Ptr Int32 -> IO ()

Haskellのほうもこれでもかというぐらい手続きチックなのだが…。

Ptr Int32という型で配列を受け取ることにした。

Ptrに対する読み書きはForeign.Storable中、

Storableクラスにて定義されている。

ストア可能な型、数値型はおおよそ可能なのだが、

それのポインタ(Ptr a 型)について

peekElemOff :: Ptr a -> Int -> IO a 
pokeElemOff :: Ptr a -> Int -> a -> IO () 
peekByteOff :: Ptr b -> Int -> IO a 
pokeByteOff :: Ptr b -> Int -> a -> IO () 
peek :: Ptr a -> IO a 
poke :: Ptr a -> a -> IO () 

こないな関数が定義されている。

…こんなんHaskellじゃないやい。

まぁ、でもこれを使えば構造体も受け渡し出来そうである。


で、ようやくSDLを呼び出してみることにする。

SDLはその昔DirectX向けに作ったプログラムをSDLに移植した程度の

経験しかないのであるが…


とりあえずチュートリアルを読みながら適当に作っていくことにする。

教科書は http://www.libsdl.org/intro.jp/toc.html これ。

まずは

#include <stdlib.h>
#include "SDL.h"

main(int argc, char *argv[])
{
    if ( SDL_Init(SDL_INIT_AUDIO|SDL_INIT_VIDEO) < 0 ) {
        fprintf(stderr, "Unable to init SDL: %s\n", SDL_GetError());
        exit(1);
    }
    atexit(SDL_Quit);

    ...
}

これを移植することにする。(いきなり目標がめちゃくちゃ低い…)

まず、スタブの作成。

(これ、なんかヘッダファイル使って自動的にやる方法が

マニュアルに書いてあったような気がするけど、

英語が全然読めなかった。詳しい方、こっそりと教えてください…)

 -- sdl_init.c
#include <SDL.h>
#include "HsFFI.h"

HsInt sdl_init(HsWord32 flags)
{
  return SDL_Init((Uint32)flags);
}

HsInt sdl_initsubsystem(HsWord32 flags)
{
  return SDL_InitSubSystem((Uint32)flags);
}

void sdl_quit()
{
  SDL_Quit();
}

void sdl_quitsubsystem(HsWord32 flags)
{
  SDL_QuitSubSystem(flags);
}

Haskell側のインターフェース

 --sdlInit.hs
module SdlInit(
  Subsystem(..),

  sdlInit, sdlInitSubSystem,
  sdlQuit, sdlQuitSubSystem,

) where

import Data.Bits

data Subsystem =
    TIMER | AUDIO | VIDEO | CDROM | JOYSTICK
  | EVERYTHING | NOPARACHUTE | EVENTTHREAD
  deriving (Eq,Show)

subsystemToInt :: Subsystem -> Int
subsystemToInt TIMER       = 0x00000001
subsystemToInt AUDIO       = 0x00000010
subsystemToInt VIDEO       = 0x00000020
subsystemToInt CDROM       = 0x00000100
subsystemToInt JOYSTICK    = 0x00000200
subsystemToInt NOPARACHUTE = 0x00100000
subsystemToInt EVENTTHREAD = 0x01000000
subsystemToInt EVERYTHING  = 0x0000FFFF

subsystemsToInt :: [Subsystem] -> Int
subsystemsToInt ss = foldl (.|.) 0 $ map subsystemToInt ss

sdlInit :: [Subsystem] -> IO Bool
sdlInit ss = do
  ret <- inSDLInit $ subsystemsToInt ss
  return $ ret>=0

sdlInitSubSystem :: [Subsystem] -> IO Bool
sdlInitSubSystem ss = do
  ret <- inSDLInitSubSystem $ subsystemsToInt ss
  return $ ret>=0

sdlQuit :: IO ()
sdlQuit = inSDLQuit

sdlQuitSubSystem :: [Subsystem] -> IO ()
sdlQuitSubSystem ss =
  inSDLQuitSubSystem $ subsystemsToInt ss

foreign import ccall "sdl_init" inSDLInit :: Int -> IO Int
foreign import ccall "sdl_initsubsystem" inSDLInitSubSystem :: Int -> IO Int
foreign import ccall "sdl_quit" inSDLQuit :: IO ()
foreign import ccall "sdl_quitsubsystem" inSDLQuitSubSystem :: Int -> IO ()

一応フラグだけはデータ型作ってみたり。

で、呼び出すプログラム

 -- main.hs
module Main(main) where

import Control.Monad
import SdlInit

main :: IO ()
main = do
  ret <- sdlInit [VIDEO]
  when (not ret) then
    putStrLn "unable to init SDL."
  sdlQuit

Haskell版とはいえラッパが薄いのでコードがCのとほとんど同じになってる。


SDLだが、今回はmingw版をGHCのディレクトリインストールした。

GHCをCコンパイラとしても使うことに。

GHCがmingw抱えてるからVisualCとのリンクがうまく行くかわからんとか、

mingwを別にインストールしてないとかそんな具合で、

別に積極的な理由があったわけではないのだが…


コンパイルして、-lsdlオプションをつけてリンクするとひとまず完成。

問題なく動いた。


しかし、何も表示されないのでうれしくない。

ウインドウを出したいので次のチュートリアルへ。

{ SDL_Surface *screen;

    screen = SDL_SetVideoMode(640, 480, 16, SDL_SWSURFACE);
    if ( screen == NULL ) {
        fprintf(stderr, "Unable to set 640x480 video: %s\n", SDL_GetError());
        exit(1);
    }
}

次はこの辺を移植する。(また目標が小さい…)

 --sdl_video.c
#include <SDL.h>
#include "HsFFI.h"

HsPtr sdl_setvideomode(HsInt width,HsInt height,HsInt depth,HsWord32 flags)
{
  return SDL_SetVideoMode(width,height,depth,flags);
}
 -- sdlVideo.hs
module SdlVideo(
  SurfaceFlag(..),
  Surface,

  sdlSetVideoMode,
) where

import Data.Bits
import Foreign

type Surface = Ptr ()

data SurfaceFlag =
    SWSURFACE | HWSURFACE | ASYNCBLIT

  | ANYFORMAT | HWPALETTE | DOUBLEBUF
  | FULLSCREEN | OPENGL | OPENGLBLIT
  | RESIZABLE | NOFRAME

  | HWACCEL | SRCCOLORKEY | RLEACCELOK | RLEACCEL
  | SRCALPHA | PREALLOC

flagToInt SWSURFACE  = 0x00000000
flagToInt HWSURFACE  = 0x00000001
flagToInt ASYNCBLIT  = 0x00000004

flagToInt ANYFORMAT  = 0x10000000
flagToInt HWPALETTE  = 0x20000000
flagToInt DOUBLEBUF  = 0x40000000
flagToInt FULLSCREEN = 0x80000000
flagToInt OPENGL     = 0x00000002
flagToInt OPENGLBLIT = 0x0000000A
flagToInt RESIZABLE  = 0x00000010
flagToInt NOFRAME    = 0x00000020

flagToInt HWACCEL    = 0x00000100
flagToInt SRCCOLORKEY= 0x00001000
flagToInt RLEACCELOK = 0x00002000
flagToInt RLEACCEL   = 0x00004000
flagToInt SRCALPHA   = 0x00010000
flagToInt PREALLOC   = 0x01000000

sdlSetVideoMode :: Int -> Int -> Int -> [SurfaceFlag] -> IO Surface
sdlSetVideoMode width height depth sf = do
  inSDLSetVideoMode width height depth $ foldl (.|.) 0 $ map flagToInt sf

foreign import ccall "sdl_setvideomode" inSDLSetVideoMode :: Int -> Int -> Int -> Int -> IO Surface

Surfaceはよくわからないが、Ptr ()にしておいた。

今のところは使わないし。

peek/pokeでがりがり読み書きしてHaskell側で同じ構造体を構築するか、

はたまた、アクセス関数をCで書いてPtr ()を渡し続けるか、

そのへんは未定。

 -- main.hs
module Main(main) where

import Control.Concurrent
import Control.Monad
import SdlInit
import SdlVideo

main :: IO ()
main = do
  ret <- sdlInit [VIDEO]
  if ret then
    do putStrLn "initialize successed."
       sur <- sdlSetVideoMode 640 480 32 [SWSURFACE,ANYFORMAT]
       threadDelay (1000*1000)
    else
      putStrLn "initialize failed."
  sdlQuit

mainはこないな感じ。

現時点でイベント処理を実装していないので

threadDelayで1秒寝た後に終了。

とりあえずウインドウの出現を確認できてちょっとうれしかった。


ときに、ここまで作ってコンパイルコマンド

>ghc sdlInit.hs sdl_init.c sdlVideo.hs sdl_video.c main.hs -fglasgow-exts -lsdl -o sdltest.exe

こんな状態になってしまった。

Windowsのcmdで作業してるのだが、

そろそろ(makeを使うためだけに)Cygwin上にするかな…

[]コンパイラ コンパイラを含むブックマーク コンパイラのブックマークコメント

結局レポートは結構適当な出来で提出。

Haskellのほうがおもろいんだもん…

[]鴨川 鴨川を含むブックマーク 鴨川のブックマークコメント

自転車撤去がリアルタイムで進行中。

どうしたものか。

トラックバック - http://d.hatena.ne.jp/tanakh/20040717

2004年07月16日(金) 登録完了

[]Visual Studio .net theSpoke Premium Version 2003 Visual Studio .net theSpoke Premium Version 2003を含むブックマーク Visual Studio .net theSpoke Premium Version 2003のブックマークコメント

登録できたとのことなので、早速インストール

HDD容量の残りが2GBぐらいしかなくなっていたので、

掃除してからインストール


…は良いのだが、なんだか妙に時間がかかった。

途中ドライブがスコスコ音を発して全然ファイルのコピーが進まない。

で、DISC1のコピーが完了したのが3時間後。

もう、なんというか、非常にイライラした。

ドライブの異常かはたまたCD不具合か。

うんざりしながらDISC2を入れると、これは快調に読み込まれる。

10分ほどで終了。

MSDNライブラリの3枚も大体10分づつぐらいで完了した。

やっぱりディスクの不良か。

まさかこんなところで悩まされるとは思いもよらなかった。


結局一番開発が進む時間帯の4時間ほどをインストールに持っていかれた。

Haskell進まず。ああ・・・。

トラックバック - http://d.hatena.ne.jp/tanakh/20040716

2004年07月15日(木) 外界とのおしゃべり

[][]Foreign function interface (FFI) Foreign function interface (FFI)を含むブックマーク Foreign function interface (FFI)のブックマークコメント

昨日適当テトリスが出来上がったけど、

まだまだHaskellネタが続くのです。

現時点であと二つほどは書きたいネタがあったりする。

Haskell上でのゲームプログラミングの方法論、

端的に言うとエレガントさの追求はまた今度。


とりあえず昨日までwxHaskellをやって、

それでゲームを作ったわけであるのだが、いくつかの点で限界を感じた。

  • 描画速度・描画機能
  • 音が出せない

普通にGUIアプリを作る分には良いんだろうけど、

(GUIのコントロール色々あるしね)

どうにもこうにもゲームには向いてないような印象だ。


そんなわけでSDLを使おうという話になった。(私の中で…)

Haskellというある意味異端なものを使いながら

結局超標準的なSDLに収まるのもなんともかんとも言えないが、

とりあえずやってみないと分からないのである。

もともと全く関数的でないライブラリをもとに

きちんと宣言的なインターフェースを用意できるのかどうか

ということにもそれなりに興味があるし。


で、まずはGoogleHaskell/SDLの存在を検索してみる。

有ったらそれ使えるので。だがまぁ、とりあえず存在しないらしい。

http://www.libsdl.org/languages.php

ここから調べるところろによると、公式にも認知されていないようである。


というわけで、FFI勉強を始めることにする。

恥ずかしながらHaskell暦は1年弱あるにもかかわらず

(積極的に使い始めたのはここ数ヶ月だけど)

FFIははじめてである。初めてなのでとんちんかんなことを

書いていても怒らないように。(こっそり教えたってください)

まぁ、wxHaskellも初めてだったんだけど。


まずは、HaskellコードをCから呼び出し。

多分使わないと思うんだけど…GHCのユーザーガイドの

FFIのとこの最初に載ってるから…。


まず、以下のようなfoo.hsを用意。

Haskell側の関数の実装。ドキュメントから引っ張ってきただけだが。

module Foo where

foreign export ccall foo :: Int -> IO Int

foo :: Int -> IO Int
foo n = return (length (f n))

f :: Int -> [Int]
f 0 = []
f n = n:(f (n-1))

foreign export のところがエクスポートする指定か。

エクスポートできるのはIOモナドだけっぽい。

まぁ、どっちでもあまり変わらないけど。


続いて呼び出し側のC。main.cというファイルにしてある。

#include <stdio.h>
#include "foo_stub.h"

int main(int argc,char *argv[])
{
  hs_init(&argc, &argv);
  printf("%d\n",foo(2004));
  hs_exit();
  return 0;
}

コンパイル方法。

ghc -cpp -fffi -o foo.exe foo.hs main.c

なんかよくわからんのだが、-fffiをつけると

FFIなコードがコンパイル出来るようである。

つけないとコンパイルとおらない。

で、FFIなコードをコンパイルすると、普段作られる

foo.hi,foo.oのほかにfoo_stub.cとfoo_stub.hが作られて、

さらにそれのコンパイルまで行われる。

なんだか至れり尽くせりな感じである。

そのスタブなヘッダをmain.cからincludeする形となっている。

それでとりあえずfoo()が呼び出せるようだが、

最初にhs_init()とhs_exit()を呼び出す必要がある。

(本当に要るのか?と思って省いてみると見事に落ちた)

>foo
2004

で、実行すると普通に動いた。というか、こんだけじゃ

ほんとに呼び出してるかわからんぞ???

もうちょっと複雑なnqueenでも動かさしてみようかの?


nqueen :: MonadPlus m => Int -> m [Int]
nqueen n = inner 0 [] where
  inner cur ls
    | n==cur = return ls
    | otherwise = msum [inner (cur+1) (n:ls) | n <- [1..n], canPut n ls]

  canPut n ls = not $ n `elem` (zip [1..] ls >>= \(d,n) -> [n,n-d,n+d])

MonadPlus版。

これ一つでリストモナドを使えば全解リスト

Maybeモナドを使えば一つの解を見つけるスグレモノである。

headとりゃいいやん、とか言っちゃ駄目。


というわけで、こんなソースをでっち上げた。

module Queen where
import Control.Monad

nqueen :: MonadPlus m => Int -> m [Int]
nqueen n = inner 0 [] where
  inner cur ls
    | n==cur = return ls
    | otherwise = msum [inner (cur+1) (n:ls) | n <- [1..n], canPut n ls]

  canPut n ls = not $ n `elem` (zip [1..] ls >>= \(d,n) -> [n,n-d,n+d])

foreign export ccall queenCnt :: Int -> IO Int

queenCnt :: Int -> IO Int
queenCnt n = return (length (nqueen n))

queenCntがエクスポートする関数で、解答の数を返す。


C側は

#include <stdio.h>
#include <stdlib.h>
#include "queen_stub.h"

int main(int argc,char *argv[])
{
  hs_init(&argc, &argv);
  printf("%d\n",queenCnt(atoi(argv[1])));
  hs_exit();
  return 0;
}

適当にこんな風に変えた。


コンパイル&実行。

>queen 8
92

>queen 10
724

よしよし、これで満足である。(満足なのか…)

2004年07月14日(水) そしてひとつの結論

tanakh2004-07-14

[]wxHaskell (その5) wxHaskell (その5)を含むブックマーク wxHaskell (その5)のブックマークコメント

前回のでゲームを作るための基盤はおおよそ固まっていたので、

とりあえず何か作ってみることにした。

何か、といってもあれなので、この前コメントをいただいたテトリスを作ることにした。

HaskellGUIテトリス。半年ほど前、Haskellというものを知ったころからは

考えもつかぬことであった。参照透明なのにゲームなんか作れるのかと。


結局のところHaskellでもIOモナドを羅列しだすと何でも出来るし、

また、IOモナドを羅列しだすとHaskellHaskellらしさというものも

あまり感じられなくなってくるのだが、

(たとえばIOが本質じゃないけどIOモナドになってるやつ、

たとえばvarCrate :: a -> IO (Var a) など、

はっきりいってIOなどという胡散臭い?ものを持ち出さずとも

見た目書き換え可能な変数は純関数的に構築できる。

詳しくはStateモナドあたりを調べていただくとして、

実際のところ、後ろに副作用が見え隠れする云々ではなくて

今現在の私にはモナディックなやり方がどうも

関数型っぽく感じられていないのかもしれない。

個人的にはStreamなやり方がまさしく純粋関数的に感じられる。

いやまぁ、モナドなやり方は便利だし、

高階プログラミングの技法としてすばらしいと思うけど、

そのたどり着く先が私の書いたようなコードだとするとちょっと悲しい)

そのせいかどうかは知らないが、当初思っていたほどの達成感は無いような。


…で、なんかよくわからん余談が長くなったけど、

とりあえずテトリスを作りました。

実装はとりあえず前回作ったやつのonProcessとonDrawを書き換えた感じ。

細かい部分でちょこっと書き換えたけど、昨日の時点での思惑は

そんなに外れていなかった模様。

テトリスの処理自体は普通にIOに侵食されずに記述できた。

描画も適当にビットマップ描画するだけなので適当に並べ立て。

昨日のプログラム、あそこまで書けていれば、今日は特に困ることは無かった。

なんというか、すんなり過ぎてあまり話題が無いのだが…

とりあえず、作ってて思ったことなど。


  • 設計技法・シーンなど

C++で作ってたころは適当にシーンクラスを作って、

実行すべきシーンクラスを差し替えながらいろいろやっていた。

Haskellでも、そのようなディスパッチャを作るのは簡単であるが、

もっとHaskellならではの良い方法があるのではないだろうか?


  • 実行ループ

これもC++で作ったときと同様に

ループごとに状態を書き換えという感じになるが、

(要するにFinite State Automaotnを実装するような感じに)

継続を用いればこのような気苦労がいらないのは周知の事実である。

(直接継続を扱えないC++などの言語では

MicroThreadとかFiberなどと呼ばれるコルーチンという形で同様の処理を行える)

Haskellで継続を扱うためにはContinuationモナドを使えるが、

継続を使うプログラムは難解になり易い。

それに、遅延言語はその遅延評価のために

同等の処理を継続を扱うことなしに可能である場合が多い。

要するに、遅延評価を生かして直接的に分断される計算のコンテキストを

管理することが出来るのでは無かろうかということである。


  • 実行速度

今使ってるマシン(PentiumM 1Ghz)でも今回作ったテトリス程度ならば

とくに問題なく60フレーム出る。

(なんかちょっとだけ足りてないような気がしないでもない…

しかし、なんだかCPUパワーを使い切っていない。

使い切っていないのにスキップしてしまっているということは

速度調節ルーチンがどこか間違えているのか、あるいはライブラリバグか)


説明・考察はこの辺で。

果物を公開しておきます。

http://fxp.infoseek.ne.jp/haskell/wxTetlis.zip

このプログラム音声が無いのでコロブチカあたりを

自前で用意して鳴らしながらプレイしてもらえれば…

ブロックの絵とか、http://www.linkfever.net/game/tetris.html このページから

ちょっと使わせてもらったんだけど…。まずかったら書き直します。

というか、このページほとんど誰も見てないから大丈夫だよね。


結局、ゲームシステムの周りはコマンドの羅列になってしまったような

感じがするのだが、一つ特筆すべき点があった。

このプログラム、ほとんどバグが出なかったのである。

GHCにはソースレベルデバッガが無い(と思う)のだが、

そもそもデバッグの必要が無かった。

なんだか今まですっかり忘れていたが、

この点だけでもHaskellを使う大きな利点ではないかと思った。

ひとまず 第一部完、てな感じ? ひとまず 第一部完、てな感じ?を含むブックマーク ひとまず 第一部完、てな感じ?のブックマークコメント

このページ見て自分もHaskellゲーム作ろかな、

と思ってくれた人がいたらうれしいなぁ…

というか、そもそも読者がおらんて?

うっかり うっかりを含むブックマーク うっかりのブックマークコメント

DLLとソースを入れるのを忘れてた。

というか、バイナリサイズが7.4MBもあるのにDLL使ってるとは…

ということで再アップしました。

tokuhiromtokuhirom 2004/07/14 12:18 「wxc-msw2.4.2-0.7.dll が見つからなかったためこのアプリケーションを開始できませんした」と怒られて、実行できませんでした。

tanakhtanakh 2004/07/14 15:00 ああ、気付きませんでした。zipの中にDLLを突っ込んでおいたのでもう一度試してもらえませんか。

tokuhiromtokuhirom 2004/07/14 20:34 再度ダウンロードしたら動きました。

tanakhtanakh 2004/07/14 23:31 それは良かったです。普通のテトリスですけど、何かの参考になれば幸いです。

2004年07月13日(火) First step toward the game programming ...

[]wxHaskell (その4) wxHaskell (その4)を含むブックマーク wxHaskell (その4)のブックマークコメント

Haskellゲーム計画もいよいよ大詰めである。

これまでHaskellではGUIアプリを作ったことが無かったため

(もっとも、日本HaskellでGUIアプリを作ったという話を聞いたことが無いけど)

その道程は困難を極めたが、これまでにひとつづつその障壁を取り除いてきた。

最初は私も本当にまともにゲームが組めるか不安でならなかったのだが、

ようやく行けそうだ、というような感覚が湧いてきた。


今回はゲームを実装する上で重要な入出力処理、

リアルタイムキー入力及び画像出力、さらにスピードコントロールを考える。


  • キー入力

wxHaskwllにはWin32APIで言うところのGetKeyState()みたいなものが無い。

どうやってキー入力を取るのかといえば、ウインドウイベントハンドラ

追加して、それで処理するのである。

しかし、やはりリアルタイムゲームを設計するにあたって、

イベントで処理はいやなのだ。適当にループまわして、そのループから

キーの押下状態を知りたいのである。


wxHaskellのローレベルな部分へのアクセスであるWXCoreモジュールにも

それに相当しそうなものは無い。

しかし、とりあえずこっちのほうにはKeyUpイベント

KeyDownイベントがあったので(Coreじゃないほうには無い)

それらを使って何とかすることにした。

windowOnKeyDown :: Window w -> (EventKey -> IO ()) -> IO ()
windowOnKeyUp   :: Window w -> (EventKey -> IO ()) -> IO ()

それぞれ↑の様な型を持っている。指定したハンドラが追加される。

ハンドラにはEventKey型のデータとして押された/放されたキーが渡される。


このそれぞれで現在押されているキーを管理することができるので、

とりあえずそのようなものを実装することにした。

 -- キーボード処理

data GameKey =
  GKUp | GKDown | GKLeft | GKRight | GKRotate
  deriving (Eq,Show,Enum)

data KeyState =
  Pushed | Pushing | Released | Releasing
  deriving (Eq,Show)

isPressed Pushed  = True
isPressed Pushing = True
isPressed _       = False

type KeyProc = GameKey -> KeyState

使うデータを適当に定義する。

キー状態はゲーム中で用いやすいように

  • 押された瞬間
  • 押されている
  • 放された瞬間
  • 放されている

の4つを持つことにする。

main :: IO ()
main = start $ do
  kd  <- varCreate ([ ],[ ],[ ])
  ...

  windowOnKeyDown f $ kbdDown kd
  windowOnKeyUp   f $ kbdUp   kd
  ...

データの共有のためにVarな変数を作る。

    kbdDown kd ek = kbdUpdt kd $ \(e,s,l) ->
      let k = keyCvt ek
          ns = s `union` k
          ne = e `union` k
      in if ns==s then (e,s,l) else (ne,ns,l \\ k)
    kbdUp   kd ek = kbdUpdt kd $ \(e,s,l) ->
      let k = keyCvt ek in (e \\ k,s \\ k,l `union` k)

    keyCvt ek = case keyKey ek of
      KeyUp       -> [GKUp]
      KeyDown     -> [GKDown]
      KeyLeft     -> [GKLeft]
      KeyRight    -> [GKRight]
      KeyChar 'Z' -> [GKRotate]
      _           -> []
    
    kbdUpdt kd f = varUpdate kd f >> return ()

kbdDownとkbdUpの処理は上のとおり。

(e,s,l) にて、eがちょうど押されたキーのリスト

sが押されているキーのリスト、lがちょうど放されたキーのリストとしている。

上記コードだけではちょうど押されたキーのリスト

ちょうど放されたキーのリストがずっとそのままになってしまう。

毎フレーム

    updateKey (_,s,_) = ([ ],s,[ ])

により、クリアを行う。キーデータは

    keyProc (e,s,l) k
      | k `elem` e = Pushed
      | k `elem` s = Pushing
      | k `elem` l = Released
      | otherwise = Releasing

などという関数をつくって取得することにする。

ゲームの処理にはこの辺が見えないようにこれに(e,s,l)なデータを部分適用

した関数を渡すことにする。要するに最初のほうで定義したKeyProcなものを

渡すということである。


  • 描画処理
  ...
  f <- frameFixed [text       := wndTitle
                  ,clientSize := wndSize
                  ,bgcolor    := black
                  ,visible    := False]
  dc <- clientDCCreate f
  ...

clientDCCreateによりDCが取得できる。(DCて、とか言わない!)

それをゲームの描画関数に渡してやることにする。

リアルタイムゲームでは実行中FPSを維持する必要がある。

適当にウェイトを入れてやることにする。

というか、結局IOコマンドの羅列になるんだが…

elapseTime :: Integer -> IO (IO (Int,Bool))
elapseTime fps = do
  let frametime = picosec `div` fps
  tm <- getClockTime
  st <- varCreate ( (0,0,noTimeDiff),(1,tm))
  return $ do
    ( (bef,cur,fdt),(cnt,bt)) <- varGet st
    ct       <- getClockTime
    let dt   = diffClockTimes ct bt
        ndt  = diffClockTimes ct tm
        adj  = frametime*cnt - toPsec dt
        nc   = if cnt==fps then (1,ct) else (cnt+1,bt)
        (nbef,ncur) = if tdSec fdt /= tdSec ndt then (cur,0) else (bef,cur)
    if adj<0 then do
        varSet st ( (nbef,ncur,ndt),nc)
        return (bef,False)
      else do
        varSet st ( (nbef,ncur+1,ndt),nc)
        threadDelay $ fromInteger $ min 16666 $ adj `div` 1000000
        return (bef,True)
  where
    toPsec dt = toInteger (tdMin dt * 60 + tdSec dt) * picosec + tdPicosec dt
    picosec = 1000000000000

こんな感じ。

FPSを指定するとFPSを安定させるコマンドを返すようなコマンドである。

(というかこれ、C++用に作ったやつをほとんど書き写しなんだがなぁ…)

実行はIdleループを用いて、これを延々回し続けることによって行う。

  ...
  et <- elapseTime 60
  
  windowOnIdle    f $ do
    k   <- varGet kd
    st  <- varUpdate gs $ onProcess (keyProc k)
    varSet kd $ updateKey k
    (fps,draw) <- et
    when draw $ dcBuffer dc (rectFromSize wndSize) $ \dc -> do
      onDraw dc res st
      drawText dc (show fps) (pt 600 10) [color := white]
    return True
  ...

上記コードでetがFPSを安定させるコマンドになる。

ちなみに返す(Int,Bool)は現在FPS(描画した回数)と

次回描画処理を行うべきかどうかである。


上のコードのonProcessとonDrawがゲームの処理と描画処理になる。

それぞれ、

onProcess :: KeyProc -> GameState -> GameState
onDraw    :: DC a -> Resource -> GameState -> IO ()

の型を持つことにする。

ResourceとGameStateはゲームにあわせてお好みに定義する。


というわけで

このあたりで一通り雛形が完成した。説明が適当すぎたけど。

onProcessは毎秒ちょうどFPS回呼び出される。

onDrawは毎秒高々FPS回呼び出される。

onProcessからはなんとかIOをはずすことができた。

IO処理は一切できないのだが、それはonDrawのほうに全部行うことにした。


まぁ、なんというか、これも書いててHaskell意味あるんかなぁとか

C++で作ってたころと何も変わらんやん?とか

なんとかちょっと悲しくなってきたのであるが、

最初はともかく動くものを作るのが先決であろう。

一通りできてからもっとエレガントな定義的で遅延を生かした

方法を考えることにする。


一応今回もファイルをアップ。

テトリスで使いそうなキーの入力テストプログラム

http://fxp.infoseek.ne.jp/haskell/tatakidai.zip

どうでもいいんだけど どうでもいいんだけどを含むブックマーク どうでもいいんだけどのブックマークコメント

こんな内容ばっかり書いているせいか、

最近「おとなり日記」が無くなった。最初のころはあったのに。

ここは陸の孤島なのか?

[]部分ビットマップ転送 部分ビットマップ転送を含むブックマーク 部分ビットマップ転送のブックマークコメント

上話題続き。

ビットマップの一部を描画したいと思ったのだが、

(小さいパーツをまとめてひとつのビットマップファイルにしたい)

wxHaskellのビットマップ描画関数にはどうもそれらしき機能が見当たらない。

drawBitmap :: DC a -> Bitmap () -> Point -> Bool -> [Prop (DC a)] -> IO ()

ビットマップを描画する機能を有するのはどうやらこれだけで、

どこからどう見ても座標の指定しかない。

WXCoreの方になら有るに違いないと思い探すこと半日以上、

いよいよもうこれはばらばらのファイルから読むしかないなと

思ったその矢先、適当に見たマニュアルのページに

bitmapGetSubBitmap :: Bitmap a -> Rect -> IO (Bitmap ())

こんなものが。

てか、こうやってやるのね…ずっと描画時に指定する方面で頑張ってた。

まぁ、どっちにしろドキュメントが不親切すぎ。

大体にして目的の関数がどんな名前してるかわからんから

アルファベット順の索引ではもうどうしようも…

2004年07月12日(月) 解けない暗号

なんだか本格的にHaskellばっかりになってきた。

私がHaskellに固執する理由は現状で純粋関数型非正格な言語

HaskellとCleanぐらいしかないからなわけで…

[]非手続き型言語の生成するコードとは 非手続き型言語の生成するコードとはを含むブックマーク 非手続き型言語の生成するコードとはのブックマークコメント

昨日の最後のプログラムリソースをテキストでべた打ちしながら

これはまともなアプリケーションなら書き換えられんように

しなければならないなぁ、そんなもん簡単な暗号化でも施しといたらいいやん?

でもそれだと逆アセしたら簡単に解析されてしまうんじゃ…。

あれ、ちょっと待てよ。Haskellのコードって逆アセして普通に

処理が追えるようなものなのか?遅延評価だぞ、遅延評価。

というか、そもそも処理も記述しないしな。


もしかしたらお手軽に破られにくい軽量な暗号が実現するかも、

ということで、調べてみることにした。

module Main(main) where

import System
import System.IO
import Data.Char
import Data.Bits

main = do
  [mode,infile] <- getArgs
  case mode of
    "-d"      -> p infile ".dec" decr
    "-e"      -> p infile ".enc" encr
    _ -> error "unknown option"
  where
    p infile ext f = do
      let outfile = takeWhile (/='.') infile ++ ext
      ih  <- openBinaryFile infile  ReadMode
      oh  <- openBinaryFile outfile WriteMode
      dat <- hGetContents ih
      hPutStr oh $ f dat

encr xs = map chr ps where
  ns = map ord xs
  ps = [(a `xor` b) `xor` 0x55 | (a,b) <- zip (0:ns) ns]

decr xs = map chr $ n:f (n:ns) where
  (n:ns) = map ((xor 0x55) . ord) xs
  f [_]        = []
  f (x:y:rest) = d:f (d:rest) where
    d = x `xor` y

適当暗号・複合プログラムをでっち上げた。

encrが符号化・decrが復号化である。

アルゴリズムは隣り合うバイト同士のxorをとって

それから55hをxorするだけの簡単なもの。


これをGHCを用いてアセンブリリストにコンパイルしてみた。

で、読んでみようと思ったのだが、案の定というか、

思った通りというか、全然読めない。

.text
  .align 2
  .long  _r1fH_srt+16
  .long  131072
  .long	851986
 _s1ht_info:
.text
 _s1ht_entry:
/APP
/NO_APP
  leal  -20(%ebp), %eax
  cmpl  84(%ebx), %eax
  jb    L45
  addl  $12, %edi
  cmpl  92(%ebx), %edi
  jbe   L44
L45:
  movl  $3, 108(%ebx)
  jmp   *-8(%ebx)
L44:
  leal  -8(%ebp), %eax
  movl  $_stg_upd_frame_info, (%eax)
  movl  %esi, 4(%eax)
  movl  $_s1hr_info, -8(%edi)
  movl  $_GHCziBase_ord_closure, -12(%ebp)
  leal  -8(%edi), %eax
  movl  %eax, -16(%ebp)
  movl  $_GHCziBase_zi_closure, %esi
  subl  $20, %ebp
  jmp _stg_ap_pp_ret

適当な抜粋。全体では2000行ぐらいあるけど。

  movl  $_GHCziBase_ord_closure, -12(%ebp)

この辺にordを使ったかな、という痕跡が見て取れる。

がしかし、やっぱり全く読めない。

ソースのどことどこが対応しているのかさえ分からない。

しかも上のアセンブリソース、実際に実行ファイルから

逆アセンブラした場合はラベルが無いわけで、この程度も読み取れるかどうか。


結局今のところの感想としては

「解読無理っぽい」

そこで、今回は読者(居るんかいな?)への挑戦を残しておく。

符号・復号プログラムからアルゴリズムを推測して欲しい。

アルゴリズムが分かった方はコメントあたりでお知らせ願いたい。

プログラムは上のソースのencrとdecrを書き換えただけのもの。

アルゴリズムのレベルも大体上と同じぐらい。

正解者先着一名様には………何もありません。

私の考えの浅はかさが露呈するだけ…。

http://fxp.infoseek.ne.jp/haskell/encr.zip

トラックバック - http://d.hatena.ne.jp/tanakh/20040712

2004年07月11日(日) 日本語は難しきものと知りたり 〜Haskell処理系の光と影〜

[]wxHaskell (その3) wxHaskell (その3)を含むブックマーク wxHaskell (その3)のブックマークコメント

前回積み残しのコンソールが出てしまう問題だが、

PEファイルフォーマットを調べるとSubsystemのフラグに

それっぽいものが有ったのでいじってみると見事出なくなった。

これにて解決である。(これで良いのか…?)

後学の為に場所を記しておく。

(こんなとこだけ記されてもうれしくない方はちゃんとしたところで

PEファイルフォーマットを調べましょう)

ここ(アドレスDCh)の2バイトが0002hだとWindowsGUIアプリということのようである。

(追記:

リンカのオプションオプションがあるようです…。

ですので、上のような書き換えをせずとも

ghc -optl -mwindows で良いようです)


続いて根本的問題のように思える日本語について考える。

そもそもなぜ日本語が使えないかというと、GHCがSJISを

受け付けてくれないからなのである。

プログラムの動作としては、Stringは[Char]だし、

Charは単なる0..255なデータだと思うので、日本語を扱うのは全く問題ない。

ところがどっこい、GHCは文字リテラルとして想定外のものを

はじいているようなのである。(というかパーズできないのか)

"lexical error in string/character literal" などというメッセージを出して

コンパイルエラーとなる。

このエラーは文字エンコードをSJISにしてもUTF8にしても発生する。

しかし、EUC-JPにするとなぜか発生しない。

EUC-JPが80h〜A0hの領域を使っていないせいなのだろうか。

(追記2:

Charは一バイト文字じゃないようです。

ghc 6.2.1だとmaxBound::Charが\x10ffffになっています。

手持ちのHugs(Version Nov 2003)だと\xffです。

Haskell仕様では上界は未定?あるいはUnicodeを扱うように決められてるけど

Hugsが実装していないのか?(ちゃんと仕様書読めという話ですが…)

しかし、GHCにしても入力はUnicodeに変換されないみたいだし、

FFI周りも単にバイトストリームとして扱われてしまっているようなので

下記のような工夫は必要)

とにもかくにもひとつの光明が見えてきた。EUC-JPを使うのである。

EUC-JPなら問題なくコンパイルできる。

そして、Windowsが受け付けるのはSJISである。

(正確に言うとWindowsに言及するのはおかしい。

wxHaskellが何を受け付けるかというのが問題なのであるが、

wxHaskellはおそらくGHCと同じで多倍長文字について

何にも考えていないだろうから、ポータビリティを考えつつ

日本語の問題に言及するのは不可能である。

そのためここではWindows環境下に限っての議論を行う。

wxHaskellがWindowsAPIに何も考えず文字列を流し込むという前提であるが。

Unix系をだと多分デフォルトEUC-JPなので

もっと何も考えないで良いと思う)

リテラルに格納されるのはGHCが許すEUC-JPとなる。

つまりtextとかの属性に文字列を渡す前に

EUC-JP→SJIS変換を掛ければ良いのである。

  [title,fileMenu,exitMenu] =
    map eucToSjis ["電卓","ファイル (&X)","終了 (&X)"]
  ...
  f      <- frameFixed    [text := title, ...
  p      <- panel f       []
  file   <- menuPane      [text := fileMenu]
  mclose <- menuItem file [text := exitMenu]
  ...

このファイルを 「EUC-JPで保存」し、コンパイルして実行すると、

title,fileMenuなどには「SJIS」の文字列が入ることになる。

eucToSjisは次のように適当に作った。

あんまりちゃんと正しいか確かめてない。

module CCode where

import Data.Char

eucToSjis :: String -> String
eucToSjis  = 
eucToSjis (x:xs)
  | ord x <= 0xA0 = x:eucToSjis xs
  | otherwise = case xs of
      y:ys -> (chr $ cvt1 (ord x)) :
              (chr $ cvt2 (ord x) (ord y)) :
              eucToSjis ys
      _    -> error "invalid EUC-JP string."
  where
    cvt1 x | x < 0xdf  = ((x+1) `div` 2) + 0x30
           | otherwise = ((x+1) `div` 2) + 0x70

    cvt2 x y | y <= 0xA0    = y
             | mod x 2 == 0 = y-2
             | y < 0xe0     = y-0x61
             | otherwise    = y-0x60

ちなみに上プログラム

http://www.net.is.uec.ac.jp/~ueno/material/kanji/euc2sjis.html

このページを参考にさせていただいた。


で、取り敢えず昨日のソースをこのように変更し、

いそいそとコンパイル→実行したところ正しく日本語が表示された。

なんとかうまくいったようである。


しかーし。

上記のソースはいくつかの点でいや〜んな感じなのである。

いくつかの点というか、

  • ポータビリティの欠損。エンコーディングのEUC-JPへの強制。
  • 回りくどい。なんでコンバートなんかせにゃイカンねん。

あたりであるが。


何が問題って、原因はすべてGHCが多倍長文字を含むソース

コンパイルできないことにあるんだから、

もっと直接的な解決方法がある。バイナリ書き換えである。

生成された実行ファイルから文字列を検索し、しれしれっと

SJISの文字列に書き換えればプログラムは何事も無かったかのように

日本語を表示してくれる。

だがしかし、これもどうなのだ、っちゅう感じである。

そもそもソースコード中で文字列について言及できてないのがなんともかんとも。

全然駄目ですな。


違う方法を考える。

発想は前と同じでソース中には多倍長文字を記述しないという方式(…?)である。

国際化のことなんかなーんも考えてないGHCに多倍長文字食わすことが

そもそもの間違い(?)だというわけで。

ソースに書けないものはどっかから引っ張ってこればよい。

なにか別のファイルにSJISで文字書いておけば実行時に

そのファイルを読み込むことによりSJISの文字列が取得できる。

 -- 文字列リソース
initResource :: String -> IO (String -> String)
initResource resfile = do
  resDat <- readFile resfile
  let dat = map (\(a:b:_) -> (a,b)) $
            takeWhile (not.null)    $
            iterate (drop 2)        $ lines resDat
  return (\name -> fromMaybe name $ lookup name dat)

関数は何かファイルを指定して、ID→文字列への写像を返すような

コマンドになる。

  ...
  res    <- initResource "res.txt"

  f      <- frameFixed    [text := res "title", ... 
  p      <- panel f       []
  file   <- menuPane      [text := res "file"]
  mclose <- menuItem file [text := res "exit"]
  ...

使い方はこんな感じ。

title
超関数電卓
file
超ファイル (&F)
exit
超終了 (&X)

res.txtには上のようなことをおずおずと書き立てておく。

で、コンパイル&実行。

おお、やったぜ。

これでようやく枕を高くして眠れるというわけである。

ちなみにこれだと文字列をプラットフォームごとに用意することにより

ポータビリティを持たせることが可能になる。

また、これはローカライズに普通に用いられる手法なので

言語対応もできる。

問題点としてはファイルを別に用意する必要があるということか。

リソースに埋め込めれば理想的なのだが

私はいまのところHaskellリソース扱う方法を知らないし、

ポータビリティも失われそうである。


まぁ、結局何が良いかよく分からないが、

個人的には最後のが比較的まともなのではないかと思う。

一応最後のやつのソース+Windowsバイナリを。

(圧縮+サブシステム書き換えで割かしまともにしたやつ)

http://fxp.hp.infoseek.co.jp/haskell/calc2.zip


どうでも良いけど、このページHaskellばっかりだなぁ。

2004年07月10日(土) 完全なる関数の電卓 〜はじめてのGUIアプリ〜

もうすぐ期末テストなのに何もしていないのだが…

まぁ、それは置いておいて。

[]wxHaskell (その2) wxHaskell (その2)を含むブックマーク wxHaskell (その2)のブックマークコメント

GUIHaskellでやりたいよ〜ということで(そうだったのか?)

昨日からwxHaskellをいじっているのだが、

色々と問題がありそうだったのは昨日書いたとおりである。

適当にZipで圧縮すると1.58MBに、

7Zipで圧縮すると970KBぐらいになった。

これでも相当でかいと思うのだが、結局実行するときは解凍しないといけないので

根本的には解決にならないだろう。

実行ファイルを圧縮できるUPXもつかってみた。

普通に圧縮したら6MB弱にしかならなかったのでこりゃ駄目だと

思っていたら余分なデータの削除なるオプションを使ったら500KB弱になった。

まぁ、それなりに大丈夫なレベルか?

ちょっと大きいような気もするけど7MBから考えると大幅にましである。

表示するオプションとかが分かったので解決

  • コンソールが表示される

分からず。これってPEファイルオプションじゃなかったっけ?


というわけでwxHaskellの勉強である。

とりあえずなんか作らねば。というわけで、電卓である。

関数型なので、関数電卓。作ったのは関数電卓じゃないけど。

module Main where
import Graphics.UI.WX

 -- 電卓の状態
type CalcState = (Integer,Maybe Integer,Maybe String)
initState = (0,Nothing,Nothing)

main = start mainFrame

 -- ウインドウの形成
mainFrame = do
  f      <- frameFixed    [text := "Calculator"
                          ,clientSize := sz winX winY
                          ,visible := False]
  p      <- panel f       []
  file   <- menuPane      [text := "&File"]
  mclose <- menuItem file [text := "&Close"]
  disp   <- textEntry p AlignRight
              [text := "0",outerSize := sz (winX-5) textHeight]
  var    <- varCreate initState
  
  set f [menuBar := [file]
        ,on (menu mclose) := close f]
  makeButton p (disp,var)
  set f [visible := True]
  where
    makeButton frame arg =
      sequence [mak x y t | (y,ls) <- zip [0..] but
                           ,(x, t) <- zip [0..] ls] where
      mak x y t = button frame
        [text       := t
        ,position   := pt (x*(bSizeX+bMergin)+bMergin)
                          (y*(bSizeY+bMergin)+textHeight+bMergin)
        ,outerSize  := sz bSizeX bSizeY
        ,on command := pushButton arg t]

    but = [ ["7","8","9","/","AC"]
           ,["4","5","6","*"]
           ,["1","2","3","-"]
           ,["0","+/-",".","+","="] ]
    (bSizeX,bSizeY) = (30,20)
    bMergin = 5
    textHeight = 20
    (winX,winY) = (182,145)

 -- ボタン押下時の処理
pushButton :: (TextCtrl a,Var CalcState) -> String -> IO()
pushButton (disp,var) b
  | b=="AC" = do
      varSet var initState
      dispNum disp initState
  | any (==b) ["0","1","2","3","4","5","6","7","8","9"] =
      upd $ pushNum $ read b
  | any (==b) ["+","-","*","/"] = upd (pushOpr b)
  | b=="="   = upd pushEqual
  | b=="+/-" = upd pushMinus
  where
    upd f = do
      dat <- varGet var
      let new = f dat
      varSet var new
      dispNum disp new

 -- 数字の表示
dispNum :: TextCtrl a -> CalcState -> IO ()
dispNum disp (n,Nothing,_) = set disp [text := show n]
dispNum disp (_,Just n ,_) = set disp [text := show n]

 -- 各々の処理
pushNum :: Integer -> CalcState -> CalcState
pushNum d (n,Nothing,o) = (n,Just d,o)
pushNum d (m,Just  n,o) = (m,Just (n*10+d),o)

pushOpr :: String -> CalcState -> CalcState
pushOpr o (n,Nothing,     _) = (n,Nothing,Just o)
pushOpr o (m,Just n,Nothing) = (n,Nothing,Just o)
pushOpr o (m,Just n,Just  s) = (exec s m n,Nothing,Just o)

pushEqual :: CalcState -> CalcState
pushEqual (m,Nothing,     _) = (m,Nothing,Nothing)
pushEqual (m,Just n,Nothing) = (n,Nothing,Nothing)
pushEqual (m,Just n,Just  o) = (exec o m n,Nothing,Nothing)

pushMinus :: CalcState -> CalcState
pushMinus (m,Nothing,o) = (-m,Nothing,o)
pushMinus (m,Just  n,o) = (m,Just (-n),o)

exec opr m n = op m n where
  op = case opr of
         "+" -> (+)
         "-" -> (-)
         "*" -> (*)
         "/" -> div

ええと…ここに張るには長すぎだったかも。


一応ソースWindowsバイナリ。(↑と同じもんだけど)

http://fxp.hp.infoseek.co.jp/haskell/calc.zip


スクリーンショット


割と普通である。

Windows電卓を参考にしたけど、結局面影なし。

機能も整数の演算のみ。小数点ボタンがあるけど、

押すとおちるので押さないように。


プログラムについて。

mainFrameがウインドウの構築を行う。

ここはまぁ、なんというか普通。

IOモナドでどろどろと作ってます。


イベントハンドラだが、

どうやって状態の更新を行っているかというと、

  var <- varCreate initState

varCreateというのは a -> IORef a の型を持つ関数で、IORefは

varGet :: IORef a -> IO a
varSet :: IORef a -> a -> IO ()

などの操作が行える、要するにポインタのようなものだと思えば。

これをみんなで共有して状態を読み書きしている。


作ってて思ったけど、これHaskell?

てか、こんなソース書いててHaskell使う意味有るのん?

ほとんどコマンドの羅列やないの?

(いや、wxHaskellのサンプルで使われてるんだって)


それでも何とか最終的な計算部分だけは関数的になるように頑張って見た。

しかし、もっと何というか関数的に宣言的に記述したいのである。

コマンドの羅列で作ってると、これは手続き言語か、と思えてくる。

とくにIORefなど使う羽目になるとは…

まぁ、もうちょっと頑張ってみますか…

致命的に駄目っぽい 致命的に駄目っぽいを含むブックマーク 致命的に駄目っぽいのブックマークコメント

ああ、忘れてた。

GHCって日本語が通らないようなのだが、これは正直厳しい。

何とかならないものか。

2004年07月09日(金) Haskellは一日にして成らず 〜関数型プログラミングのGUI事情〜

[]wxHaskell wxHaskellを含むブックマーク wxHaskellのブックマークコメント

Haskellは良い言語だと思うのだが、

世間での認識を数学者のおもちゃレベルから汎用実用的言語へと改めるには

やはりHaskellゲームをばりばり書くとかの必要があるだろう(ほんまかいな?)


というわけでGUIである。

Windowが出せないと最近では馬鹿にされるてしまうのである。

HaskellGUIとなると、とりあえず有名どころ(?)のwxHaskellを見てみることにする。


まず、躓くのがドキュメント。

日本語など望むべくも無いので、公式ページをちまちまと解読。

英語読むのすごく嫌なんですけど。


その結果できたのがこれ。

module Main where
import Graphics.UI.WX

main = start mainFrame

mainFrame = do
  f <- frameFixed [text := "Hello World"]
  p <- panel f []
  set f [layout := minsize (sz 300 300) $ widget p]

ええと、quick startから切り貼りしただけですが…


以下、全部推測。

startがメッセージループ起動なのか?

startの型はIO() -> IO()。IO()だけではほとんど何も言及できてないのでは…

とりあえず、何も考えずに

main = start $ putStrLn "Hell World!!"

とかやってみる。

型が正しいので当然コンパイルは通る。

実行結果であるが、コンソールには何も表示されない。

(これ、嘘かも。Eclipseのコンソールには表示されなかったけど

普通にコンソールから実行したら表示された)

もちろんウインドウも表示されない。

つつがなく制御不能になったのでとりあえず殺す。

結局このことからはstartが何をやっているのかはよく分からなかった。

やはりメッセージループなのか。

メッセージループに入る前に指定されたコマンドを実行?


で、とりあえず最初に張ったソースをコンパイル。

私はEclipseHaskellプラグイン使ってるので保存したら即時で

コンパイルが開始されるのだが、


ごりごりごりごりごりごりごり…


なんかコンパイルが異様に長いんですけど。

300*300のウインドウ表示するだけのプログラムなんですが…

で、しばらくしてできたバイナリのサイズが7.4MB。

ええっ?300*300のウインドウ表示するだけのプログラムが7.4MB!?


もうこの時点でやる気半分カットな訳ですが。

ライブラリ全部リンクですか。気を取り直して実行してみる。

ウインドウはちゃんと表示されるのだが、

なんか起動直後にチラッと大きなウインドウが表示されるような。

これは見栄えが良くない。

ウインドウが出来上がるまでは不可視にしておく必要が有りそうな。


なんというか、今のところ問題が山積みである。

最初のはともかく(?)何とかしないとC#とかに馬鹿にされそうだ。

tokuhiromtokuhirom 2004/07/10 07:54 Haskell で創られたゲームでしたらこんなのもありますよ。GUI じゃないですけど。 http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh/Hetris/

tanakhtanakh 2004/07/10 16:46 おお、コメントありがとうございます。私も以前コンソールでテトリス作ろうと思ったことあるんですが、リアルタイムのキー入力とかが分からなくて頓挫してました。参考にさせてもらいます。

2004年07月08日(木) 続コンパイラ…

[]コンパイラ コンパイラを含むブックマーク コンパイラのブックマークコメント

コンパイラのソースが理解不能になっていたのですが…

どうも、型周りの設計をミスって放置されていたらしい。

しかも、ちゃんと動いてたときのソース残してなかったから

とりあえず明日のために復元作業をするはめに…

というか、復元作業中…非常に悲しい。

トラックバック - http://d.hatena.ne.jp/tanakh/20040708

2004年07月07日(水) 小休止

[]Visual Studio .net theSpoke Premium Version 2003 Visual Studio .net theSpoke Premium Version 2003を含むブックマーク Visual Studio .net theSpoke Premium Version 2003のブックマークコメント

買ってしまった。生協で4180円也。

しかし安くしたもんだな。

最初のバージョンも(今は2002と呼ばれるのか?)買ったけど、

そのときは買って間もなく2003が出て憤怒したものである。

しかもアカデミック版だけ無償アップグレードが無いと来たもんだ。

まぁ、今回のこれで許しといたる。

とりあえず2003今まで買わなくて良かった良かった。

どうでも良いが初回限定で「できるプログラミング」という本が入っていたのだが、

客層としてこのレベルの開発者を取り込むことを目的としているのか?

[]コンパイラ コンパイラを含むブックマーク コンパイラのブックマークコメント

今までICPCの練習ばっかりやってたせいでコンパイラの課題の

発表日が迫っていることを忘れていた。

要求されるレベルのコンパイラはもう即効で完成させて、

以降ちょっとだけ拡張して今までほったらかしだったのであるが、

自称西日本一のプログラマとしてはこんなものを発表する

訳にはいかないのである。(とか何とか言うてみる)

まぁ、後二日有るし大丈夫やろ。

ああ、Haskell勉強が進まない。

[][]問題A再び 問題A再びを含むブックマーク 問題A再びのブックマークコメント

コンパイラ作るつもりがなぜか問題Aの改良を…

Scheme的にはCPSだけど、Haskell的には関数合成だでよ!!

ということで、再実装。

入れ替えを関数にして、それを合成して、それに0を適用。

ついでに入力のパーズをちょっとだけ手直し。

全体的に幾分かすっきりしたのではなかろうか。

main = getContents >>= mapM_ (print.solve) . slice . map (map read . words) . lines where
  slice ([0,0]:_ ) = []
  slice ([n,r]:xs) = (n,take r xs):(slice $ drop r xs)

solve (n,ls) = n - foldr (.) id (map f ls) 0 where
  f [p,c] i = if i<=c then i+p-1 else if i<p+c then i-c else i

ときに、↑のソースとか、変なタグが混じるんだけど、これ

どうにかならんのでしょうか?

追記:どうでもいいが、何で上のソース、ガード部使ってないんだ…?

Cソースから難も考えないで写したのがばればれ…

main = getContents >>= mapM_ (print.solve) . slice . map (map read . words) . lines where
  slice ([0,0]:_ ) = []
  slice ([n,r]:xs) = (n,take r xs):(slice $ drop r xs)

solve (n,ls) = n - foldr (.) id (map f ls) 0 where
  f [p,c] i | i <= c    = i+p-1
            | i <  p+c  = i-c
            | otherwise = i
トラックバック - http://d.hatena.ne.jp/tanakh/20040707

2004年07月06日(火) ストーリームIO

[]数当てゲーム in Haskell 数当てゲーム in Haskellを含むブックマーク 数当てゲーム in Haskellのブックマークコメント

純粋関数言語を使う上でもっとも問題となるのはやはりIOだろう。

現在用いられている方法はおおよそ3つある。

  • ストリーム
  • モナド
  • 一意性型付け

Haskellは主にモナドを使うわけであるが、

入出力が文字列に限定される場合はinteract*1

簡単にモナド→ストリームの変換ができる。

そこで、コンソールアプリ習作の大定番、

数当てゲームHaskellで実装してみた。

(実装してみたというか、ちょっと前に作ったネタだけど)

ストリームIOである。

見てもらえば分かると思うが、むちゃくちゃ簡潔。

数当てゲームというものが見事に"記述"できている

のが分かると思う。

今まで触った言語の中でもきわめて短い部類にはいるのではなかろうか。

module Main(main) where
import Random

main = do ans <- randomRIO (1,100)
          interact $ unlines.game ans.map read.words

game :: Int -> [Int] -> [String]
game ans ls = "Please Input Number. (1-100)":gen ls where
  gen (x:xs) | x == ans = ["Collect Answer!"]
             | x  > ans = "Answer is smaller.":gen xs
             | x  < ans = "Answer is bigger." :gen xs

gameという関数が数当てゲームを記述している。

解答と入力される数字の列を引数にとって、

しかるべきリアクションのリストを返す。

入力が準備され次第構築され、

出力はそれに応じて生成される。

上記のようなソースできちんとインタラクティブな

プログラムになるのである。

これは驚くべきことではないだろうか?

*1: (String -> String) -> IO() の型を持つ関数。渡された関数に標準入力から取ってきた文字列を渡し、その結果を標準出力に出すようなコマンドを作る

トラックバック - http://d.hatena.ne.jp/tanakh/20040706

2004年07月05日(月) ACM/ICPC 2004 国内予選

[]参加しました 参加しましたを含むブックマーク 参加しましたのブックマークコメント

とりあえず予選は通過したけど、Gokuri-Squeezeの強さに唖然。

Squeezeになっても力は健在だと。

3時間(実際には3時間15分)で6問だなんて、

コーディング速度とアルゴリズム考える力、どちらも強くないと

できることではない。

こんなことばかり書いていても仕方ないので、

反省と解答作りました。

http://fxp.hp.infoseek.co.jp/icpc2004/domest.html

まぁ、参考になれば。

[][]問題A in CPS 問題A in CPSを含むブックマーク 問題A in CPSのブックマークコメント

問題Aはもともと簡単な問題だけど、

CPSでもっと簡単に解けるようである。

つまり、各シャッフルを置換と考えるわけですね。

とりあえずHaskellで。

solve n ls = n - (foldr inner id ls 0) where
  inner (p,c) f i = f $ if i<=c then i+p-1 else if i<p+c then i-c else i 

solve 10 [(1,10),(10,1),(8,3)] => 4

入出力つき。

main = getContents >>= mapM_ (print.solve) . slice . map read . words where
  slice (0:0:_) = []
  slice (n:r:xs) = (n,take r $ map (take 2) $ iterate (drop 2) xs):
                   (slice $ drop (r*2) xs)

solve (n,ls) = n - (foldr inner id ls 0) where
  inner [p,c] f i = f $ if i<=c then i+p-1 else if i<p+c then i-c else i 

ついでに芋っぽい解答。

main = getContents >>= mapM_ (print.solve) . slice . map read . words where
  slice (0:0:_) = []
  slice (n:r:xs) = (n,take r $ map (take 2) $ iterate (drop 2) xs):
                   (slice $ drop (r*2) xs)

solve (n,cut) = head $ foldl proc [n,n-1..1] cut where
  proc ls [p,c] = (take c $ drop (p-1) ls) ++ (take (p-1) ls) ++ (drop (p-1+c) ls)

あんまり長さ変わらないけど。

トラックバック - http://d.hatena.ne.jp/tanakh/20040705

2004年07月04日(日) テスト このエントリーを含むブックマーク このエントリーのブックマークコメント

テスト

これから適当になんか書きます。

トラックバック - http://d.hatena.ne.jp/tanakh/20040704
Connection: close