F# の Active Pattern （で FizzBuzz）

F# にはアクティブパターン (active pattern) という機能があって以前ここで書いた [1] Scala の extractor のようなことができるようになっています。リリースは Scala よりも後ですが、もともと F# 開発者の Don Syme さんのアイデアに Scala 開発者の Martin Odersky さんが多大な興味を示し、それぞれの現われが active pattern と extractor ということのようです。F# の方は何か分かりにくさがあって理解しきれていないかもしれませんが、ちょっと紹介してみます。

例として少し前までプログラミング系ブログを席巻していた Fizz-Buzz 問題 [2] を取り上げます。
まず、心のきれいな OCaml プログラマが変な方向に凝ろうとせずに素直に Fizz-Buzz 問題を書き下したら、おそらく大体以下のようなものになるのではないかと思います。

let fizzbuzz = function
| n when n mod 15 = 0 -> "FizzBuzz"
| n when n mod  3 = 0 -> "Fizz"
| n when n mod  5 = 0 -> "Buzz"
| n -> string_of_int n
;;

for i = 1 to 100 do print_string (fizzbuzz i ^ " ") done

これはこれでもう動かしようがないと個人的に思いますが、引っかかりを残すのはパターンマッチの部分です。上記のコードでは関数の引数を「パターン」に「マッチ」させているといえる部分はまったくなくて、実質的な仕事をしているのはガード条件の部分です。単に3つ以上の分岐を書く構文が他にないので使っているにすぎません。ついでに言えば「N の倍数である」ということを言うのに「N で割った余りが 0 である」といちいち言い換えなければいけない部分も気に入りません。本当は fizzbuzz 関数を以下のように書けたらいいのではないのでしょうか。

let fizzbuzz = function
| 15 * _ -> "FizzBuzz"
|  3 * _ -> "Fizz"
|  5 * _ -> "Buzz"
| n -> string_of_int n
;;

F# でアクティブパターンを使えば（全く上記のとおりには書けないけど）できるよ、というのが今日の話です。

こんな風に書きます。

#nowarn "57";;

let (|Mul|_|) x y = if y % x = 0 then Some(y / x) else None;;

let fizzbuzz = function
| Mul 15 _ -> "FizzBuzz"
| Mul  3 _ -> "Fizz"
| Mul  5 _ -> "Buzz"
| n -> string_of_int n
;;

for i = 1 to 100 do print_string (fizzbuzz i ^ " ") done

let (|Mul|_|) ～というのが問題の active pattern を定義している部分です。(| |) という記号はバナナに似ているので banana marks とか banana symbols とか呼ばれているようです。定義された ( |Mul|_| ) は見かけは変ですが普通に関数として使えます。

> ( |Mul|_| ) 3 15;;
val it : int option = Some 5
> ( |Mul|_| ) 5 15;;
val it : int option = Some 3
> ( |Mul|_| ) 7 15;;
val it : int option = None

特殊なのは、この関数はパターンマッチのパターン中で Mul が出てきたときに Mul の逆適用関数として呼び出されるという点です。その逆適用の結果の戻り値が Some 何とかであった場合はパターンマッチ成功でその何とかにパターン中の変数が束縛され、None であった場合はパターンマッチ失敗とみなされるというわけです。

( |Mul|_| ) の中ごろの余計なアンダーバーとパイプはこの関数がオプション型を返す場合の書き方です。これは partial active pattern と呼ばれます。(|Mul|) とか書くときは逆適用が常に成功するようなパターンを定義することになります。
また ( |Mul|_| ) は2つ引数を取りますが、これは parameterized active pattern と呼ばれるもので、おそらく Scala にはこれに相当する機能はないと思います。分かりにくいですが Mul 15 _ と書くときの 15 と _ は同じ立場のものではなくて、実は 15 は Mul をパラメタライズしているだけです。なのでパターンマッチ中に Mul _ 15 とはかけません。
なお parameterized active pattern の構文はまだ確定とはされていないようで、使うと警告が出ます。これを抑止するために #nowarn "57";; という行を書いています。

[1] http://blog.so-net.ne.jp/rainyday/2007-02-26
[2] http://www.aoky.net/articles/jeff_atwood/why_cant_programmers_program.htm

F# から FFI で Tcl を呼ぶ

SML# の FFI も簡単だった [1] けど F# の FFI も簡単。

module Tcl = begin

  open System.Runtime.InteropServices
  open Microsoft.FSharp.NativeInterop

  [<DllImport(@"C:\\Tcl\\bin\\tcl84.dll", EntryPoint="Tcl_CreateInterp")>]
  extern void* CreateInterp();

  [<DllImport(@"C:\\Tcl\\bin\\tcl84.dll", EntryPoint="Tcl_Eval")>]
  extern int Eval(void*, string);

  [<DllImport(@"C:\\Tcl\\bin\\tcl84.dll", EntryPoint="Tcl_GetStringResult")>]
  extern string GetStringResult(void*);

end

let _ =
  let interp = Tcl.CreateInterp() in
  Tcl.Eval(interp, "puts {Hello World}"); (* -> Hello World *)
  Tcl.Eval(interp, "puts xxx {Hello World}");
  print_string(Tcl.GetStringResult(interp)) (* -> can not find channel named "xxx" *)

F# 1.9.1.8 で動作させています。C 風の定義（が書ける！）の中に string 型とか埋め込んでしまってるのは勘で書いてみたらうまく動いている風なのですが、ひょっとしたらお作法に違反している可能性も。

F# は LINQ を統合していたり配列のパターンマッチが書けたりなど OCaml とは別の言語として進化しているようで何より。[2007-05-25追記] ここは一部勘違いでOCamlでも普通に配列のパターンマッチはできた。

なお、この記事は F# News の記事 [2] を参考にしました。

[1] http://blog.so-net.ne.jp/rainyday/2007-03-31
[2] http://fsharpnews.blogspot.com/2007/04/foreign-function-interface-ffi.html

Camlp4 の日本語チュートリアル（未完成版）

Caml-list で OCaml 3.10.0 のベータテストが始まったよというアナウンスが出たりして、もうそろそろ 3.10 が正式に出てしまうのかもしれない。
3.10 のことは知りつつもしばらく前に Camlp4 の勉強をしていたのだけど、結局途中で放置した状態になっていたのでこのアナウンスを機に現行の Camlp4 の勉強は打ち切って 3.10 版に目を向けることに決めた。決めただけでいつまた始めるかは未定。

で、その現行版 Camlp4 の勉強をしながらチュートリアルめいたものを書いていたのがあるので、これも未完成なのだけど Scribd にアップロード [1] しておきました。一番大事な章がまったく書かれていませんが（あと後半はもうちょっと例を直したかった気もする）、とっかかりとして誰かの役に立つかもしれません。なお元は Word 文書で Scribd の変換した PDF で見ると見栄えはいまいちです。

それにしても 3.10 版 Camlp4 はちゃんとしたドキュメントが出てくれるのかな。

[1] http://www.scribd.com/doc/13930/Understanding-Camlp4

カリー化関数 vs. タプル

OCaml や SML では関数は一つしか引数を持てない。もっとも実用上はそんなことはなくて、2通りの実現方法がある。一つはカリー化関数を使う方法で、もう一つは引数をタプルにする。

# let f x y = x + y;;  (* カリー化関数 *)
val f : int -> int -> int = <fun>
# let f (x,y) = x + y;; (* 複数の引数をタプル化 *)
val f : int * int -> int = <fun>

OCaml も SML も も両方をサポートしているのだけど、何故か OCaml は前者、SML は後者という印象がある。ML for the working programmer を読んだとき、ずっと後者の書き方しか出てこないので SML は前者をサポートしていないのかと最初勘違いしていたほどだ。先日「プログラミング言語Standard ML入門」を買ってみたが、パッと見ではやはり基本はタプルらしい。一方ウェブなどで OCaml の記事などを読むと後者が出てくることはあまりない。

中置演算子も OCaml ではカリー化関数で、SML ではタプルをとる関数として定義されている。

OCaml:

# (+);;
- : int -> int -> int = <fun>

SML:

- op +;
val it = fn : int * int -> int

どっちもできるけどどっちがよいのか、ということについて特にまとまった見解を見たことは無いような気がするので―あるいはちゃんとした ML 使いはそんな部分で迷わないのか―比較をまとめてみた。

1. カリー化関数は部分適用できる

当然のことだが、そうなる。

# let add1 = (+) 1;;
val add1 : int -> int = <fun>
# add1 5;;
- : int = 6

タプルの場合に同じことをやるにはひと手間かけてカリー化関数に変える必要がある（secl, secr 関数は ML for ～ p.180 から）。

- fun secl x f y = f(x,y);
val secl = fn : 'a -> ('a * 'b -> 'c) -> 'b -> 'c
- fun secr f y x = f(x,y);
val secr = fn : ('a * 'b -> 'c) -> 'b -> 'a -> 'c
- val add1 = (secl 1 op+);
val add1 = fn : int -> int
- add1 5;
val it = 6 : int

2. タプルはパターンマッチで少しだけ簡潔な場合がある

ある関数が2つの引数に注目したパターンマッチを行うものの場合、カリー化関数の引数を一度タプル化してマッチにかけるよりも最初からタプルの方が1行程度すっきりする。
例えば下の2つを比べると前者のほうが match が余計な気がして気になる。

let rec a n m =
  match (n, m) with
  | (0, m) -> m + 1
  | (n, 0) -> a (n - 1) 1
  | (n, m) -> a (n - 1) (a n (m - 1))

let rec a = function
  | (0, m) -> m + 1
  | (n, 0) -> a (n - 1, 1)
  | (n, m) -> a (n - 1, (a (n, m - 1)))

3. タプルのほうが #trace で読みやすい

OCaml の話だが #trace で呼び出しトレースを見る場合、カリー化関数では以下のようになって見難い。

# let f a b c d e = a + b + c + d + e;;
val f : int -> int -> int -> int -> int -> int = <fun>
# #trace f;;
f is now traced.
# f 1 2 3 4 5;;
f <-- 1
f --> <fun>
f* <-- 2
f* --> <fun>
f** <-- 3
f** --> <fun>
f*** <-- 4
f*** --> <fun>
f**** <-- 5
f**** --> 15
- : int = 15

タプルを引数にとる関数はすっきり見える。

# let f (a,b,c,d,e) = a + b + c + d + e;;
val f : int * int * int * int * int -> int = <fun>
# #trace f;;
f is now traced.
# f (1,2,3,4,5);;
f <-- (1, 2, 3, 4, 5)
f --> 15
- : int = 15

#trace を使うのは動きの良く分からないものを分析する場合なので後者のほうがいらいらさせられなくて済む。

こんなところだろうか。他にあるかな。

The Little Schemer の collector を OCaml で

The Little Schemer を買って割と簡単に読み進めていたら p.137 の multirember&co 関数のところで分からなくなったので OCaml で書き直してみた。

元の Scheme コードはこれ（わからん！）。

(define multirember&co
  (lambda (a lat col)
    (cond
      ((null? lat)
       (col (quote ()) (quote ())))
      ((eq? (car lat) a)
       (multirember&co a
         (cdr lat)
         (lambda (newlat seen)
           (col newlat
             (cons (car lat) seen)))))
      (else
        (multirember&co a
          (cdr lat)
          (lambda (newlat seen)
            (col (cons (car lat) newlat)
              seen)))))))

(define a-friend
  (lambda (x y)
    (null? y)))

この multirember&co 関数は「引数 lat : list を (a.) lat から要素 a : atom に一致するものを取り除いたリストと (b.) 取り除かれた分の a のリストの2つに分けて、それら2つのリストを引数として関数 col を呼んでその値を返す関数」のはず…
a-friend 関数は col として与える関数の一例で、a を取り除いた後のリストが null かどうかを返す。

OCaml で書き直すとこうなった。

let rec multirember_and_co a lat col =
  match lat with
  | [] -> (1)
    col [] [] 
  | x::xs when x = a -> (2)
    multirember_and_co a xs (fun newlat seen -> col newlat (x::seen))
  | x::xs -> (3)
    multirember_and_co a xs (fun newlat seen -> col (x::newlat) seen)
;;

let a_friend x y = y = [] ;;

こっちのほうが大分読める。OCaml の複雑な yacc ファイルはすべて括弧を減らす為にあるのだということが分かります。

これがどのように動くかということを手作業で追ってみた。※ここからはパターンマッチのマッチ節を上から順に (1) , (2), (3) として指し示します

まず lat が空リストの場合。

multirember_and_co "tuna" [] a_friend
|
+-> (1) a_friend [] []

これは空リストのパターンにマッチしておわり。col として与えられた a_friend に [] [] を引数として与えてその結果を返す。

次に lat が a と一致する要素1つのみからなるリストの場合。

multirember_and_co "tuna" ["tuna"] a_friend
|
+-> (2) multirember_and_co "tuna" [] (fun newlat seen -> a_friend newlat ("tuna"::seen))
        |
        +-> (1) (fun newlat seen -> a_friend newlat ("tuna"::seen)) [] [] 
                 ||
                a_friend [] ("tuna"::[])
                 ||
                a_friend [] ["tuna"]

最初の呼び出しで ["tuna"] の car 部分と "tuna" が一致するので (2) にマッチして multirember_and_co を再帰呼び出しする。そのときの lat は [] （=["tuna"] の cdr 部分）で col は (fun newlat seen -> a_friend newlat ("tuna"::seen)) となる。

multirember_and_co "tuna" [] (fun newlat seen -> a_friend newlat ("tuna"::seen))

次の呼び出しでは lat は空リストになっているので (1) にマッチする。ここでは col として与えられた (fun newlat seen -> a_friend newlat ("tuna"::seen)) に [] [] を引数として与えて呼び出す。

(fun newlat seen -> a_friend newlat ("tuna"::seen)) [] []

newlat と seen を [] で置き換えると a_friend [] ("tuna"::[]) で、これは a_friend [] ["tuna"] というのと同じことになる。

さらに lat が a と一致する要素と一致しない要素の両方を持っている場合。

multirember_and_co "tuna" ["and;" "tuna"] a_friend
|
+-> (3) multirember_and_co "tuna" ["tuna"] (fun newlat seen -> a_friend ("and"::newlat) seen)
        |
        +-> (2) multirember_and_co "tuna" [] (fun newlat seen -> (fun newlat seen -> a_friend ("and"::newlat) seen) newlat ("tuna"::seen))
                |
                +-> (1) (fun newlat seen -> (fun newlat seen -> a_friend ("and"::newlat) seen) newlat ("tuna"::seen)) [] [] 
                         ||
                        (fun newlat seen -> a_friend ("and"::newlat) seen) [] ("tuna"::[])
                         ||
                        a_friend ("and"::[]) ("tuna"::[])
                         ||
                        a_friend ["and"] ["tuna"]

最初の呼び出しでは ["and;" "tuna"] の car は "and" であり "tuna" と一致しないので (3) にマッチする。multirember_and_co を再帰呼び出しするが、ここでは lat は ["tuna"] （=["and;" "tuna"] の cdr 部）で col は (fun newlat seen -> a_friend ("and"::newlat) seen) となる。

multirember_and_co "tuna" ["tuna"] (fun newlat seen -> a_friend ("and"::newlat) seen)

次の呼び出しでは lat = ["tuna"] の car 部分と "tuna" が一致するので (2) にマッチして multirember_and_co を再帰呼び出しする。今度は lat は [] で col は (fun newlat seen -> (fun newlat seen -> a_friend ("and"::newlat) seen) newlat ("tuna"::seen)) となる（無名関数が二重になる）。

multirember_and_co "tuna" [] (fun newlat seen -> (fun newlat seen -> a_friend ("and"::newlat) seen) newlat ("tuna"::seen))

さらに次の呼び出しでは lat は空リストになったので (1) にマッチする。ここで col として与えられた (fun newlat seen -> (fun newlat seen -> a_friend ("and"::newlat) seen) newlat ("tuna"::seen)) に引数として [] [] を与えて呼び出すことになる。

(fun newlat seen -> (fun newlat seen -> a_friend ("and"::newlat) seen) newlat ("tuna"::seen)) [] []

まずは外側の関数の newlat と seen を [] に置き換えると (fun newlat seen -> a_friend ("and"::newlat) seen) [] ("tuna"::[]) となる。

(fun newlat seen -> (fun newlat seen -> a_friend ("and"::newlat) seen) newlat ("tuna"::seen)) [] [] 
 ||
(fun newlat seen -> a_friend ("and"::newlat) seen) [] ("tuna"::[])

ここからさらに newlat を [] 、 seen を "tuna"::[] で置き換えると a_friend ("and"::[]) ("tuna"::[]) となる。

(fun newlat seen -> a_friend ("and"::newlat) seen) [] ("tuna"::[])
 ||
a_friend ("and"::[]) ("tuna"::[])

これは a_friend ["and"] ["tuna"] というのと同じことだ。

で、こういう場合の col に当たるものを collector と呼んで、リストから一度に複数の値を掻き集める場合に使うのだとか。

Practical OCaml について

予約して長い期間待った末に入手したのと割と高価な本だったこともあり、逆に全面否定したくはない気持ちがあるのですが（こういう心理を心理学用語ではなんていうんだったかな）、[1] のリンク先にある米Amazonのレビュー [2] に書いてあるような「一般的な説明だけした後にコードを書き連ねて何の説明もしないで次に進む」「コードのインデントが変」「まるでカット&ペースト仕事のよう」というのは残念ながら事実です。

あくまで一例ですが、例えば p.160 からのファンクタについての説明ではいまいちピンと来ないファンクタについての一般的な説明が7行ほど続いた後に「ファンクタを定義するには functor キーワードを使う方法と parameter syntax を使う方法と2通りありますが、それは単にスタイルの問題で、私は functor キーワードを使うほうが好きです。」と来て、すぐ後に1ページ半のコード例。コメントはなし。最後に「ファンクタは難しいこともあるけど、実際それほど理解しにくいものでもなく、ものすごい便利でもあるんです。」でこの節は終わり。いやいや、分かりませんよ。

まず定義方法が2通りあるというならその2通りについて構文のテンプレートを囲みか何かで示して、その後にちょっとした具体例を示して、コードについて逐一解説するというのがこういう技術書の王道だと思うんですが、この本では大体上記のような書き方になっています。

そしてそのコード例の提示の仕方もひどい。この本のコード例は基本的に ocaml トップレベルで実行した結果のようなのですが、ユーザの入力とトップレベルからの出力がフォント上も区別がなく、トップレベルのプロンプトも何故か分かりませんが見当違いの場所に現れていることがあってあまり当てにならない。
あとインデントが変です（スタイルの話ではなく）。長いコードをエディタからトップレベルに単純にペーストするとこういう結果が採れるのかもしれません。なにか大急ぎで実行例を採取してそのままチェックせずに本にしてしまったかのような印象を受けます。

というわけで基本的にはお勧めできず、特に OCaml をこの本で学習してみようという目的にはまったく向かないと思います。

この本の価値のある部分としては「OCaml で XX をする場合、他の人はどうしてるんだろう」という例になることと、幅広いトピックを扱っているため、「こういう機能/ツールもあるのか」という発見になることかと思います。活用の仕方としてはとにかくコードに説明がないので鉛筆をもって自分で説明を書き入れながら読むといいと思います。

OCaml の日本語本を書いていらっしゃる人がいるそうですが、是非この本の目次だけ参考にして、如何にしたらこの題材でもっと良い本が書けるかという動機付けにしていただけたらと思います。

[1] http://d.hatena.ne.jp/sumii/20061116/1163637120
[2] http://www.amazon.com/gp/product/customer-reviews/159059620X/

OCaml と awk の文法を視覚化する

Nick Siegerさんという人が Ruby, Java, JavaScript の文法を yacc ファイルを元に視覚化するということをやっていて [1] 、そのやり方を真似して awk 版と OCaml 版を作ってみた。

まずは awk の文法。これは the one true awk [2] の awkgram.y を元にやってみた。大きく見るにはブラウザの機能で画像の単独表示をしてみてください。

上記3言語と比べてもかなりコンパクトにまとまっててなかなかキュートです。

そして OCaml の文法。これは OCaml ソースコードの parser.mly を使った。
多分 implementation から始まる .ml の文法と interface から始まる .mli の文法があるのだが、前者のみ。

これは…。全然追えない。

[1] http://blog.nicksieger.com/articles/2006/10/27/visualization-of-rubys-grammar
[2] http://cm.bell-labs.com/cm/cs/awkbook/

逆ポーランド記法を解釈する Camlp4 プリプロセッサ

最近 Camlp4 を本腰入れて理解しようとがんばっている。

今日は逆ポーランド記法を OCaml の構文木に変換するプリプロセッサを作ってみた。

Camlp4 は基本的には OCaml コードを構文木に変換する関数を Pcaml.parse_implem に定義しているのだけど、それを書き換えれば任意の言語を入力にすることができる。その関数は char Stream.t を読んで構文木を返すことができればいい。

(* ocamlc -c -I +camlp4 -pp "camlp4o q_MLast.cmo" pa_rpn.ml *)

let _ =
Pcaml.parse_implem := function strm ->
  let _loc = Token.dummy_loc in
  let stack = Stack.create () in
  let rec process stack strm = 
    match (Stream.peek strm) with 
      | Some ('0'..'9')
        -> let c = String.make 1 (Stream.next strm) in
           Stack.push <:expr<$int:c$>> stack;
           process stack strm
      | Some ('+')
        -> Stream.junk strm;
           let x = Stack.pop stack and y = Stack.pop stack in
           Stack.push <:expr< $y$ + $x$ >> stack;
           process stack strm
      | Some ('-')
        -> Stream.junk strm;
           let x = Stack.pop stack and y = Stack.pop stack in
           Stack.push <:expr< $y$ - $x$ >> stack;
           process stack strm
      | Some ('*')
        -> Stream.junk strm;
           let x = Stack.pop stack and y = Stack.pop stack in
           Stack.push <:expr< $y$ * $x$ >> stack;
           process stack strm
      | Some ('/')
        -> Stream.junk strm;
           let x = Stack.pop stack and y = Stack.pop stack in
           Stack.push <:expr< $y$ / $x$ >> stack;
           process stack strm
      | Some _
        -> raise (Failure "unknown char")
      | None
        -> let e = Stack.pop stack in
           <:str_item< print_int $e$ >>
  in
  [(process stack strm), _loc], false;

これを以下のようにコンパイルして

ocamlc -c -I +camlp4 -pp "camlp4o q_MLast.cmo" pa_rpn.ml

こんな感じで使う。

F:\>type rpn.ml
12-3*
F:\>ocamlc -pp "camlp4o ./pa_rpn.cmo" rpn.ml

F:\>camlprog
-3
F:\>

OCaml ソースコード上は print_int ((1 - 2) * 3) に相当する構文木に変換されるのだが pr_o.cmo で見た場合は何故か元のソースがそのまま最後にくっついてしまう。

F:\>camlp4o ./pa_rpn.cmo pr_o.cmo rpn.ml
let _ = print_int ((1 - 2) * 3)12-3*
F:\>

これはどうやら pr_o.cmo のバグで、 Pcaml.parse_implem を直接書き換えるとおかしくなるみたいだ。Matin Jambon 氏のページ [1] でもそのような現象について記載されている。

Camlp4 を勉強しながらその成果をチュートリアルみたいなものとして残そうとしているのだけど、3.09版でやっているので、下方互換性のない3.10がいずれ正式になることと思うと未来のない作業かもしれない。最終的には文章を書く練習だと考えればいいとも思っているが。

[1] http://martin.jambon.free.fr/extend-ocaml-syntax.html#inserting-bof

Practical OCaml が届く

待ちかねた！

しかし Amazon ではペーパーバックとあったのだが、表紙は硬いやつだった。こういうのもペーパーバックっていうのかな。よくわからん。今日から読みます。

OCaml で書く Tcl インタプリタ 2

ちょっと前に書いた Tcl インタプリタ [1] を Camlp4 のストリームパーサを使って書き直してみた。他にもスタイル的な部分でちょこちょこと変えた。

最初ガード条件をどうやって書けばいいのか分からなくて詰まった。

module StringMap = Map.Make(String)
exception Unknown_command

type interp = {
    result : string;
    g : string StringMap.t;
}

type state = {
    openBraces : int;
    argv : string list;
    buf : string;
    nest : bool;
}

let string_of_char c = String.make 1 c

let invoke interp argv = 
    let argv = List.rev argv in
    match argv with
    | "puts"::str::[] -> Printf.printf "%s\n" str; interp
    | "set"::name::[] -> {interp with result = StringMap.find name interp.g}
    | "set"::name::value::[] -> {g = StringMap.add name value interp.g; result = value}
    | _ -> raise Unknown_command

let backslash = parser
    | [< ''\n' >] -> ' '
    | [< ''n'  >] -> '\n'
    | [< ''t'  >] -> '\t'
    | [< 'c    >] -> c
    | [<       >] -> '\\'

let rec varsub interp name = parser
    | [< ''A'..'Z' | 'a'..'z' | '_' | '0'..'9' as c; strm>]
            -> varsub interp (name ^ string_of_char c) strm
    | [< >] -> if name = "" then "$" else StringMap.find name interp.g

let argv_of_state state =
    if state.buf="" then state.argv else state.buf::state.argv
let add_arg state =
    {state with argv = state.buf::state.argv; buf = ""}
let ($^) state c = 
    {state with buf = state.buf ^ string_of_char c}
let ($^^) state s = 
    {state with buf = state.buf ^ s}
let flush state =
    {state with argv = []; buf = ""}
let incrbrace state =
    {state with openBraces = state.openBraces + 1}
let decrbrace state =
    {state with openBraces = state.openBraces - 1}

let rec eval interp state = parser
    | [< '' '|'\t'|'\r'|'\n'|';'; strm >] -> eval interp state strm
    | [< ''#'; strm >] -> comment interp state strm
    | [< strm >] -> command interp state strm
and comment interp state = parser
    | [< ''\n'; strm >] -> eval interp state strm
    | [< ''\\'; strm >] -> ignore (backslash strm); comment interp state strm
    | [< '_;    strm >] -> comment interp state strm
    | [<        strm >] -> interp
and command interp state = parser
    | [< '']' when state.nest; >] -> invoke interp (argv_of_state state)
    | [< '';'|'\n'; strm >] ->
        eval (invoke interp (argv_of_state state)) (flush state) strm
    | [< ''\\'; strm >] ->
        command interp (state $^ backslash strm) strm
    | [< '' '|'\t'|'\r' when state.buf = ""; strm >] ->
        command interp state strm
    | [< '' '|'\t'|'\r'; strm >] -> command interp (add_arg state) strm
    | [< ''{'  when state.buf = ""; strm >] ->
        brace interp {state with openBraces = 1} strm
    | [< ''\"' when state.buf = ""; strm >] ->
        quote interp state strm
    | [< ''$'; strm >] ->
        command interp (state $^^ varsub interp "" strm) strm
    | [< ''['; strm >] ->
        let interp = cmdsub interp strm state in
        command interp (state $^^ interp.result) strm
    | [< 'c; strm >] -> command interp (state $^ c) strm
    | [< >] ->
        let argv = argv_of_state state in
        if argv = [] then
            interp
        else
            invoke interp argv
and brace interp state = parser
    | [< ''\\' as c; strm >] -> brace interp (state $^ c) strm
    | [< ''{'  as c; strm >] -> brace interp (incrbrace (state $^c)) strm
    | [< ''}'  as c; strm >] ->
        if state.openBraces = 1 then
            command interp (decrbrace (add_arg state)) strm
        else
            brace interp (decrbrace (state $^ c)) strm
    | [< 'c; strm >] -> brace interp (state $^ c) strm
    | [<     strm >] -> command interp state strm
and quote interp state = parser
    | [< ''\\'; strm >] -> quote interp (state $^ backslash strm) strm
    | [< ''\"'; strm >] -> command interp (add_arg state) strm
    | [< ''$';  strm >] -> quote interp (state $^^ varsub interp "" strm)  strm
    | [< ''[';  strm >] -> let interp = cmdsub interp strm state in
                           quote interp (state $^^ interp.result) strm
    | [< 'c;    strm >] -> quote interp (state $^ c) strm
    | [<        strm >] -> command interp state strm
and cmdsub interp strm state =
    eval interp {openBraces = 0; argv = []; buf= "" ; nest = true;} strm

let inch = open_in Sys.argv.(1);;
let instr = Stream.of_channel inch;;
let _ = eval {result = ""; g = StringMap.empty}
             {openBraces = 0; argv = []; buf=""; nest = false;}
             instr;;

[1] http://blog.so-net.ne.jp/rainyday/2006-09-25