λx.x K S K @ はてな このページをアンテナに追加 RSSフィード

2008年10月11日

[] Pretty printers for tuples, variants, records, Sets and Maps.

10/4まで北京泊・10/5 京都泊・10/6 東京泊・10/7 機内泊・10/8からシドニー泊…という激しいスケジュールを経て NICTA を訪問中です. 最近,再び OCaml のコードをたくさん書く機会ができたので, 久しぶりに OCaml プログラミングに関するメモを公開します.

Ruby には p という便利な関数 (メソッド) があってどんな値でも可視化できますが, OCaml だと自分で書かなきゃいけなくて面倒です. extlib に Std.print という関数がありますが,これは実行時の値を出力する関数なので, 実行時に単なる組になってしまうレコードやバリアントではフィールドやコンストラクタの名前が失われてしまい,十分な可視化ができているとは言えません. このため,結局自分で書く必要があります. 今回紹介する print.ml はそれを補助するプログラムで,先日公開した Glid のソースにも使われています. 表示形式をわりと自由にカスタマイズできるので, printf デバッグ専門の人はもちろん, ocamldebug 使いにとっても (install_printer などを使えば) 役に立つと思います. 特に,

  • レコードの一部のフィールドは自分で定義した関数で表示したい
  • 一部の構築子の引数の出力を省略したい
  • Set や Map を可視化したいが,毎回書くのが面倒だ
というような場合に便利だと思います.

実際に print.ml について説明する前に, pretty printer (以下 PP) の関数の型について触れておきます. PP 関数は,単相型ごとに与えられ,型 t に対して

val pp_t : Format.formatter -> t -> unit
という型を持ちます. 第一引数Format.formatter を取る理由は, 整形して出力できることに加え, 対話環境で #install_printer に直接渡すことができるからです. Format.printf でのフォーマット中の "%a" と組み合わせられるので更に強力です. 以下では,型 t に対する PP 関数pp_t と書くことにします. また,多相型 'a t に対する PP は, 'a の PP を受け取るので,
val pp_t : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
という型を持ちます.従って int list 型に対する PP は pp_list pp_int で定義できるようになります. 順序が逆転してしまうのは型引数を先に書くという ML の流儀によるものです (Haskell などは順序通りに書けます). 同様に,多相型 ('a,'b) t に対応する PP は,
val pp_t : (Format.formatter -> 'a -> unit) * (Format.formatter -> 'b -> unit) ->
           Format.formatter -> ('a,'b) t -> unit
を持ちます.好みに応じてカリー化しても構いませんが, この形で使った方が (int, string) t 型に対応する PP が pp_t (pp_int, pp_string) と書けるので,型とその PP がきれいに対応します.

さて,ここからは print.ml の内容と使い方の説明です. print.mlこちらで配布しています. 以下,(* print.ml ... *)で始まる部分は,配布した print.ml 内にあるので, 使う側は記述する必要はありません. (* 使い方 *)で始まる部分を参考に,お好みの PP を作成してください. (* 使い方 *)の部分は, ocamlc -c print.mlコンパイルして ocaml print.cmo と対話環境を起動し, open Print している状態を想定しています.

(* print.ml (1) *)
open Format
let pp_unit fmt () = pp_print_string fmt "()"
let pp_bool = pp_print_bool
let pp_int = pp_print_int
let pp_float = pp_print_float
let pp_char fmt = fprintf fmt "%C"
let pp_string fmt = fprintf fmt "%S"
まず,Format モジュールを open してから,各基本型に対応する PP を用意しています. 使い方は,
(* 使い方 *)
# Format.printf "x = %a@." pp_int 3;;
x = 3
- : unit = ()
# Format.printf "s = %a@." pp_string "hoge";;
s = "hoge"
- : unit = ()
という感じです.これらは,単独で使うことは少ないのであまり面白くない例ですが, 他の多相型に対する PP を作るときに便利なので導入しています.

次は,'a list 型に対応する PP です. 多相型なので要素の型に対応する PP 関数 pp_a を受け取って,以下のように与えられています.

(* print.ml (2) *)
let pp_list pp_a fmt xs =
  fprintf fmt "@[<1>[";
  begin match xs with
    | [] -> ()
    | x::xs ->
        pp_a fmt x;
        List.iter (fprintf fmt ";@;%a" pp_a) xs end;
  fprintf fmt "]@]"
pp_list は以下のようにして使います.
(* 使い方 *)
# let pp_int_list = pp_list pp_int;;
val pp_int_list : Format.formatter -> int list -> unit = <fun>
# Format.printf "List of integers : %a@." pp_int_list [1;2;3];;
List of integers : [1; 2; 3]
- : unit = ()
# Format.printf "List of lists of strings : %a@." (pp_list (pp_list pp_string))
    [["This";"is";"a"];["nested";"list."];["The";"type";"is"];["string";"list";"list."]];;
List of lists of strings : [["This"; "is"; "a"]; ["nested"; "list."];
                            ["The"; "type"; "is"];
                            ["string"; "list"; "list."]]

さて,ここからのソースは難解です. 10年以上 OCaml (OLabl) を触ってきた自分でも毎回解読に時間がかかります. ただ,使う側からすればソースを理解する必要は全く無いので, (* 使い方 *)のコードだけ見て憶えれば十分です. 難解になっている理由は,一般的な型に対する PP の作成支援に必要なヘテロなリストが, 以前ここでも記事にした存在型の実装を利用しているためです.

(* print.ml (3) *)
type pp_poly = { pp_poly: 'b. 'b pp_neg -> 'b }
and 'b pp_neg = { pp_neg: 'a. (formatter -> 'a -> unit) -> 'a -> 'b }
let pp_poly pp_a x = { pp_poly = fun k -> k.pp_neg pp_a x }
let apply_pp_poly fmt p = p.pp_poly { pp_neg = fun pp_a -> pp_a fmt }
pp_poly は,∃α.(formatter -> α -> unit) という型を表します. この型をもつ値は,関数 pp_poly に型 α に対応する PP とその型の値を渡すことで作れます. apply_pp_polypp_poly 型の値を関数として使うことができますが, print.ml を使うだけの人は憶えなくて構いません. 「関数 pp_poly で PP に必要なヘテロなリストを作れる」ということだけ憶えれば十分です. 具体的な使い方については,後に示す組 (tuple) 型,ヴァリアント型,レコード型に対応する PP の作り方をご覧ください.

組型に対する PP は,任意個の任意型の値を扱うので,ヘテロなリストが必要になります. print.ml では, まず pp_poly 型のリストを ',' で接続された組型の形式で出力するための関数を定義しています.

(* print.ml (4) *)
let pp_poly_list fmt = function
  | [] -> ()
  | p::ps ->
      fprintf fmt "@[<1>(%a" apply_pp_poly p;
      List.iter (fprintf fmt ",@;%a" apply_pp_poly) ps;
      fprintf fmt ")@]"
組型に対応する PP を作成するのにこれをそのまま使ってもよいですが, formatter を意識しないで PP を作成できるように pp_tuple を以下のように提供しています.
(* print.ml (5) *)
(* pp_tuple : ('a -> pp_poly list) -> formatter -> 'a -> unit *)
let pp_tuple make_pps fmt x = pp_poly_list fmt (make_pps x)
下のような感じで使います.
(* 使い方 *)
# let pp_tuple_int_string_char =
    pp_tuple (fun (i,s,c) -> [pp_poly pp_int i; 
                              pp_poly pp_string s;
                              pp_poly pp_char c]);;
val pp_tuple_int_string_char :
  Format.formatter -> int * string * char -> unit = <fun>
# Format.printf "Tuple of integer, string and character : %a@."
    pp_tuple_int_string_char (3,"hoge",'A');;
Tuple of integer, string and character : (3, "hoge", 'A')
- : unit = ()
pp_poly 型のリストを作るときは,各要素を関数 pp_poly で作る必要がありますが, これを List.map 等を使って簡略化することはできません. 理由については実際に試してみるとよくわかると思います.

次は,ヴァリアント型に対応する PP です.多相ヴァリアント型にも同様に使えます. [追記] 但し,拡張も縮小もできない多相ヴァリアント型に制限されているので,入力の型を明示する必要があります.

(* print.ml (6) *)
(* pp_variant : ('a -> string * pp_poly list) -> Format.formatter -> 'a -> unit *)
let pp_variant make_cps fmt x =
  let cname, ps = make_cps x in
  fprintf fmt "%s%a" cname pp_poly_list ps
以下のように使います.
(* 使い方 *)
# type color = Black | White | Gray of int | RGB of int * int * int;;
type color = Black | White | Gray of int | RGB of int * int * int
# let pp_color = pp_variant (function
                               | Black -> "Black", []
                               | White -> "White", []
                               | Gray i -> "Gray", [pp_poly pp_int i]
                               | RGB(r,g,b) -> "RGB", [pp_poly pp_int r;
                                                       pp_poly pp_int g;
                                                       pp_poly pp_int b]);;
val pp_color : Format.formatter -> color -> unit = <fun>
# Format.printf "Color is %a.@." pp_color (RGB(140, 182, 255));;
Color is RGB(140,182,255).
- : unit = ()
変数を含むヴァリアント型については, print.ml で与えられている option 型に対応する PP のコードが参考になると思います.
(* print.ml (7) *)
let pp_option pp_a =
  pp_variant (function
                | None -> "None", []
                | Some x -> "Some", [pp_poly pp_a x])
pp_list と同様に,中身に対応する PP を渡すことで PP が作成できます.
(* 使い方 *)
# Format.printf "maybe = %a@." (pp_option pp_int) (Some(42));;
maybe = Some(42)
- : unit = ()
残念ながら,面倒なので括弧の省略は全く考えていません. 再帰型の場合は,PP 関数再帰で定義されます.
(* 使い方 *)
# type 'a bin = Tip of 'a | Fork of 'a bin * 'a bin;;
type 'a bin = Tip of 'a | Fork of 'a bin * 'a bin
# let rec pp_bin pp_a = pp_variant (function
                                      | Tip x -> "Tip", [pp_poly pp_a x]
                                      | Fork(t1,t2) -> "Fork", [pp_poly (pp_bin pp_a) t1;
                                                                pp_poly (pp_bin pp_a) t2]);;
val pp_bin :
  (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a bin -> unit =
  <fun>
# Format.printf "Tree = %a@." (pp_bin pp_int) (Fork(Fork(Tip 1,Tip 2),Tip 3));;
Tree = Fork(Fork(Tip(1), Tip(2)), Tip(3))
- : unit = ()
実は,型引数を持たない再帰型の場合は,η 展開が必要です.
# type int_bin = IntTip of int | IntFork of int_bin * int_bin;;
type bin = IntTip of int | IntFork of int_bin * int_bin
# let rec pp_int_bin fmt =
    pp_variant (function
                  | IntTip x -> "IntTip", [pp_poly pp_int x]
                  | IntFork(t1,t2) -> "IntFork", [pp_poly pp_int_bin t1;
                                                  pp_poly pp_int_bin t2]) fmt;;
となって書きにくく formatter を意識させないというコンセプトに反してしまうので, この辺りは改善の余地がありますね. [追記] 内側の pp_int_bin に関しては η 展開が必要なかったので修正しました.

最後に,レコード型に対する PP の作成です.

(* print.ml (8) *)
(* pp_record : ('a -> (string * pp_poly) list) -> Format.formatter -> 'a -> unit *)
let pp_record make_pp_fields fmt x =
  let apply_pp_field fmt (f,p) = fprintf fmt "@[<2>%s = @,%a@]" f apply_pp_poly p in
  fprintf fmt "@[<1>{";
  begin match make_pp_fields x with
    | [] -> ()
    | fp::fps ->
        apply_pp_field fmt fp;
        List.iter (fprintf fmt ";@;%a" apply_pp_field) fps end;
  fprintf fmt "}@]"
ヴァリアント型に対する PP と同様に,関数を受け取る形を取っています. [追記] フィールドごとに整形されるようにブロックを追加しました. これに合わせて配布中の print.ml も更新しています. 以下のように使います.
(* 使い方 *)
# type polar = { radial: float; angle: float };;
type polar = { radial : float; angle : float; }
# let pp_polar = pp_record (fun x -> ["radial", pp_poly pp_float x.radial;
                                      "angle", pp_poly pp_float x.angle]);;
val pp_polar : Format.formatter -> polar -> unit = <fun>
# Format.printf "polar = %a@." pp_polar { radial = 1.05; angle = 3.14 };;
polar = {radial = 1.05; angle = 3.14}
- : unit = ()

配布している print.ml では, おまけとして Set.S.t や Map.S.t に対する PP の作成を支援するファンクタも用意しています.

(* print.ml (9) *)
module Set = struct
  module Make(Ord:Set.OrderedType) : sig
    include Set.S with type elt = Ord.t
    val pp_t : (Format.formatter -> elt -> unit) -> Format.formatter -> t -> unit
  end = struct
    module S = Set.Make(Ord)
    include S
    let pp_t pp_elt fmt set =
      fprintf fmt "@[<1>{";
      ignore (S.fold (fun elt is_fst ->
                        if is_fst then pp_elt fmt elt
                        else fprintf fmt ",@;%a" pp_elt elt;
                        false) set true);
      fprintf fmt "}@]"
  end
end

module Map = struct
  module Make(Ord:Map.OrderedType) : sig
    include Map.S with type key = Ord.t
    val pp_t :
      (Format.formatter -> key -> unit) -> (Format.formatter -> 'a -> unit) ->
      Format.formatter -> 'a t -> unit
  end = struct
    module M = Map.Make(Ord)
    include M
    let pp_t pp_key pp_a fmt map =
      fprintf fmt "@[<1>{";
      let pp_each key fmt v = fprintf fmt "@[<2>%a => @,%a@]" pp_key key pp_a v in
      ignore (M.fold (fun key v is_fst ->
                        if is_fst then pp_each key fmt v
                        else fprintf fmt ";@;%a" (pp_each key) v;
                        false) map true);
      fprintf fmt "}@]"
  end
end
print.mlコンパイルすれば,以下のように使うことができます.
(* 使い方 *)
# module IntSet = Set.Make (struct type t = int let compare = compare end);;
...(出力は省略)...
# let pp_int_set = IntSet.pp_t pp_int;;
val pp_int_set : Format.formatter -> IntSet.t -> unit = <fun>
# Format.printf "IntSet = %a@." pp_int_set
    (IntSet.add 1 (IntSet.add 2 (IntSet.singleton 3)));;
IntSet = {1, 2, 3}
- : unit = ()
# module StrMap = Map.Make (struct type t = string let compare = compare end);;
...(出力は省略)...
# let pp_str_int_map = StrMap.pp_t pp_string pp_int;;
val pp_str_int_map : Format.formatter -> int StrMap.t -> unit = <fun>
# Format.printf "int StrMap = %a@." pp_str_int_map
    (StrMap.add "hoge" 1 (StrMap.add "fuga" 2 StrMap.empty));;
int StrMap = {"fuga" => 2; "hoge" => 1}
- : unit = ()
要するに,open してから Set.MakeMap.Make を普段通り使うだけです. あとは,そのモジュールpp_t を利用すれば PP を作成できます.

長くなりましたが,OCaml プログラマならこれくらいは (たぶん) 各自で用意しているような気がします. 各型に対する PP を毎度毎度書くのが面倒なので,自分の中では結構活用しています.

スパム対策のためのダミーです。もし見えても何も入力しないでください
ゲスト


画像認証