AM-Scheme(2)

前回見つけた継続渡し形式(CPS)のページを 辿ってみたら、Windows Script Host で、javascriptの真似事が出来る事を知った。 javascriptだと、println と書く所を

WScript.Echo("hello, world.");

の様に書かなければならない事を我慢すれば、javascriptと同様な事が出来るみたいだ。javascritのインタープリタの変わりに CScript /NoLogo hello.js とすれば、ターミナルに、hello, word. と、出てくるはずなんだが やってみたら、"js を持つスクリプトエンジンはありません。" という、意味不明な事を言ってきた。

これだから困るんだよな。Windows 7 もいいけど、その前にやる事あるだろうに! こういう場合は 冴子先生とか、ワトソン博士はあてにならないので、google先生頼り。

聞いてみたら、ファイル拡張子”.js”のスクリプトエンジンについての質問 なんてのが、出てきた。修正方法は、えーーーー、regedit.exe を使えと。仰せの通りに 調べてみたら、私のは、何も設定して無かった。壊れてこうなったのか、セキュリティー上の 理由で削除されたのかは、不明だ。 ちょいと、設定してあげたら、ちゃんと認識出来るようになった。やれやれ!

やれやれとため息をついていたら、Real World Haskellを 献本頂いた。本だけなく、かぶと虫のバッチ付き。RWH読書会のご縁で、頂いたものだ。 (ちゃんと勉強しろって励ましに、感謝致します。ありがとうございました。)

帯には、 "Haskellで書ける幸せ" なんて言うキャッチコピーが踊っている。自分には、ParsecとかQuickCheckが 一番嬉しいかな。また、Haskellで書いて幸せになろう。

AM-Schemeで、S式の読み込み

前回の続きです。前回は、Schemeが起動して、プロンプトが出てくるまでの流れを、気ままに 見てきた。その中で、すっとばしてしまった、初期ファイル(amscm.scm)の読み込みを追って みる事にする。

LoadFromFileName の中で 指定されたファイルをオープンし、mk_inputにファイルディスクリプタを 渡して、schemeが扱う構造を作る。そして、そのオブジェクトを引数にして、Rep_From_Inputを 呼び出す。

このRep_From_Inputは、いわゆる REPL(read eval print loop)だ。

 139     g_push(&l)
 140     for(;;) {
 141         tok = get_token(l);
 142         Is_read_complete = 0;
 143         Read_Cycle(tok);
 144         Is_need_prompt = 0;
 145         if (Is_read_complete) {
 146             Init_read_stack()
 147             Is_need_prompt = 1;
 148             if (r_value == eof_object) {
 149                 g_pop(1)
 150                 break;
 151             }
 152             read_white(l);
 153             s_save(OP_EVALEND, code)
 154             code = r_value;
 155             r_value = Eval_Cycle(OP_EVAL);
 156             if (IsVerbose) {
 157                 printlist(r_value, std_output, 1, 1);
 158                 PrintChar(std_output, '\n');
 159             }
 160         }
 161     }
 162     return 1;

一つ トークンを読み込み、それを引数にして、それぞれのトークン毎の処理ををRead_Cycyleで行う。 読み込みが終了すると、読み込んだオブジェクトがeofか確認の後、スタックに評価終了TAGを積んで から、Eval_Cycleで評価を実行。結果を出力する必要がなるなら、printlistを呼んで表示させる。

オブジェクトが、eofだった場合は、LoadFromFileName内に復帰して、ファイルのクローズ処理等を 行う。

上の大まかな流れは、gdbを使って追いかけてみたんだけど、143行目で tok の値を確認しようと したら、そんなのここでは見られません(意訳)と言われてしまった。全く役立たずのgdbだ事!、 と、最初は思っていたんだけど、はっと、頭にひらめきが走りましたよ。 賢いコンパイラが最適化しちゃってるに違い無いと。 Makefile に記述してあった、最適化指定を、-O0 (オー、ゼロ)に変更してから、再コンパイル したら、ちゃんと見られるようになりました。これって、gdbを使う時の鉄則ですね。

そんじゃ、Read_Cycleを見て行くけど、肝になるのは、上のリストの142行目に出てくる Is_read_completeと言うフラグ。Read_Cycleの中で、解析した結果、Eval_Cycleして良い状態に なったら、このフラグを1にしている。(ようするに、S式を一つ読み込んだ状態) また、Read_CycleとEval_Cycleとの値の受け渡しには、グローバル変数の r_valueが使われている。

 223     switch (tok) {
 224     case TOK_LPAREN:
 225         s_push(NULL)
 226         r_push(OP_RDLST)
 227         return;
 228     case TOK_RPAREN:
 229         switch (r_pop()) {
 230         case OP_RDLST:
 231             r_value = get_list_from_stack(NIL);
 232             break;
 233         case OP_RDDOT:
 234             if (r_pop() != OP_RDLST)
 235                 Error("reader -- Illegal dot expression");
 236             r_value = get_list_from_stack(r_value);
 237             break;
 238         case OP_RDVEC:
 239             r_value = get_vector_from_stack();
 240             break;
 241         default:
 242             Error("reader -- Illegal ')'");
 243         }
 244         break;
 245     case TOK_DOT:
  :
 273     case TOK_EOF:
 274         if (r_pop() != OP_RDEND)
 275             Error("reader -- Illegal EOF");
 276         else {
 277             Is_read_complete = 1;
 278             r_value = eof_object;
 279             return;
 280         }
 281         break;
 282     default:
 283         Error("reader -- Illegal token %d", tok);
 284     }
 285 
 286 AGAIN:    
 287     switch (r_pop()) {
 288     case OP_RDLST:
 289         s_push(r_value)
 290         r_push(OP_RDLST)
 291         return;
  :
 311     case OP_RDEND:
 312         Is_read_complete = 1;
 313         return;
 314     default:
 315         Error("reader -- Illegal read operator");
 316     }

最初は、渡されてきたtokによって、処理を場合分けしてる。左括弧の場合は、こりゃリストが 始まりましたよというTAGをread_stackへプッシュして、このルーチンを抜ける。 右括弧の場合は、get_list_from_stack()を使って、スタックをポップしつつ、リストを構築。 その後、AGAIN:とラベルされた所で、更に後処理を行っている。

ちと実例をば

[sakae@nil ~/v110/src]$ cat z.scm
(define xyz 12345678)
xyz

こんなファイルを、REPL から、loadを使って読み込んでみます。数字の扱いをどうしてるかを 中心に見ます。

Breakpoint 2, LoadFromFileName (name=0x28216fb0 "z.scm", IsVerbose=1, IsInit=0)
    at generic_os.c:111
111         if ((fp = fopen(name, "r")) == NULL) {
(gdb) b Read_Cycle
Breakpoint 3 at 0x8056b06: file read.c, line 223.
(gdb) p name
$1 = 0x28216fb0 "z.scm"
(gdb) c
Continuing.
;loading z.scm

Breakpoint 3, Read_Cycle (tok=1) at read.c:223
223         switch (tok) {
(gdb) p tok
$2 = 1

左括弧ですね。続けて行きます。

(gdb) c
Continuing.

Breakpoint 3, Read_Cycle (tok=5) at read.c:223
223         switch (tok) {
(gdb) p tok
$3 = 5

ATOMって事ですから、"define"でしょう。どうなるか、一応見ておきます。

(gdb) n
265             r_value = mk_atom(&strbuff[0]);
(gdb) p strbuff
$4 = 0x8059ea0 "define"
(gdb) n
266             break;
(gdb) n
287         switch (r_pop()) {
(gdb) n
289             s_push(r_value)
(gdb) n
290             r_push(OP_RDLST)
(gdb) n
291             return;

"define"と言うATOMを作って(既にありますので、この時点で新規に作る事は無く、オブジェクトの 場所が、返されますが)、それを、schemeのスタックに入れてます。この時点では、まだ リスト中なので、read_stackには、リストでっせ情報を再度Pushしてから、抜けます。

(gdb) n
265             r_value = mk_atom(&strbuff[0]);
(gdb) p strbuff
$7 = 0x8059ea0 "12345678"
(gdb) s
mk_atom (q=0x8059ea0 "12345678") at mk.c:306
306         switch (numtype(q, 10)) {

ちょっと先へ進めました。丁度数字を登録しようとしています。numtypeでは、realかintかそれ 以外かを判定してます。今回は、intと判定してくれました。(この判定ルーチンがちと、やや こしいです。何故って、schemeの場合、123xyz なんてのも、いわゆる変数名として許されていますから。 それに、小数点がからんできたりするから、面倒です。)

mk_atom (q=0x8059ea0 "12345678") at mk.c:310
310             return (mki_f_string(q, (long)strlen(q), 10));
(gdb)
mki_f_string (num=0x8059ea0 "12345678", len=8, base=10) at mk.c:49
(gdb)
55          size = get_formal_size_of_int(len, base);
(gdb) n
56          x = (pointer)Get_Heap(INTEGERSIZE(size));
(gdb) p size
$8 = 2

get_formal_size_of_intを使って、与えられた長さの数字列を、10000進法で表したら、何桁に なるか求めています。なお、これは多倍長整数を扱うためです。(INTEGERSIZEは、10000と定義されてます) その後、Short_MuitiとShort_Addを使って、データを格納しています。時間があったら、じっくりと 多倍長ルーチンを見てみたいな。(int.cは、独立性が高いから、ここだけ印刷して、見るのも可)

このルーチンを抜け、Read_Cycleに戻ってくると、オブジェトとして T_INTEGERが格納されてました。

(gdb) c
Continuing.

Breakpoint 3, Read_Cycle (tok=2) at read.c:223
223         switch (tok) {
(gdb) p tok
$10 = 2
(gdb) n
229             switch (r_pop()) {
(gdb)
231                 r_value = get_list_from_stack(NIL);
(gdb)
232                 break;
(gdb)
287         switch (r_pop()) {
(gdb)
312             Is_read_complete = 1;
(gdb)
313             return;

最後に、トークンは右括弧が来て、これでS式を一つ読み込んだと言う事になります。 後は、このr_valueをcodeに代入して、評価が始まります。

最初のS式は、defineでしたから、12345678をxyzに束縛(代入のようなもの)されます。 次は、ただ xyz としか書かれていませんから、xyzという名前(シンボル)を参照する S式になります。これを評価すると、12345678 が、得られます。

ちと改造

AM-Schemeには、samplesとして、tools.scm というのがついている。内容を見ると、trace や清書機能 lisp-editorという、有用なものが入っていた。amscmの起動時に、コマンド引数から与えるとか、 起動した後に、replからloadコマンドを使って読み込んでもいいけど、ちとめんどい。 折角ソースがあるので、改造して、起動時に読み込んじゃえ。

[sakae@nil ~/v110/src]$ diff -u generic_os.c.org generic_os.c
--- generic_os.c.org    2009-10-21 05:48:37.000000000 +0900
+++ generic_os.c        2009-10-30 13:57:02.000000000 +0900
@@ -189,6 +189,7 @@
     else if (setjmp(reset_jmp) == 0) {
         /* changed by A.Kida */
         LoadFromFileName(InitFileName, 0, 1);
+        LoadFromFileName("./tools.scm", 0, 1);
         /* A detection of any error in a file which is specified as a
          * command line parameter aborts loading and ignores the files
          * rest (if any). In such a case, AM-Scheme will begin read /

Cのソースに即値を書いちゃうのって、野良改造って言うんでしょうか?

[sakae@nil ~/v110/src]$ ./amscm
Hello, This is AM-Scheme Interpreter Version 1.10
allocated 2*300000 bytes main memory areas
allocated 4*10000 bytes stack areas
;loading ./amscm.scm
;loading ./tools.scm
> (define (f n)
    (if (= n 0)
       1
       (* n (f (- n 1)))))
f
> (trace f)
(f)
> (f 4)
(f 4)
  (f 3)
    (f 2)
      (f 1)
        (f 0)
        (f 0) ==> 1
      (f 1) ==> 1
    (f 2) ==> 2
  (f 3) ==> 6
(f 4) ==> 24
24

続いて、lisp-editorを試してみる。

> (ed f)
a,d,l,p,r,i,x,c,v,e,b,u,?,! (top): ?
 ----- list editor command ----
 a -- Change current sublist to CAR
 d -- Change current sublist to CDR
 l -- Print outline of current sublist
 p -- Pretty print current sublist
 r -- Replace current sublist to one typed follow
 i -- Insert one typed follow to CAR
 x -- Delete CAR of current sublist
 c -- Copy current buffer to CAR
 v -- Yank current sublist to buffer
 e -- Edit buffer
 b -- Show buffer
 u -- Exit current sublist (up one level)
 ! -- Exit to toplevel
a,d,l,p,r,i,x,c,v,e,b,u,?,! (top): p
(define (f n) (if (= n 0) 1 (* n (f (- n 1)))))
a,d,l,p,r,i,x,c,v,e,b,u,?,! (top): d d l
a,d,l,p,r,i,x,c,v,e,b,u,?,! (1): a,d,l,p,r,i,x,c,v,e,b,u,?,! (2): ((if (= n 0) 1 &))
a,d,l,p,r,i,x,c,v,e,b,u,?,! (2): a l
a,d,l,p,r,i,x,c,v,e,b,u,?,! (3): (if (= n 0) 1 &)
a,d,l,p,r,i,x,c,v,e,b,u,?,! (3): d d l
a,d,l,p,r,i,x,c,v,e,b,u,?,! (4): a,d,l,p,r,i,x,c,v,e,b,u,?,! (5): (1 (* n (f (- & &))))
a,d,l,p,r,i,x,c,v,e,b,u,?,! (5): d l
a,d,l,p,r,i,x,c,v,e,b,u,?,! (6): ((* n (f (- n &))))
a,d,l,p,r,i,x,c,v,e,b,u,?,! (6): a l
a,d,l,p,r,i,x,c,v,e,b,u,?,! (7): (* n (f (- n &)))
a,d,l,p,r,i,x,c,v,e,b,u,?,! (7): a
a,d,l,p,r,i,x,c,v,e,b,u,?,! (8): l
*
a,d,l,p,r,i,x,c,v,e,b,u,?,! (8): r +
? a,d,l,p,r,i,x,c,v,e,b,u,?,! (8): l
+
a,d,l,p,r,i,x,c,v,e,b,u,?,! (8): !
a,d,l,p,r,i,x,c,v,e,b,u,?,! (top): p
(define (f n) (if (= n 0) 1 (+ n (f (- n 1)))))
a,d,l,p,r,i,x,c,v,e,b,u,?,! (top): u
A)bandan, E)valuate, C)ontinue : e
f
> (f 4)
11
> f
#<CLOSURE>

S式の移動って面倒だなあ。今居る所を確認しながら移動してかないと、思わぬ所へ行っちゃう よ。a とか d で移動した後 自動で、l をやって欲しいぞ。 まるで、昔々の ed を使ってるみたいだ。(って、あんたは、どんだけ古い人なんよ。)