SSブログ

Camlp4 のストリームパーサ [OCaml]

Camlp4 に用意されているストリームパーサを使うと前回 [1] 作った Tcl インタプリタの以下のような部分がもっとすっきり書きなおせる。例えば、

comment (interp, strm, state) =
    match (Stream.peek strm) with
    | Some '\n' -> Stream.junk strm; eval (interp, strm, state)
    | Some '\\' -> Stream.junk strm; ignore (backslash strm); comment (interp, strm, state)
    | Some _    -> Stream.junk strm; comment (interp, strm, state)
    | None      -> eval (interp, strm, state)

これが以下のようになる。ソースの先頭で #load "camlp4.cma";; とする。

comment (interp, strm, state) = (parser
      [< ''\n' >] -> eval (interp, strm, state)
    | [< ''\\' >] -> ignore (backslash strm); comment (interp, strm, state)
    | [< '_ >]    -> comment (interp, strm, state)
    | [< >]       -> eval (interp, strm, state)
    ) strm

これだと Stream.junk とか書かなくてよいし、また書く場合と書かない場合に注意しなくてよいのでかなりよい。なるほど、これは便利だ。

実際このコードを camlp4o -I . pr_o.cmo otcl2.ml > a などとすると、以下のようなコードに変換されているのが分かる。

comment (interp, strm, state) =
  (fun (strm__ : _ Stream.t) ->
     match Stream.peek strm__ with
       Some '\n' -> Stream.junk strm__; eval (interp, strm, state)
     | Some '\\' ->
         Stream.junk strm__;
         begin ignore (backslash strm); comment (interp, strm, state) end
     | Some _ -> Stream.junk strm__; comment (interp, strm, state)
     | _ -> eval (interp, strm, state))
    strm

元々のコードとかなりぴったり一致する。あとこのコードを見て分かったのは Genlex のソースも元々は Camlp4 のストリームパーサを使ったものから変換しているっぽい。strm__ という変数名とかが一致するし。なんかぐるっと遠回りしてたどり着いた感じだ。

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


OCaml で書く Tcl インタプリタ [OCaml]

OCaml で Tcl インタプリタのサブセットを作ってみた。Tcl の文法は [1] のようなものだが、すべてを実装しているわけではない。コードは全115行で以下のとおり。

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 strm =
    match (Stream.peek strm) with
    | Some '\n' -> Stream.junk strm; ' '
    | Some 'n'  -> Stream.junk strm; '\n'
    | Some 't'  -> Stream.junk strm; '\t'
    | Some c    -> Stream.next strm
    | None      -> '\\'

let rec varsub interp strm name =
    match (Stream.peek strm) with
    | Some ('A'..'Z' | 'a'..'z' | '_' | '0'..'9')
                -> varsub interp strm (name ^ string_of_char (Stream.next strm))
    | _ -> if name = "" then "$" else StringMap.find name interp.g

let rec eval (interp, strm, state) =
    match (Stream.peek strm) with
    | Some (' ' | '\t' | '\r' | '\n' | ';')
                -> Stream.junk strm; eval (interp, strm, state)
    | Some '#'  -> comment (interp, strm, state)
    | Some ']'  when state.nest
                -> Stream.junk strm; interp
    | Some _    -> command (interp, strm, state)
    | None      -> interp
and comment (interp, strm, state) =
    match (Stream.peek strm) with
    | Some '\n' -> Stream.junk strm; eval (interp, strm, state)
    | Some '\\' -> Stream.junk strm; ignore (backslash strm); comment (interp, strm, state)
    | Some _    -> Stream.junk strm; comment (interp, strm, state)
    | None      -> eval (interp, strm, state)
and command (interp, strm, state) =
    match (Stream.peek strm) with
    | Some (';' | '\n')
                -> eval  (invoke interp state.argv, strm, {state with argv = []})
    | Some ']'  when state.nest
                -> eval  (invoke interp state.argv, strm, {state with argv = []})
    | Some _    -> arg   (interp, strm, state)
    | None      -> eval  (invoke interp state.argv, strm, {state with argv = []})
and arg (interp, strm, state) =
    match (Stream.peek strm) with
    | Some (';' | '\n')
                -> command (interp, strm, {state with argv = state.buf::state.argv; buf = ""})
    | Some '\\' -> Stream.junk strm; arg (interp, strm, {state with buf = state.buf ^ string_of_char (backslash strm)})
    | Some (' ' | '\t' | '\r')
                -> white (interp, strm, {state with argv = state.buf::state.argv; buf = ""})
    | Some '{'  when state.buf = ""
                -> Stream.junk strm; brace (interp, strm, {state with openBraces = 1})
    | Some '\"' when state.buf = ""
                -> Stream.junk strm; quote (interp, strm, state)
    | Some '$'  -> Stream.junk strm; arg (interp, strm, {state with buf = state.buf ^ varsub interp strm ""})
    | Some '['  -> Stream.junk strm;
                   let interp = cmdsub interp strm state in
                   arg   (interp, strm, {state with buf = state.buf ^ interp.result})
    | Some ']'  when state.nest
                -> command (interp, strm, {state with argv = state.buf::state.argv; buf = ""})
    | Some _    -> arg   (interp, strm, {state with buf = state.buf ^ string_of_char (Stream.next strm)})
    | None      -> command (interp, strm, {state with argv = state.buf::state.argv; buf = ""})
and brace (interp, strm, state) =
    match (Stream.peek strm) with
    | Some '\\' -> brace (interp, strm, {state with buf = state.buf ^ string_of_char (Stream.next strm)})
    | Some '{'  -> brace (interp, strm, {state with openBraces = state.openBraces + 1; buf = state.buf ^ string_of_char (Stream.next strm)})
    | Some '}' when state.openBraces = 1
                -> Stream.junk strm; white (interp, strm, {state with argv = state.buf::state.argv; buf = ""})
    | Some '}'  -> arg   (interp, strm, {state with openBraces = state.openBraces - 1; buf = state.buf ^ string_of_char (Stream.next strm)})
    | Some _    -> brace (interp, strm, {state with buf = state.buf ^ string_of_char (Stream.next strm)})
    | None      -> arg   (interp, strm, state)
and quote (interp, strm, state) =
    match (Stream.peek strm) with
    | Some '\\' -> Stream.junk strm; quote (interp, strm, {state with buf = state.buf ^ string_of_char (backslash strm)})
    | Some '\"' -> Stream.junk strm; white (interp, strm, {state with argv = state.buf::state.argv; buf = ""})
    | Some '$'  -> Stream.junk strm; quote (interp, strm, {state with buf = state.buf ^ varsub interp strm ""})
    | Some '['  -> Stream.junk strm;
                   let interp = cmdsub interp strm state in
                   quote (interp, strm, {state with buf = state.buf ^ interp.result})
    | Some _    -> quote (interp, strm, {state with buf = state.buf ^ string_of_char (Stream.next strm)})
    | None      -> arg   (interp, strm, state)
and white (interp, strm, state) =
    match (Stream.peek strm) with
    | Some (';' | '\n')
                -> command (interp, strm, state)
    | Some (' ' | '\t' | '\r')
                -> Stream.junk strm; white (interp, strm, state)
    | Some _    -> arg   (interp, strm, state)
    | None      -> command (interp, strm, state)
and cmdsub interp strm state =
    eval (interp, strm, {openBraces = 0; argv = []; buf= "" ; nest = true;})

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

コードに Stream.peek と Some ばっかり書くことになったのでこれでいいのかと不安になったが OCaml 標準モジュールの Genlex もソースはそんな感じだったのでこういう書き方でいいのだろうと思う。多分 Haskell で書けばストリームが無限リストになるので peek して junk してという命令的な書き方はしなくてよいのだろう。

interp 型と state 型という2つの型を定義していて、前者はインタプリタの状態(変数テーブルと最終実行コマンドの戻り値)を表現し、後者はコマンド解析の状態(解析中のコマンドの一部分や中括弧の対応状態など)を表現している。
eval 関数以降の and で連結された関数定義は互いに呼び出しあっているが、コマンド置換を行う cmdsub を呼ぶ場合以外は末尾呼び出しになっているのでスタック食いにはならない(はず)。

コマンドは puts と set しか使えないが、グルーピングと変数置き換えとコマンド置き換えをサポートしているので以下のようなサンプルがちゃんと動く。

# this is comment line \
this is comment line too.

puts hello

puts {hello
world}

puts "hello
again"

# back slash substitution
puts ->\n<-

set foo bar
set bar hoge

puts "foo is $foo, bar is $bar"

# this suppresses variable substitution
puts {foo is $foo, bar is $bar}

puts $bar;            # prints hoge
puts [set bar];       # prints hoge, too
puts [set $foo];      # prints hoge, too
puts [set [set foo]]; # prints hoge, too

実行するとこうなる。

hello
hello
world
hello
again
->
<-
foo is bar, bar is hoge
foo is $foo, bar is $bar
hoge
hoge
hoge
hoge

[1] http://www.tcl.tk/man/tcl8.4/TclCmd/Tcl.htm


Practical OCaml [OCaml]

出版日が2006/10/23に延期になっていた。がっかり。

http://www.amazon.co.jp/gp/product/159059620X/


#trace ディレクティブ [OCaml]

ocaml トップレベルで #trace というディレクティブを使うと関数の呼び出しをトレースして観察できる。これはとても便利で、例えば以下のようにすると fact 再帰関数とその末尾再帰版 facti の違いが分かりやい。

# let rec fact n = if n = 0 then 1 else n * (fact (n - 1));;
val fact : int -> int = <fun>
# #trace fact;;
fact is now traced.
# fact 4;;
fact <-- 4
fact <-- 3
fact <-- 2
fact <-- 1
fact <-- 0
fact --> 1
fact --> 1
fact --> 2
fact --> 6
fact --> 24
- : int = 24
# let rec facti (n, p) = if n = 0 then p else (facti ((n - 1), (n * p)));;
val facti : int * int -> int = <fun>
# #trace facti;;
facti is now traced.
# facti (4, 1);;
facti <-- (4, 1)
facti <-- (3, 4)
facti <-- (2, 12)
facti <-- (1, 24)
facti <-- (0, 24)
facti --> 24
facti --> 24
facti --> 24
facti --> 24
facti --> 24
- : int = 24

関数の戻り方向で何もせずにひたすら帰っていくのが末尾再帰版だというのが実際に目で見て観察できる。

この #trace は ocaml トップレベルの機能なので普通のプログラムに組み込んで何かすることはできない。そういう意味ではただの学習・デバッグ用機能だ。これが「関数呼び出しをフックして任意の関数を呼び出すように登録できる」という機能だったら面白いことができたかもしれないのにと思う。

なお Tcl にはそういう機能を提供する trace コマンドというのがある。上記の例をシミュレートするには以下のようにする。

% proc fact n {
    if {$n == 0} {
      return 1
    } else {
      return [expr $n * [fact [expr $n - 1]]]
    }
  }
% proc facti {n p} {
    if {$n == 0} {
      return $p
    } else {
      return [facti [expr $n - 1] [expr $n * $p]]
    }
  }
% proc trace_enter {cmd op} {
    puts "[lindex $cmd 0] <-- [lrange $cmd 1 end]"
  }
% proc trace_leave {cmd code result op} {
    puts "[lindex $cmd 0] --> $result"
  }
% trace add execution fact enter trace_enter
% trace add execution fact leave trace_leave
% trace add execution facti enter trace_enter
% trace add execution facti leave trace_leave
% fact 4
fact <-- 4
fact <-- 3
fact <-- 2
fact <-- 1
fact <-- 0
fact --> 1
fact --> 1
fact --> 2
fact --> 6
fact --> 24
24
% facti 4 1
facti <-- 4 1
facti <-- 3 4
facti <-- 2 12
facti <-- 1 24
facti <-- 0 24
facti --> 24
facti --> 24
facti --> 24
facti --> 24
facti --> 24
24
%

以前「Tcl で memoization」という記事 [1] を書いたときに思いついたアイデアのひとつとして、これを使って enter 時に memoize 用のプロシージャを登録し、キャッシュにヒットしたら本来のコードを実行せずに return する、というのがあったのだが、実際やってみるとトレース用のコマンドは対象プロシージャのスタックレベルではなくトップレベルで実行されるという仕様だったため上手く行かなかった。

[1] http://blog.so-net.ne.jp/rainyday/2006-06-24


Camlp4 で構文拡張 [OCaml]

OCaml 用の COM オートメーションライブラリを作り始めたという記事 [1] の中で Camlp4 を使って構文を書き換えればもっと綺麗な書き方ができるかもしれないと書いた。
その後 Camlp4 が理解できていないのは相変わらずなのだけど、見よう見まねと試行錯誤の結果、部分的にそれらしいことができるようになった。

ちなみにその見よう見まねは Martin Jambon さんの解説 [2] を読んでがんばった。この解説は公式のチュートリアルよりかなり分かりやすいと思う。(というか公式の方は私の頭ではまったく理解できない。何か理解するなと言っているようなオーラを感じる)。なお Campl4 は次リリースで下位互換性がなくなるような変更が予定されていて、今 Camlp4 を新たに勉強しようというのはかなり微妙な状況にあるようだ。

今回書いてみたのは前回の記事で挙げた問題点の (1) と (3) への対策。こういう構文が使えるようにしたい(このコードのファイル名は prog.ml とする)。

let get obj prop = 
  Printf.printf "get %s\n" prop

let set obj prop value = 
  Printf.printf "set %s=%s\n" prop value

let _ =
  let obj = 0 in (* dummy *)

  obj->Hello->World;
  (* get (get obj "Hello") "World" *)

  obj->member1->property = "somevalue"
  (* set (get obj "member1") "property" "somevalue" *)

単純化のために get 関数と set 関数はダミーのものを用意した。obj 変数もダミーで、特に意味はない。
ゴールは「obj-> ~」という部分がそれぞれ下の行のコメントの形に置き換えられるようにすることだ。

そのための Camlp4 のコードを以下のように書いた(ファイル名は pa_odmacro.ml とする)

let propget loc obj prop =
  <:expr<get $obj$ $str:prop$>>

let propset loc obj prop value =
  <:expr<set $obj$ $str:prop$ $value$>>

EXTEND
  Pcaml.expr: LEVEL "expr1" [
    [ obj = Pcaml.expr ; "->" ; prop = UIDENT -> propget loc obj prop
    | obj = Pcaml.expr ; "->" ; prop = LIDENT -> propget loc obj prop ]
  ];
END

EXTEND
  Pcaml.expr: LEVEL "expr1" [
    [ obj = Pcaml.expr ; "->" ; prop = UIDENT; "="; value = Pcaml.expr -> propset loc obj prop value
    | obj = Pcaml.expr ; "->" ; prop = LIDENT; "="; value = Pcaml.expr -> propset loc obj prop value ]
  ];
END

これを以下の Makefile を使ってメイクする。

all:
    ocamlc -c -I +camlp4 -pp "camlp4o pa_extend.cmo q_MLast.cmo -loc loc" pa_odmacro.ml
    camlp4o -I . pr_o.cmo pa_odmacro.cmo prog.ml -o prog.ppo
    ocamlopt -o prog -pp "camlp4o -I . pa_odmacro.cmo" prog.ml

出来上がった prog.exe の実行結果は以下のとおり。

F:\odmacro>prog
get Hello
get World
get member1
set property=somevalue

Makefile の2行目では prog.ml をプリプロセスした結果の OCaml コードを prog.ppo というファイル名で出力している。これを覗いてみると…

let get obj prop = Printf.printf "get %s\n" prop

let set obj prop value = Printf.printf "set %s=%s\n" prop value

let _ =
  let obj = 0 in
  get (get obj "Hello") "World";
  set (get obj "member1") "property" "somevalue"
	(* set (get obj "member1") "property" "somevalue" *)

よかった。期待通りの結果が出ている。

今回の pa_odmacro.ml はとりあえず動いたという程度なのでどういうことをしているのかというのを事細かに説明することができない。

特に分かっていないこと:
・LEVEL "expr1" というときの "expr1" というのは本当は他にもあって状況に応じて適切なものを選定すべきなのだろうが、何があってそれぞれどういう意味を持つのか理解していない
・今回「->」という記号を使ったが、既存の OCaml 文法の「->」の使用とぶつかるかどうか検証していない(そういう場合 Camlp4 は警告とか出してくれるのだろうか?)
・(上記のコードとはあまり関係ないが)何故 Camlp4 ではわざわざ revised syntax などというものが使われているのかわからない

[1] http://blog.so-net.ne.jp/rainyday/2006-08-16
[2] http://martin.jambon.free.fr/extend-ocaml-syntax.html


OCaml には null 参照が存在しない [OCaml]

あるところで「OCaml の参照には null 参照が存在しない。よって segmentation fault も起こりようがない」という意味の文章を見た。

確かに OCaml では let a = ref 0 みたいに初期値を与えないと参照が作れない。通常の変数の束縛は言わずもがなだ。なるほど。

でも逆に思ったのは他の言語、例えば Java で null 参照が必要な理由ってなんだっけってことだ。なんかすごく簡単な話のはずのような気もするけど考えるとパッとわからない…


(可変長の)書式付バイナリ入力関数 [OCaml]

前回 [1] はバイナリ出力関数を作ったけど入力のほうを作っていなかった。

入力のほうは読み込んだ値をどのように取り出すかで何通りかの実装が考えられると思う。思いついた順に3種類のコードを載せる。

まずは参照を使う方法。これは出力版をひっくり返しただけでシンプルだ。

let ($) f g x = f (g x)

let a len k s x = 
  let buf = String.make len ' ' in
  really_input s buf 0 len;
  x := buf;
  k s
let c k s x = k (x := input_char s; s)
let b k s x = k (x := input_byte s; s)
let i k s x = k (x := input_binary_int s; s)
let fin ich p = p (fun s -> s) ich

let _ =
  let x = ref 0 in
  let y = ref ' ' in
  let z = ref "" in
  let ich = open_in_bin "test.dat" in
  ignore (fin ich (i$c$a(5)) x y z);
  print_int !x;
  print_char !y;
  print_string !z

しかし使う段になって変数名に ! をつけなければいけないのが煩わしかったり、そもそも副作用はできるだけ持ち込みたくないかもしれない。変数の宣言もちょっとまどろっこしい。

次に関数がリストを返せばいいのではないかと考えた。でも異なる型の要素をひとつのリストに入れることはできないのでヴァリアント型を導入する。

let ($) f g x = f (g x)

type vt = A of string | C of char | B of int | I of int
let a len k s = 
  let (l,s) = s in
  let buf = String.make len ' ' in
  really_input s buf 0 len;
  k ((A buf)::l,s)
let c k s = let (l,s) = s in k ((C(input_char s))::l, s)
let b k s = let (l,s) = s in k ((B(input_byte s))::l, s)
let i k s = let (l,s) = s in k ((I(input_binary_int s))::l, s)
let fin ich p = p (fun s -> s) ([], ich)

かなり強引ではあるけれどもパターンマッチで値を取り出すことはできる(マッチが exhaustive でないという警告が出る)。

let _ =
  let ich = open_in_bin "test.dat" in
  let (A z::C y::I x::[], _) = fin ich (i$c$a(5)) in
  print_int x;
  print_char y;
  print_string z

しかしこの方法はやはり本当の値が構造の奥深くに入り込んでしまうことと、リストの構築が読み込み順になるので、出来上がったリストがファイルと逆の順序になってしまうという点がいまいちだ。

最後にカリー化関数を与えて読み込んだ順に部分適用していって、最終的に与えた関数の戻り値が返ってくるという方法。

let ($) f g x = f (g x)

let a len k s = 
  let (f,s) = s in
  let buf = String.make len ' ' in
  really_input s buf 0 len;
  let f' = f buf in
  k (f',s)

let c k s =
  let (f,s) = s in
  let f' = f (input_char s) in
  k (f',s)

let b k s =
  let (f,s) = s in
  let f' = f (input_byte s) in
  k (f',s)

let i k s =
  let (f,s) = s in
  let f' = f (input_binary_int s) in
  k (f',s)

let fin ich p f = p (fun s -> s) (f, ich)

let _ =
  let ich = open_in_bin "test.dat" in
  let maketuple x y z = (x,y,z) in
  let ((x,y,z), _) = fin ich (i$c$a(5)) maketuple in
  print_int x;
  print_char y;
  print_string z

これはかっこいいし、与える関数の中で前出の2つの方法をカバーできるので柔軟である。これが一番いいな。…というか、ちゃんと確認していなかったけど OCaml の scanf も同じようなインターフェイスだった。

さて、この(もともと私ではなくて Olivier Danvy さん [2] が考えた)仕組みはよくできているけど、やはり OCaml に適用する場合の最大のネックは書式表現の識別子問題だと思う。

上記のコードでは出力関数を作ったときと同じ a, b, c, i を使ったけど、現実のコード中では両方同時に使うのが普通だから名前を分けなければいけない(これは書式表現が関数ではなくて文字列の場合は考えなくてよい制約だ)。
バリエーションはそれだけではなくて、ビッグエンディアン用とリトルエンディアン用の区別もしなければならない。それに本当は int だけじゃなくて Int32 とか Int64 とか、符号の有無も追加したい。

それらの区別をすべて小文字で始まる識別子で表現しなければならない(これが OCaml 特有の制限だ)となると、書式表現としてはもう結構な長さになる。それでまったく使えないというわけではないけど…

ところでこのやり方の printf の OCaml 実装をまとめた Cpsio [3] というライブラリも検索で見つけたのでリンク。

[1] http://blog.so-net.ne.jp/rainyday/2006-08-15
[2] http://www.brics.dk/RS/98/12/index.html
[3] http://tkb.mpl.com/~tkb/software.html


OCaml で COM オートメーション [OCaml]

OCaml で COM オートメーション(OLE オートメーション)をするためのライブラリを作り始めた。COM オートメーションというのは主にスクリプト言語などから COM オートメーションに対応したアプリケーション(例えば Excel とか)を操作するためのインターフェイスのことである。

http://sourceforge.jp/projects/odispatch/

OCaml で COM オートメーションをやるためのライブラリには既に OCam'OLE [1] があるのでやっていることはまるっきり車輪の再発明なのだが、OCam'OLE にはいろいろと意にそぐわないところがあったので自分で作ることにした。

今のところ以下のように書ける。

let _ =
  let disp = createobject "Excel.Application" in
  let workbooks = disp//"Workbooks" in

  set disp "Visible" (VT_BOOL true);

  let _ = call workbooks "Add" [] in

  let range = call (disp//"ActiveSheet") "Range" [(VT_BSTR "A1:B10")] in
  set range "Value" (VT_BSTR "OCaml");

一見して問題が多い。例えば、

(1) メソッド名、プロパティ名を二重引用符で括って与えないといけない
(2) ヴァリアント型のコンストラクタを書かないといけない
(3) オブジェクト指向っぽい左から右に連鎖する書き方ができない(app.Workbooks("Book1.xls").Worksheet("Sheet1").Range("A1").Value=1みたいな)

(3) に関しては中置演算子 // を get 関数のエイリアスにすることで部分的に可能にしている(上記のコードには現れていないが get に限り連鎖もできる)が、かなり苦し紛れだ。OCam'OLE は目的の IDispatch インターフェイスからラッパー関数群を自動生成することで (1) を解決している(+型安全なプログラムができる)。だがどちらかというとひょっとしたら Camlp4 を使いこなせれば上記3つの問題を解決できるのかもしれないとも思う。

もっとも今回これを作っている目的は OCaml でスクリプト言語を作ってそこからこれを呼ぶことなので OCaml コード内でのシンタクスシュガーはそれほど必要としていない(それにその場合はむしろメソッド名・プロパティ名を実行時に扱えないといけないのだ)。なのでさしあたっては上記の問題は深く追求しないで先に進もうと思う。

[1] http://tech.motion-twin.com/ocamole.html


可変長引数の書式付バイナリ出力関数 [OCaml]

OCaml の printf 関係で検索していたら Caml-list の過去ログ [1] で紹介されていた論文 [2] に ML で printf っぽいものを作る一つのやり方が書いてあった。(ちなみにそのスレッドのフォローアップに OCaml には special
typechecking rules for format strings があるようなことが書いてあるのでやはり printf は特別ということらしい)

さて、[2] を参考に見よう見まねで当初の目的であった書式化バイナリ出力関数を作ってみた。fout というのが作りたかった関数だ。

# let ($) f g x = f (g x);;
val ( $ ) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>
# let a k s x = k (output_string s x; s);;
val a : (out_channel -> 'a) -> out_channel -> string -> 'a = <fun>
# let c k s x = k (output_char s x; s);;
val c : (out_channel -> 'a) -> out_channel -> char -> 'a = <fun>
# let b k s x = k (output_byte s x; s);;
val b : (out_channel -> 'a) -> out_channel -> int -> 'a = <fun>
# let i k s x = k (output_binary_int s x; s);;
val i : (out_channel -> 'a) -> out_channel -> int -> 'a = <fun>
# let fout out p = p (fun s -> s) out;;
val fout : 'a -> (('b -> 'b) -> 'a -> 'c) -> 'c = <fun>
# let out = open_out_bin "test.dat";;
val out : out_channel = <abstr>
# fout out (c$b$c$b$c$i$a) 'H' 0x65 'l' 0x6c 'o' 542601074 "ld";;
- : out_channel = <abstr>
#
ether@KURO-BOX:~$ od -h -c test.dat
0000000 4865 6c6c 6f20 576f 726c 6400
          H   e   l   l   o       W   o   r   l   d  \0
0000013
ether@KURO-BOX:~$

Obj.magic を使うのとは違って、この仕組みは型チェックがちゃんとなされる安全なものである。

# fout out (c$b$c$b$c$i$a)
  ;;
- : char -> int -> char -> int -> char -> int -> string -> out_channel =
<fun>
# fout out (c$b$c$b$c$i$a) 'H' 0x65 'l' 0x6c 'o' 542601074 'l';;
This expression has type char but is here used with type string

これはかなりいいと思う。少なくとも output_xxx を何行も書くよりはずっといい。
でもちょっと難点もある。それは書式指定を表現するのが文字(列)ではなく関数であるということで、当該名前空間の貴重な1文字識別子を消費してしまう。これは何か嫌だ。あと OCaml 固有の問題として大文字で始まる識別子を関数名に使えないので1文字で表現できる能力が限定される。だからといってあまり書式指定を長い識別子にしたり、モジュールにして例えば Fout.c$Fout.b$... なんて書きたくはない。

[1] http://caml.inria.fr/pub/ml-archives/caml-list/1999/03/f29ccf690732fd68d7c69079a7dc5a92.en.html
[2] http://www.brics.dk/RS/98/12/index.html


printf 続き [OCaml]

前回 [1] の myprintf は2引数をとる関数だったから部分適用できる。

# let f = myprintf "%s";;
val f : '_a -> unit = <fun>

'_a という、これまた馴染みのない型が出てきた。
調べてみるとこれは多相型ではなくて、まだ型が決まっていないというだけの状態を示すものらしい。続けて以下のように打ち込む。

# f "hello!";;
hello!- : unit = ()

そしてもう1回 f の型を確認してみる。

# f;;
- : string -> unit = <fun>

さっきとちがう。一度関数が完全に適用されると型が確定して string になるということのようだ。こうなると文字列以外を与えて f を呼び出すとコンパイルエラーになる。

# f 123;;
Characters 2-5:
  f 123;;
    ^^^
This expression has type int but is here used with type string

この状態までくると安全といえるけど、でもコンパイル時にこの状態に持っていくなんてできるんだろうか。やっぱり printf/scanf は OCaml コンパイラが特別視してあげてるのかな。

[1] http://blog.so-net.ne.jp/rainyday/2006-08-13-1


この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。