hugs98
『人間に勝つコンピューター将棋の作り方』(技術評論社)なんて本を読んでみた。 大人向けの囲碁・将棋欄にあった唯一興味を引く本だったから。図書分類記号では、ちゃんと 分類番号796ってのを与えられている割には、この手の本がやけに少ないな。小供向けの コーナーの方が多数あったぞ。
それはさておき、技評が出してるのに驚いた。そして表紙でまた驚いた。アニメっぽい 女流棋士が描かれているんだもん。
そう、コンピューター将棋が女流棋士と対戦して、初めて勝った事を象徴してるんですかね？ 欧米では早くからチェスを指すプログラムが研究されていたけど、将棋は余り進歩が無かった。 例の取った駒を有効活用するってのが、探索空間を拡げてしまい、どう対応したら良いか 、有効な方法が見出せなかったから。
ルール上ある局面での差し手の数は85手ぐらいあるそうな。その局面を130回ぐらい展開 して、ひと勝負つくとの事。すると、８５の１３０乗という手が将棋にはある訳だ。 途方もない数ですよ。
自分がこう指したら、相手はこう指すだろう。その局面で自分はこう指す、、、、と相手は こう指す（かも知れない）って、深読みをせにゃ、人間には勝てん。コンピュータは馬鹿だ から言われた事しか出来ない。直感とか無いからね。
そこで、色々な人が、それぞれの考えで将棋を指すプログラムを作った。有名な所では、 Bonanzaとか激指とかYSSとかGPS将棋とかが有る。
人間に勝つには、それぞれのプログラムが協力したら、いいんでないかい。でも、それぞれには 主義主張が有るんでなぁ。ならば多数決でどうだ。
そんな方法でもいいから、取り合えず協力してやんべぇって、大学の先生方は考えた。 あから2010ってのがそれ。コンピュータ強調（協調）将棋。で、先生方がガウンを まとって、将棋連盟に果たし状を出しに行った。
それを受けて、将棋連盟の親分は、『いい度胸をしているとその不遜な態度に感服仕っ次第』 と受けて、対戦が決定。
大学の先生方には、将棋道場が有った。いや、作ったんだ。 コンピュータ将棋連続対局場所 これで、密かに自分のプログラムの腕を磨いていたのさ。
後、数年もすれば、コンピュータが人間を越える日がやってくるだろう。人口知能の勝利。 次なる手は、接待将棋の開発とか。
コンピュータが連戦したんじゃ、人間は気分が悪くなる。かと言って、コンピュータが あからさまに悪手を指して、人間に勝ちを譲ったんでは、これまた人間の気分を害する。
上手によいしょするプログラムを作りましょ。これ難しいーーーーぞ。頑張って！！
life
前回、ひょんな事からLifeゲームを思い出した。入れて楽しんでもいいんだけど、どうせ すぐ飽きる。簡易コードが無いかしらと思ってしばしば熟考。。思い出した。 プログラミングHaskellにコードが載っていた事を。
早速、hugsを入れたぞ。そして実行はどうやるんだったかな？
[sakae@fedora hugsBook]$ hugs __ __ __ __ ____ ___ _________________________________________ || || || || || || ||__ Hugs 98: Based on the Haskell 98 standard ||___|| ||__|| ||__|| __|| Copyright (c) 1994-2005 ||---|| ___|| World Wide Web: http://haskell.org/hugs || || Bugs: http://hackage.haskell.org/trac/hugs || || Version: September 2006 _________________________________________ Haskell 98 mode: Restart with command line option -98 to enable extensions Type :? for help Hugs> :l life.lhs Main> main ERROR - Undefined variable "main" Main> life glider
これで、しばし観賞。確かrunhugsって即実行系も有ったな。
[sakae@fedora hugsBook]$ runhugs life.lhs runhugs: Error occurred ERROR - Undefined variable "main"
実行系の時は、mainが必要とな。main = life glider を追加してと、、、
[sakae@fedora hugsBook]$ runhugs life.lhs
:
O O
OO
Orunhugs: Error occurred
ERROR - Garbage collection fails to reclaim sufficient space
あれ？ ガベコレが走るなんて、裏Lispですかい？ メモリーを増やしてあげると、御利益が あるかな？ その前に、何世代まで、実行してくれるか表示出来るようにしておこう。 まあ、こういうのHaskellのリハビリになるでしょう。
> showage :: Int -> IO () > showage n = do goto (width + 2, 0) > putStr (show n) > > life :: Board -> Int -> IO () > life b n = do cls > showcells b > showage n > wait 5000 > life (nextgen b) (n + 1) > > main = life glider 0
世代を表示させるshowageを追加。lifeの引数を追加して、世代表示するようにした。 ここで、再帰してるんだな。では、実験。
[sakae@fedora ~]$ runhugs mylife.lhs
47runhugs: Error occurred
ERROR - Garbage collection fails to reclaim sufficient space
ちょっと醜いけど、47世代まで行けた。メモリーを増やすのをmanで調べたよ。
[sakae@fedora ~]$ runhugs +h3m mylife.lhs
146runhugs: Error occurred
ERROR - Garbage collection fails to reclaim sufficient space
初期値は256kらしいから、メモリーをどーんと増やしても、それに見合う御利益は得られないとな。 なお、hugsから起動して、エラーになった所で、強制的にgcすると
48
ERROR - Garbage collection fails to reclaim sufficient space
Main> :gc
ERROR - Garbage collection fails to reclaim sufficient space
Main>
余裕の無い作りになってましたよ。普通にhugsを起動してどのぐらいcellが有るか調べると
Hugs> :gc Garbage collection recovered 986940 cells
あっ、cellて普通の人は細胞と思うみたいですよ。Lisperはすぐにアレを思い出すな。 一体どういう構造になってる？
この先、資料を見るかも知れないので、hugs98のページを揚げておく。 Haskell 98 言語とライブラリ 改訂レポート こちらは入門編
なお、hugs98はその名前から分かるように昔の仕様。とっくに開発は終了してる。それに 変わって新しいHaskellが標準になった。そう、大英帝国はグラスゴー発のGHC。 仕様が安定せず追っかけが必須。haskellの今を知りたいならば、 あどけない話あたりが良いだろう。
そこにソースが有るぞ
で、中身見たーーい。そうなると、fedoraは不適でBSD系（と、勝手に思う）ですな。 ports一発、お取り寄せでコンパイルしてくれる。後はその残骸を漁るだけ。 で、注意しなければいけないのが、付属品をわんさかと要求される事だ。
FreeBSDでやろうとしたら、gccから始めないとだめだった。そなら、OpenBSDでは？ Makefileを覗いたら、そこまでは無かったけど、
WANTLIB = GL GLU X11 c m ncurses pthread readline
こういう物が必要との事。面倒嫌いって事で、NetBSDのそれを調べてみると、readlineだけ 必要との事。よって、NetBSDでやってみる。Makefileに面白い注意書きがあった。
# The default -O2 breaks the interpreter producing strange internal errors # at run time. .if !empty(CC_VERSION:Mgcc-4*) CFLAGS+= -O0 .endif
普通にコンパイルされてhugsが鎮座してくれた。けど、gdbに追うにはdebugオプションが 付いていないので、不適。srcの下にあるMakefileに手を入れる。
CFLAGS = -gdwarf-2 -g3 -O0 -I/usr/include
これで再コンパイルすると、リンク段階でreadlineが無いと言う。はて、先ほどはちゃんと コンパイル出来ていたはずなんだけど。最上位でコンパイルしないと駄目？ もう一度、Makefileを見直し。そしてライブラリィdirを強制指定。
LDFLAGS = -L/usr/lib -L/usr/pkg/lib -Wl,-R/usr/lib -Wl,-R/usr/pkg/lib
これで無事にhugs類が出来上がった。やれやれ。
hugsを追う
hugsのソースは5万行を越えていて、取っ掛かりが無いので、例のごとく、どこら辺で 走っているかスパイしてみる。hugsを起動しておいて、いきなりすれにattachする。 これが対話プログラムを追う時の、上等もとえ常套手段だ。（オイラーが今決めた）
(gdb) bt #0 0xbba2a8b7 in read () from /usr/lib/libc.so.12 #1 0xbbbcad7c in rl_getc () from /usr/pkg/lib/libreadline.so.6 #2 0xbbbcb5df in rl_read_key () from /usr/pkg/lib/libreadline.so.6 #3 0xbbbb5bd1 in readline_internal_char () from /usr/pkg/lib/libreadline.so.6 #4 0xbbbb6284 in readline () from /usr/pkg/lib/libreadline.so.6 #5 0x0806e829 in consoleInput (prompt=0xbfbfe3e4 "Hugs> ") at input.c:272 #6 0x0804b9af in promptForInput (moduleName=0x80f9bfc <text+1020> "Hugs") at hugs.c:937 #7 0x0804ba6a in initInterpreter () at hugs.c:1038 #8 0x0804ba09 in interpreter (argc=1, argv=0xbfbfe84c) at hugs.c:982 #9 0x08049fca in main (argc=1, argv=0xbfbfe84c) at hugs.c:220
先ほどプチ苦労したreadlineはlibcの上に胡坐をかいているのね。その上にいるのは、 フレーム番号5番さん。それらしい名前になってるな。8番さんの下働きとして、7番に、 initInterpreterが居るけど、initって名前がちと気になるな。
1031static Void local initInterpreter()
1032{
1033 everybody(RESET); /* reset to sensible initial state */
1034 dropScriptsFrom(numLoadedScripts()-1);
1035 /* remove partially loaded scripts */
1036 /* not counting prelude as a script*/
1037
1038=> promptForInput(textToStr(module(findEvalModule()).text));
1039}
更にフレームをもう一段上がって、interpreterを見渡してみれば、起動時の初期処理の後
981 for (;;) {
982=> initInterpreter();
983 if (doCommand())
984 break;
985 }
このようなループをぐるぐる回るとな。核は、doCommandだな。これはインタープリタで 受け付ける、コロンコマンドを処理してる（だろうね）。
doCommandでは、入力を解析して、switch文で振り分けているんか。例えば、:? なんて やると、
1091 case NAMES : 1092#if HUGS_FOR_WINDOWS... 1094#endif 1095 listNames(); 1096 break; 1097=> case HELP : menu(); 1098 break; 1099 case BADCMD : guidance(); 1100 break; 1101 case SET : setOptions(); 1102 break;
menu()が実行されるとな。HELPなんてのは、 人間が理解し易いようにそれなりの単語を使っているけど、実態は
(gdb) info macro HELP Defined at /usr/pkgsrc/lang/hugs/work/hugs98-Sep2006/src/command.h:32 included at /usr/pkgsrc/lang/hugs/work/hugs98-Sep2006/src/hugs.c:16 #define HELP 7
こんな風になってるのね。そんじゃ、簡単なスクリプトをロードしてみる。:load t.hs
364static Void local load() { /* read filenames from command line */
365 String s; /* and add to list of scripts waiting */
366 /* to be read */
367 clearEvalModule();
368 while ((s=readFilename())!=0) {
369#if HUGS_FOR_WINDOWS...
371#endif
372=> addScriptName(s,TRUE);
373 }
374 readScripts(1);
375}
いちどに幾つものスクリプトをロード出来るのね。今回は、addScriptNameの引数は、 勿論、指定したt,hsになってた。
addScriptNameの先を追って行くと、scriptTableにファイル名等を登録してた。
$7 = {{
fileName = 0xbb90e040 "/usr/pkg/lib/hugs/packages/hugsbase/Hugs/Prelude.hs",
realName = 0xbb90e080 "/usr/pkg/lib/hugs/packages/hugsbase/Hugs/Prelude.hs",
directory = 0x0,
lastChange = 1444075489,
postponed = 0,
chased = 1
}, {
fileName = 0xbb90f040 "/usr/pkg/lib/hugs/packages/base/Prelude.hs",
realName = 0xbb90f070 "/usr/pkg/lib/hugs/packages/base/Prelude.hs",
directory = 0x0,
lastChange = 1444075492,
postponed = 0,
chased = 1
}, {
fileName = 0xbb90f0d0 "/usr/pkg/lib/hugs/packages/hugsbase/Hugs.hs",
realName = 0xbb90f100 "/usr/pkg/lib/hugs/packages/hugsbase/Hugs.hs",
directory = 0x0,
lastChange = 1444075489,
postponed = 0,
chased = 0
}, {
fileName = 0xbb90d4a0 "t.hs",
realName = 0x0,
directory = 0xbb90c0a4 ".",
lastChange = 0,
postponed = 0,
chased = 0
} <repeats 796 times>}
先頭の３つは、システム備え付けって事で、削除不可になってた。このテーブル配列数から すると、とんでもない数のスクリプトを許容してるんだな。登録が終わった時点で、lastChangeが設定 されてた。:edit で編集すると、これを見て、再ロードするんだな。ロード時に評価 されるのだろうか？ そんな事より、先へ行こう。
いよいよ実行。main ってやると、EVALってラベルの所で、evaluator(findEvalModule()); を 実行しようとする。
取りあえず、evaluatorで待ち構えると、
Breakpoint 2, evaluator (m=2628) at evaluator.c:64 64 Kinds ks = NIL;
謎の番号2628って何だ？ コードを見ると分かるかな？
61Void evaluator(m)
62Module m; { /* evaluate expr and print value */
63 Type type, bd, t;
64=> Kinds ks = NIL;
65 Cell temp = NIL;
66
67 setCurrModule(m);
68 scriptFile = 0;
69 startNewScript(0); /* Enables recovery of storage */
70 /* allocated during evaluation */
71 parseExp();
72 checkExp();
73 defaultDefns = evalDefaults;
74 type = typeCheckExp(TRUE);
75 if (isPolyType(type)) {
76 ks = polySigOf(type);
77 bd = monotypeOf(type);
78 }
:
setCurrModuleは、利便性の為に用意したとな。で、そこの出口では、
(gdb) p/x module(m)
$17 = {
text = 0x123,
tycons = 0xfff0c0a4,
names = 0xfff0c0bb,
classes = 0xfff0c076,
exports = 0xfff0c0bf,
modAliases = 0xfff0bdd7,
qualImports = 0x0,
modImports = 0xfff0c0b0
}
続けて追って行くと、machine.cの中のrunに実行が移る。
Void run(start,root) /* execute code beginning at given */
Addr start; /* address with local stack starting*/
StackPtr root; { /* at given root offset */
register Memory pc = memory+start;
#if !DEBUG_CODE && HAVE_LABELS_AS_VALUES...
#else
#if DEBUG_CODE...
#else
#define Dispatch for (;;) { switch((pc++)->instr) {
#endif
#define Case(x) case x
#define Continue continue
#define EndDispatch default : internal("illegal instruction"); \
break; \
}}
#endif
=> Dispatch
Case(iLOAD) : push(stack(root+pc->mint)); /* load from stack*/
pc++;
Continue;
Case(iCELL) : push(pc->cell); /* load const Cell*/
pc++;
Continue;
独自定義のstackマシンだな。pcがどんな構造かと言うと
(gdb) p pc
$25 = (Memory) 0xbac22494
(gdb) p *$
$26 = {
mint = 1,
mfloat = 1.40129846e-45,
cell = 1,
text = 1,
addr = 1,
instr = iCELL,
lab = 1
}
後は自由気ままにコードの中をさ迷うと、evaluator内で、パースしてコンパイルして、 それをアセンブルするって趣きなんだけど、どんなアセンブリコードになるかと言うと、
static Addr local dissInstr(pc) /* print dissassembly of instruction */
Addr pc; {
switch (instrAt(pc)) {
case iLOAD : pc = dissInt(pc,"LOAD"); break;
case iLEVAL : pc = dissInt(pc,"LEVAL"); break;
case iCELL : pc = dissCell(pc,"CELL"); break;
case iCHAR : pc = dissInt(pc,"CHAR"); break;
case iINT : pc = dissInt(pc,"INT"); break;
case iDOUBLE : pc = dissDouble(pc,"DOUBLE"); break;
case iSTRING : pc = dissText(pc,"STRING"); break;
case iMKAP : pc = dissInt(pc,"MKAP"); break;
case iUPDATE : pc = dissInt(pc,"UPDATE"); break;
case iRUPDATE: pc = dissNone(pc,"RUPDATE"); break;
case iUPDAP : pc = dissInt(pc,"UPDAP"); break;
case iRUPDAP : pc = dissNone(pc,"RUPDAP"); break;
case iEVAL : pc = dissNone(pc,"EVAL"); break;
case iSTAP : pc = dissNone(pc,"STAP"); break;
case iRETURN : pc = dissNone(pc,"RETURN"); break;
case iTEST : pc = dissCellAddr(pc,"TEST"); break;
case iGOTO : pc = dissAddr(pc,"GOTO"); break;
case iSETSTK : pc = dissInt(pc,"SETSTK"); break;
case iALLOC : pc = dissInt(pc,"ALLOC"); break;
case iSLIDE : pc = dissInt(pc,"SLIDE"); break;
case iROOT : pc = dissInt(pc,"ROOT"); break;
case iFAIL : pc = dissNone(pc,"FAIL"); break;
case iTABLE : pc = dissNone(pc,"TABLE");
pc+= intAt(pc)+1;
break;
default : internal("unknown instruction");
}
この辺になると、rubyもPythonもgaucheもJavaも、オレオレCPUの世界だな。きっと、 あの人とかこの人が得意の分野だろう。machine.cを良く見ておけって結論かな。 後は、補助として、DEBUG_CODEをtrueにしとくとICEの代わりになるかな？
Hugs> :set +D Hugs> :load t.hs ------------------ name=main Arity = 0 codeGen = print "Hellow Haskell" name=main 0x8917 STRING Hellow Haskell 0x8919 CELL v16 0x891B CELL v25 0x891D MKAP 1 0x891F CELL print 0x8921 MKAP 2 0x8923 RETURN ------------------
ふむ、hugs版のハロワは、上記のようなコードになるとな。で、それを実行すると、
Main> main ------------------ Arity = 0 codeGen = hugsIORun main 0x8925 CELL main 0x8927 CELL hugsIORun 0x8929 MKAP 1 0x892B RETURN ------------------
main :: IO () が効いて、外界表示用の特殊機能マシンを作って、そいつにmainを喰わせる って寸法かな。続いて、だらだらと、実行過程が表示される。
evaluator() builds: hugsIORun main
Entering name(73): hugsIORun
0x2D01: LOAD 1
0x2D03: CELL v1097
0x2D05: MKAP 1
0x2D07: CELL basicIORun
0x2D09: MKAP 1
0x2D0B: CELL v1098
0x2D0D: RUPDAP
Leaving name(73): hugsIORun
Entering name(889): v1098
0x2CEE: LEVAL 1
Entering name(598): basicIORun
:
Entering name(579): putChar
0x28EC: CELL stdout
0x28EE: CELL hPutChar
0x28F0: MKAP 1
0x28F2: RETURN
Leaving name(579): putChar
:
Entering name(77): Finished_Return
0x2CF0: TEST Finished_ExitWith 0x2CF8
0x2CF8: TEST Finished_Return 0x0000
0x2CFB: LOAD 2
0x2CFD: CELL Right
0x2CFF: RUPDAP
Leaving name(889): v1098
Entering name(149): Right
Main>
この長いtraceを解析すれば、何が起こっているか分かるな。
そんじゃ、もう一例。与えられた整数をインクリメントする関数を定義して実行。
Main> incN 123 ------------------ Arity = 0 codeGen = hugsIORun (putStr (showsPrec 0 (incN 123) [])) 0x8937 CELL [] 0x8939 INT 123 0x893B CELL v32 0x893D CELL fromInt 0x893F MKAP 2 0x8941 CELL v32 0x8943 CELL incN 0x8945 MKAP 2 0x8947 INT 0 0x8949 CELL v44 0x894B CELL showsPrec 0x894D MKAP 4 0x894F CELL putStr 0x8951 MKAP 1 0x8953 CELL hugsIORun 0x8955 MKAP 1 0x8957 RETURN ------------------
ほー、結果の表示の為、適切なコードが挿入されるとな。実際のincNは
Entering name(1180): incN
0x8917: INT 1
0x8919: LOAD 2
0x891B: CELL fromInt
0x891D: MKAP 2
0x891F: LOAD 1
0x8921: LOAD 2
0x8923: CELL +
0x8925: MKAP 2
0x8927: RUPDAP
Leaving name(1180): incN
上記で定義したincNはジェネリック型だったけど、Intを受けてIntを返すように宣言すると
Entering name(1180): incN
0x8917: INT 1
0x8919: CELL v30
0x891B: CELL fromInt
0x891D: MKAP 2
0x891F: LOAD 1
0x8921: CELL v30
0x8923: CELL +
0x8925: MKAP 2
0x8927: RUPDAP
Leaving name(1180): incN
出て来るコードが微妙に違うな。ここまではgaucheみたいな言語でも普通にやっている事。 HaskellをHaskellたらしめている型チェックはどうしてるんだろうか？
こういうのを調べるのの鉄則は、エラーを起して状態を観察すれば良い。例えばこんなの。
-- test for hugs -- incN :: Int -> Int incN n = n + 1.0
整数と浮動小数点の演算を混ぜこぜにした。hugsからロードしてみると
ERROR "t.hs":3 - Instance of Fractional Int required for definition of incN
期待通り？ エラー発生。後は、このエラーを出してる所をソースからgrep。但し、Intとか の字句は埋め込みの可能性があるので、何度か字句の組み合わせを変えて試すと良い。 こういう時は、取替え可能な字句がどれか、根幹の字句はどれかが分かれば、手っ取り早い。 おいらは、英語力低下の為、何度かTryしたよ。
そして見つかったのは、
2874static Void local typeDefnGroup(bs) /* type check group of value defns */
2875List bs; { /* (one top level scc) */
2876 List as;
2877
2878=> emptySubstitution();
2879 hd(defnBounds) = NIL;
2880 preds = NIL;
2881 setTypeIns(bs);
2882 typeBindings(bs); /* find types for vars in bindings */
2883
2884 if (nonNull(preds)) {
2885 Cell v = fst(hd(hd(varsBounds)));
2886 Name n = findName(textOf(v));
2887 Int l = nonNull(n) ? name(n).line : 0;
2888 preds = scSimplify(preds);
2889 ERRMSG(l) "Instance%s of ", (length(preds)==1 ? "" : "s") ETHEN
2890 ERRCONTEXT(copyPreds(preds));
2891 ERRTEXT " required for definition of " ETHEN
2892 ERREXPR(nonNull(n)?n:v);
2893 ERRTEXT "\n"
2894 EEND;
2895 }
後は、この関数にBPを置いて走らせる、簡単なお仕事です。
(gdb) bt #0 typeDefnGroup (bs=-141275) at type.c:2878 #1 0x080c08e1 in typeCheckDefns () at type.c:2853 #2 0x0808912f in addScript (fname=0xbb90d4b0 "t.hs", len=103) at script.c:203 #3 0x08089793 in readScripts (n=800) at script.c:360 #4 0x0804a2d6 in load () at hugs.c:374 #5 0x0804bac8 in doCommand () at hugs.c:1058 #6 0x0804ba0e in interpreter (argc=1, argv=0xbfbfed68) at hugs.c:983 #7 0x08049fca in main (argc=1, argv=0xbfbfed68) at hugs.c:220
それにしても、ここから先、意味を理解しながら追って行くのは大変だぞ。
etc
季節柄、 詰碁を解く Haskell プログラム なんてのが見つかって、嬉しいな。
それにしてもNet上にある詰め碁のサイトは、揃いも揃って、フラッシュを要求して くるなあ。代替品で賄っている所は無いのか。プンプン。