Hatena::ブログ(Diary)

::Eldesh a b = LEFT a | RIGHT b このページをアンテナに追加 RSSフィード Twitter

2014-12-10

kitlibをSML/NJとSML#に移植

kitlibというSMLライブラリSML/NJSML#に移植しました*1。 #全く誰も嬉しくないと思いますが(^^;;


kitlibはMLKitという処理系を実装されているElsman先生が作っているSMLライブラリ集です。

元々はMLKitのソースコードと一緒に配布されていましたがライブラリとして切り出したようですね。*2


移植と言っても処理系依存の箇所はほとんど無いので、実際はMakefile(と.cmと.smi)を書いたくらいです。

ライブラリに含まれる機能としては 正規表現、Pickle(シリアライズ/デシリアライズ)、Map(コンテナ)等、ありがちな内容なのでsmlnj-libや他のライブラリが使えるならそちらを使えばいいと思いますが、この手の小回りの効くライブラリはいくつか選択肢にあると安心かも知れません。


注意

SML/NJとSML#はそれぞれ別の個所でpickle(バイナリシリアライザ)のテストに失敗する個所があるのでどれかの処理系が怪しいかも知れません。

あんまり突き詰めたくないのですが、やる気が出たら原因究明しようと思います。

*1:pull requestがスルーされているようなのでもう紹介しちゃいます

*2:他のSMLプロジェクトをガリガリ書いているようなのでそのためでしょう

2014-12-07

SMLでDynamic(再び)


この記事は ML Advent Calendar 2014 7日目の記事です。


ここではSMLによるDynamic(あるいはAny)と呼ばれる*1、任意の型の値を保持出来るテクニックを紹介します。

任意の型の値を保持可能な型という内容は 以前も紹介したことがあります(2) が、前回紹介した実装では例外を使っており、プログラム作法またはパフォーマンスに懸念があるかも知れません。プログラマの心理的にもよろしくなさそうです。

この記事では例外を使わずポータブルなコードのみで同等の振る舞いを実現するテクニックを紹介し、実装を理解出来るように解説します。


序/Dynamicの必要性

StandardMLでジェネリックなコードを書こうとすると、型に応じて処理を切り替えるということが一切出来ないことがネックになります。(その代わり型が完全に推論される)

しかしどうしても型によって振る舞いを変えたい場合があり、そういった場合はどこかで妥協する必要が出てきます。

その妥協のひとつの方法として、型と同名の値(or関数)と、そのコンビネータを提供することでユーザに型*2を強制的に指定させる手法が知られています(3)。

この手法は型ごとの振る舞いのデータベースを(暗黙に)構成出来ることが重要ですが、それにはここで紹介する Dynamic を駆使して UniversalType と呼ばれるテクニックを用いることで実現出来ます。


振る舞い

まず簡単なユースケースから見ていきます。

Dynamicは以下のようなシグネチャを持ち、例外を用いた実装と変りません。

structure Dynamic : sig
  type t
  type 'a key : ('a -> t) * (t -> 'a option)

  val mk : unit -> 'a key
  val emb : 'a key -> 'a -> t
  val prj : 'a key -> t -> 'a option
end = ...

t 型に(任意の型の)値を保持させ、'a key を使って対応する型の値を設定または取り出します。

埋め込みと取り出しには emb/prj という名前が付けてありますが、自分でkeyタプルを分解しても同じです。

- structure D = Dynamic;
(* 型タグを作成 *)
- val int : int D.key = D.mk()
- val string : string D.key = D.mk()
- val int_string : (int * string) D.key = D.mk()

- val val0 = D.emb int 314      (* intの値を埋め込み *)
val val0 = - : Dynamic.t

- val get = D.prj int val0      (* int 型の値を問い合わせる *)
val get = SOME 314 : int option (* 入れた値が出てくる *)

- val get = D.prj string val0   (* string 型で問い合わせてみる *)
val get = NONE : string option  (* 入ってない *)

図にしてみました。

それぞれの型に対応するキーを使って Dynamic.t 型の値に問い合わせを行い、値を取り出します。

値を設定した時のキー(型)以外を使って問い合わせるとNONEが返ります。

f:id:eldesh:20141206234757p:image

混成リスト

お約束ですが Dynamic の分かりやすい適用先として、互いに異なる型の値から出来たリスト(混成リスト)の作成があります。

以下の例では int,string,int*string の値からなるリストを構成し、それぞれに対する一般化toStringを定義;適用しています。

- val hlist =
      [D.emb int 256
      ,D.emb string "hello"
      ,D.emb int_string (1414, "good bye.")
      ];
val hlist = [-,-,-] : Dynamic.t list (* いろいろな型の値が入ったリスト *)

- fun maybe _  NONE    n = n ()
    | maybe t (SOME x) _ = t x

- fun IStoString (x,s) = concat["(",Int.toString x,",",s,")"]

- fun toString d = (* Dynamic用toString *)
  maybe Int.toString (D.prj int        d) (fn()=>
  maybe (fn x=>x)    (D.prj string     d) (fn()=>
  maybe IStoString   (D.prj int_string d) (fn()=>
  "unkown type")))
val toString = fn : Dynamic.t -> string

- map toString hlist;
val it = ["256","hello","(1414,good bye.)"] : string list (* それぞれを文字列に変換出来た *)

実装

では実装を示します。

短いですが読んでいきなり理解するのはかなり難しいと思います。

structure Dynamic :> DYNAMIC =
struct
  datatype any = V of {
                    disclose:   unit -> unit,
                    undisclose: unit -> unit
                 }
  type t = any
  type 'a key = ('a -> t) * (t -> 'a option)

  fun mk () =
    let
      val box = ref NONE (* 通信チャネル *)
      fun discloser v () = box := SOME v
      fun undiscloser () = box := NONE
      fun mkV v = (* それぞれが box にアクセスするサンク *)
         V { disclose   = discloser v,
             undisclose = undiscloser }
      fun useV (V {disclose, undisclose}) =
        ( box := NONE;  (* mkV したときと同じ box にアクセスするなら *)
          disclose ();  (* 同じ box に v を書く *)
          let val v = !box (* すぐに取り出す *)
          in undisclose(); v end )
    in
      (mkV, useV)
    end

  fun emb (f,_) = f
  fun prj (_,f) = f
end

見ての通り、例外(やその他怪しい機能)は一切使っていません。

ですがかなり入り組んだリファレンスの使い方をしています。


以下に概念図を書いてみました。

f:id:eldesh:20141207001434p:image

mkとuseVの使う関数が一致している場合、クロージャ内の box を介して通信していることがポイントです。

useVを使う際(=値を取り出す時)、同じ box の実体を共有する場合は、「キーが一致した」ことになり、discloseが書いた値を直後に取り出すことになります。

そうで無い場合は、useVに渡したdiscloseが値を設定したものとは異なる box の実体に値を設定しているため、box に何も設定されていないままの値、つまり NONE が取り出されます。

box に実際に値が書かれるのは useV 内で値を取り出す直前だということに注意して下さい。ユーザが埋め込んだ(embした)値は mkV の返すクロージャに含まれています。


結び

例外を用いずにDynamicを実装する方法を見てきました。 #理解できたでしょうか?

これはリファレンスの便利さに加えて、通常考えられている以上に強力な機能だということも示しています。

自明な挙動をするように見えるSMLのコードでも、リファレンスが絡むと挙動を簡単には理解出来ないようなプログラムになることがある、ということは気を付けておくとよいでしょう。

参考/出典

*1:大抵こういう名前のstructureとして提供される

*2:のような値

2014-11-30

MLtonでWin32APIを呼び出す

f:id:eldesh:20141130004119p:image:right


Cygwin上のMLton*1でWin32APIを使用する簡単な例を紹介します。

以下の2つの例では異なる方法で右図のようなメッセージボックスを表示します。

コード全体はgistに置いてあります。


direct call

_import 式でシンボルと型を書くとお手軽に外部関数が使えます。

local
  val MessageBoxA =
        _import "MessageBoxA" stdcall: C_Pointer.t * string * string * Word32.word -> int;
in
  val _ = MessageBoxA (C_Pointer.null, "Hello World!", "MLton Static FFI", 0w4096)
end

indirect call

libdlを使って共有ライブラリから取り出した関数ポインタを呼ぶ方法もあります。

関数ポインタを呼び出す場合、 import式に `*' を指定します。

local
  val double_to_double = _import * : DynLink.fptr -> real -> real;
  val user32 = DynLink.dlopen ("user32.dll", DynLink.RTLD_LAZY)
  val sigMessageBoxA =
    _import * : DynLink.fptr -> C_Pointer.t * string * string * Word32.word -> int;
  val msgbox_ptr = DynLink.dlsym (user32, "MessageBoxA")
  val dynMessageBoxA = sigMessageBoxA msgbox_ptr
in
  val _ = dynMessageBoxA (C_Pointer.null, "Hello World!", "MLton Dynamic FFI", 0w4096)
  val _ = DynLink.dlclose user32
end

ビルド

allowFFI を有効にしてビルドする必要があります。

# cat win32.mlb
ann "allowFFI true" in
	$(SML_LIB)/basis/basis.mlb
	$(SML_LIB)/basis/mlton.mlb
	$(SML_LIB)/basis/c-types.mlb
	dynlink.sml
	win32.sml
end
# mlton win32.mlb

参考

*1win7(64bit) + mlton{20100608|20130715}で確認

2014-11-28

SML/NJでスタックトレースを表示する


SMLではコード中のほとんどどこからでも例外が投げられるのですが、それがどこから投げられたかを追跡するポータブルな方法は存在しません。

ただしSML/NJでは例外が投げられた時にスタックトレースを表示することが出来たので方法を紹介します。

#なお、ドキュメントは存在しない模様orz


実行例

以下のコードの場合の実行結果を示します。

error() で投げられる例外が、wrap1..4 の呼び出しを巻き戻して上がってきます。

fun error () = (raise Fail "error!";())
fun wrap1 () = error ()
fun wrap2 () = wrap1 ()
fun wrap3 () = wrap2 ()
fun wrap4 () = wrap3 ()

fun main' (_, _) =
   OS.Process.success before wrap4();

fun main (name, argv) =
  BackTrace.monitor(fn () => main'(name, argv))

実行した結果、以下のようなログが得られます。

$ sml @SMLload=stacktrace

*** BACK-TRACE ***
GOTO   stacktrace.sml:7.7-7.42: StackTrace.error[2]
          (from: stacktrace.sml:8.18-8.26: StackTrace.wrap1[2])
GOTO   stacktrace.sml:8.7-8.26: StackTrace.wrap1[2]
          (from: stacktrace.sml:9.18-9.26: StackTrace.wrap2[2])
GOTO   stacktrace.sml:9.7-9.26: StackTrace.wrap2[2]
          (from: stacktrace.sml:10.18-10.26: StackTrace.wrap3[2])
GOTO   stacktrace.sml:10.7-10.26: StackTrace.wrap3[2]
          (from: stacktrace.sml:11.18-11.26: StackTrace.wrap4[2])
CALL   stacktrace.sml:11.7-11.26: StackTrace.wrap4[2]
          (from: stacktrace.sml:14.6-14.39: StackTrace.main'[2])
GOTO   stacktrace.sml:13.7-14.39: StackTrace.main'[2]
          (from: stacktrace.sml:17.32-17.49: StackTrace.main[2])
GOTO   stacktrace.sml:17.23-17.49: StackTrace.main[2]
          (from: stacktrace.sml:17.5-17.50: StackTrace.main[2])
CALL   stacktrace.sml:16.7-17.50: StackTrace.main[2]
          (from: 4120-export.sml:1.38-1.90: XYZ_XXX_0123)

stacktrace.sml:7.25-7.38: Fail: error!

いい感じですね。スタックの底から順に表示されるようです。

main関数から wrap4 の呼び出し以外は全部ジャンプになっているようです。賢い。


使い方

CMファイルで指定する方法と、REPLからその場で使う方法があります。

ちょっと普通と違うので注意。

CMファイルで指定

$smlnj-tdp/plugins.cm を依存関係に追加します。

group
is
  $/basis.cm
  $smlnj-tdp/plugins.cm
  stacktrace.sml

ビルドの段階でTDPモードの指定と、セットアップ用に back-trace.cm を指定します。

この場合、ヒープファイル名の省略は出来ません。

$ ml-build -Ctdp.instrument=true \$smlnj-tdp/back-trace.cm stacktrace.cm StackTrace.main stacktrace

あとは普通に実行するだけ。

$ sml @SMLload=stacktrace
REPLから使用

いきなり $smlnj-tdp/back-trace.cm を読み込んだ後、内部モジュールフラグを書き換えてから use します(makeではダメ)。

sml> CM.make "$smlnj-tdp/back-trace.cm";
sml> SMLofNJ.Internals.TDP := true;
sml> use "stacktrace.sml";
sml> StackTrace.main(CommandLine.name(), CommandLine.arguments());

..(上に同じ)..

参考

2014-11-25

GCCをクロスビルドする

linux上で「mingwバイナリを吐くgcc」をビルドする方法を調べた。

#正確には「linux(i386)ホスト上でmingw(32bit)用のバイナリを作る」gccがビルドしたかった


方法を説明したサイトはかなりいろいろあるけど見つけた中で一番簡単だったのはこれ。*1

> http://ffmpeg.zeranoe.com/blog/?p=383#more-383

以下のスクリプトを実行するだけでその場にgcc一式がビルドされる。すばらしく簡単。

# @Linuxホスト
cd /path/to/mingw-dev/
wget http://zeranoe.com/scripts/mingw_w64_build/mingw-w64-build-3.6.4
bash mingw-w64-build-3.6.4 [--build-type=win32]

ちなみに、mingw-w64 はそういうプロダクト名であって64bit版のmingwでは無い(32bit版もある)ようだ。ひどい。

使い方

gccを直接使う場合
# @Linuxホスト
/path/to/mingw-dev/i686-w64-i686/bin/i686-w64-mingw32-gcc hoge.c
# @Windows.Mingw
./a.exe
autoconfを使う場合

--host を指定する。

大分非直感な気がするが、「コンパイルして得られたプログラムが動く」ホストを指定するものらしい。

じゃあ --target は何かというと、「「コンパイルされたコンパイラ」が出力するバイナリ」が動く環境を指定する…ようだ(自信無し)。

./configure --host=i686-w64-mingw32
make

configureの出すメッセージに ...whether we use cross compiler? ... yes みたいな行があれば、クロスコンパイラが指定出来てる気がする。


依存関係のある場合はCFLAGSとLDFLAGSで指定できる。

CFLAGS="-L/path/to/mingw/lib" LDFLAGS="-lgmp" ./configure --host=i686-w64-mingw32
make

感想

自分で1から手動ビルドする場合、オプションが長大だったり、パッチを当てたりする必要があり予想より大分大変そうだ。*2

ターゲットがmingwならどうせwindows上で作業すればどうにかなるはずのシロモノなので、慣れてないならそっちで頑張った方が分かり易いかも知れない。

*1:但しバイナリパッケージで済むなら多分それが最も楽っぽい

*2:大学でマイコンを弄くった時にも触っていたはずなんだけど、あれはバイナリをどこからか持って来たんだったかな…?