ocaml to sml
所要で上京。この機を逃さず、銀座の林檎屋を偵察。初めて行ったけど混雑してますなあ。 老いも若きも皆真剣そのもので吟味中。スタップの方は、とっても親切でフレンドリィー。
おいらのipadは、まだ7にしてないんで、ここで7の感触を確かめたよ。いいんでないかい。 少なくても、窓7から8への移行よりは断然ユーザーの気持ちを考えてくれているよ。
窓7のマシンが若し壊れたら、窓8には多分しないね。その代替は林檎のマシンかな。 これなら、デフォでBSD(改)が入ってるから、デストロをあれこれする必要ないからね。 スタップの人に、コンソールはどうやって開くんですか？ って聞いたよ。Appの中の ユーティｒティに置いてあった。まあ、妥当な場所か。
bashが張り付いて80x24の端末が出てきた。topとかduとかrubyとかpythonとかemacsとか 普通に入ってた。林檎印のBSDを使うようになるのは何時だろう？
そうそう、おいらに取っちゃ大事な用件、英語キーボードモデルは有りますか？ って聞いたら 勿論との事。在庫確認しましょうかと、向こうの人は売り込みモードに入ってましたよ。 こちらの方も英語キーボードを 選択されたようで、ウブに浮気(本命？)するためのハードとしてMACを選んでる風でした。
巣鴨でみやげを調達。四の市とかで、東京中の婆が集まってきた感じ。巣鴨信金の大 サービスとかもやってて、地域の皆様に愛されてますなあ。巣鴨名物の2枚で1000円也の 赤色ズロースが飛ぶように売れてました。縁起物だからねぇ。
おいらは、とげぬけ地蔵をすりすりしようと思ったんだけど、婆パワーに圧倒されて はじき飛ばされちゃったぞ。しょうがないので、地蔵さんのたもとで売ってた、幸福だんご を食べて、御利益を祈る。
すぐ近くにある有名なカレー屋に入ろうとした、大行列。諦めて、古奈屋のクリーミーカレーうどん 匠揚げを買って、食べた積もりになったよ。後は塩大福ですな。赤褌は見つからなかった、 残念。
上京中はお付き合い頂き、献本してくださった、某さんに感謝。
diff -c ocaml sml
前回、sml mlton smlsharp に出合ったので、折角だから例題をやっておく。例によって お題は、retro.mlの移植だ。これ、程よくいろいろな機能を使っていて勉強するには 好都合だ。
で、いきなり取り掛かってもいいんだけど、ocamlとsmlの機能の差を見ておこう。 ocaml人口を増やしたくて、ocaml.jpには、 関数型言語の比較 なんてのが用意されてるけど。。自分で調べてみるのも一興かと。
タプルは便利、ocamlだと、括弧でくくらんくて、カンマで区切ってデータを並べてく だけで、組になってくれる。対してsmlは、ちゃんと括弧でくくらないと組とは 認めんというかたくな態度。
これが迷いを生むのよ。移植元のコードの中にあった奴。
dyadic2 (fun x y -> y / x, y mod x) (* divmod *)
これの意味が明確に理解出来ず。 A Concise Introduction to Objective Caml のタプルの使い方を見て、やっと納得しましたよ。上記コードは、内部関数扱いになってて 状況が把握出来なった（と言い訳しとこう）というものあるけど。
smlで実験すると、こんな具合。
- fun hoge x y = (x div y, x mod y, x + y, x - y, x * y) ; val hoge = fn : int -> int -> int * int * int * int * int - hoge 10 3 ; val it = (3,1,13,7,30) : int * int * int * int * int
もう一つ、タプルの話題で、ocamlにある、fstとかsndはsmlには無いの？ まさかね。 シャープ番号っていう関数らしくない関数が用意されてる。番号は１から始まる。 フランス人がfirstを短縮したfstを使ってるのに、ニュージャージーの人は番号指定で 余計な負荷を下げている。どんな風に使うかと言うと、上の例に続いて
- #4 it ; val it = 7 : int
何番までサポートしてるかは知らないけど、確かにこちらの方が融通はききそうだ。
続いてocamlでは、普通に使う演算子がデフォで、前置と中置をサポートしてるんだけど、 smlは、そうなっていない。
- 3 + 5 ; val it = 8 : int - + (3,5) ; stdIn:2.1 Error: expression or pattern begins with infix identifier "+" - nonfix + ; nonfix + - + (3,5) ; val it = 8 : int
nonfix ってのを使って、中置を解除しろとな。そして、引数は組で渡すんだぞってのは、 sml界の暗黙の了承事項です。
- 3 + 5 ;
stdIn:4.1-4.6 Error: operator is not a function [literal]
operator: int
in expression:
3 +
- infix + ;
infix +
- 3 + 5 ;
val it = 8 : int
元に戻すには、ちゃんと指定する事。あいまいさの排除に効果があるのかな。infix と言えば、 smlには面白い機能が有ったんだ。関数合成。
- fun nix x = x * 2 ; val nix = fn : int -> int - val many = nix o nix o nix o nix ; val many = fn : int -> int - many 2 ; val it = 32 : int
最初nixって言う、引数を２倍する関数を定義。次はその関数をoというinfix演算子を使って 関数合成。定義をvalで行うのが味噌かな。合成を使わないで書くとするとnix(nix(nix(nix x)))って 具合に、lispっぽくなっちゃう。括弧が目障りな人、ご用達。自分で定義するなら、
- infix ~ ;
infix ~
- fun f ~ g = fn x => f (g x) ;
val ~ = fn : ('a -> 'b) * ('c -> 'a) -> 'c -> 'b
- val my = nix ~ nix ~ nix ~ nix ;
val my = fn : int -> int
- my 2 ;
val it = 32 : int
ocaml.jpでも、演算子って事で、取り上げ られていた。
そうそう、valとfunの使い分けも厳格だなあ。ocamlみたいに何でもletじゃないもん。 ここら辺は、commonLisp風なんだな。逆にocamlはscheme風か。どちらがいいかは、その 人の趣味というか過去の言語遍歴によるのかな。
smlには、WordとかWord8とかの型がある。Word型を使うとMS Office様ご一行のファイルを 取り込めるかと思ったら、そうじゃ無かった。別にswl業界の人はM$に癒着してる訳では無く、 Word型で、バイナリー型を表している。ちょっとセンスが悪いと思うぞ。
論理andとかxorを取ろうとすると、一度Word型に変換してからじゃないと駄目だ。 確かに整数をBit列と看做してandを取るなんてのは、便利ではあるけど、型に五月蝿い人 に取っては看破出来なかったんだろうな。で、その弊害が。。。
- val x = Word.fromInt ~1 ; [autoloading] [library $SMLNJ-BASIS/basis.cm is stable] [autoloading done] val x = 0wx7FFFFFFF : word - Word.toInt x ; uncaught exception Overflow [overflow] raised at: <file stdIn>
整数の世界(の －１)から一度、Word界に入り、また元に戻そうとしたんだ。そしたら エラーを喰らったぞ。これは重い足枷だぞ。おまけにintのBit幅は31Bitって言う伝統も あるしね。ああ、31Bit幅はocamlも一緒か。
手動patchと言うか、何というか
早速、上記の調査を元にocaml用ソースをsml用に変換してみる。変換と言うよりpatch当て と言った方が適切かな。
ocamlに有った制御構造、forがsmlには無い。代わりを務めるのはwhileだ。forからwhile への書き換えは簡単だけど、終了条件の用意が、今回のケースでは面倒そう。だって、ファイル サイズを調べているんだもん。で、がらっと書き換えてみた。EOFが出て来るまで、突き進め 方式にね。
fun load () =
let
open BinIO
val p = openIn image_file
fun buildInt (SOME a, SOME b, SOME c, SOME d) =
if Word8.andb(d, 0wx40) = 0wx40 then (* negative *)
(Word8.toInt (Word8.andb ((Word8.notb d), 0wx3f)) * 16777216
+ Word8.toInt (Word8.notb c) * 65536
+ Word8.toInt (Word8.notb b) * 256
+ Word8.toInt (Word8.notb a)) * ~1 - 1
else (* positive *)
Word8.toInt d * 16777216
+ Word8.toInt c * 65536
+ Word8.toInt b * 256
+ Word8.toInt a
fun rom (_, NONE, _, _, _ ) = ()
| rom (i,a,b,c,d) = (
update(ram, i, buildInt(a,b,c,d));
rom(i + 1, input1 p, input1 p, input1 p, input1 p)
)
in
rom(0, input1 p, input1 p, input1 p, input1 p) ;
closeIn p
end
再帰大好きバージョンで、ちまちまと１バイトづつ読み込んでいる。バイトが読めれば SOME a が帰ってくるし、EOFに達していたら、NONE が帰って来るんだ。４バイト読み込んで 、それを整数に組み立てている。負数か否かを判定して、負数なら、最上位バイトを反転し ２ビット分を落としてから整数領域へ持って行って桁数を掛ける、なんて面倒な事をやってる。 そして、－１を掛けてから１を引き、正しい負の数に戻してる。正直めんどう臭い。
実は上記コードを最初から書いていた訳では無い。最初に書いたコードを走らせたら
uncaught exception Overflow [overflow] raised at: <file j.sml> /usr/local/smlnj/bin/sml: Fatal error -- Uncaught exception Overflow with 0 raised at <file j.sml>
エラーが出たよっていうM$並みの報告を受けて、頭をかかえたのさ。exceptionの時、 もう少し詳細を報告してくれる方法って有るんかね？ しょうがないので、romの所に print文を入れて、どの辺を読んでる時に発生したか確認。
00000180 00 00 00 00 0c 00 00 00 6e 00 00 00 01 00 00 00 |........n.......| 00000190 04 00 00 00 0e 00 00 00 01 00 00 00 ff ff ff ff |................|
ffffffffを処理しようとして落ちた。対策を練ったら、buildIntが生まれたって訳。 負数の扱いに齟齬をきたしていたんだ。
ああ、上記ではBinIOの返す値をSOME a して、aと言う中身を取り出したけど、val a = input1 p とか した場合、中身を取り出すには、valOf a すれば良い。これも、いろいろ歩き回った成果 です。なお、ocamlとsmlを同時にやると、精神分裂、情緒不安定になるそうだから、注意、注意、注意。 （３回警告しましたからね。情緒不安定になっても、おいらに責任を擦り付けないように。）
変換済みのコードは最後に載せるとして、 実行時間は例のloopの計測。byeが旨く動いていなくてsmlのpromptに戻っちゃうので、 すかさずCtrl-Dしたよ。
[sakae@fedora sml]$ time sml j.sml
Standard ML of New Jersey v110.75 [built: Mon Nov 18 06:57:50 2013]
[opening j.sml]
:
val it = () : unit
-
real 0m13.624s
user 0m13.285s
sys 0m0.225s
コンパイル
fedoraにはmltonとsmlsharpを入れてるんで、コンパイルしてみる
[sakae@fedora sml]$ smlsharp j.sml
j.sml:51.1-61.16 Warning: match nonexhaustive
(SOME a, SOME b, SOME c, SOME d) => ...
[sakae@fedora sml]$ mlton j.sml
Warning: j.sml 51.2.
Function is not exhaustive.
missing pattern: (NONE, _, _, _)
| ((SOME _), NONE, _, _)
| ((SOME _), (SOME _), NONE, _)
| ((SOME _), (SOME _), (SOME _), NONE)
in: buildInt (SOME a, SOME b, SOME c, ... 256 + Word8.toInt a
何か警告が出てきたぞ。両方共、パターンマッチで全てのケースを考慮してないでっせって いう、有り難い忠告。こういうのは、親の忠告と冷酒は後で効く っていうから、素直に 従うのが吉。今回は、無視するけどね。で、成果物は、smlsharpからは、a.outが得られ、 mltonからは、ｊ だ。（本物のjはいつか試してみよう）
[sakae@fedora sml]$ time ./a.out uncaught exception: Underflow Aborted real 0m0.205s user 0m0.089s sys 0m0.102s [sakae@fedora sml]$ time ./j real 0m1.595s user 0m1.274s sys 0m0.282s
両方共、コンパイルしちゃったら、機能しなくなったぞ。もうお手上げだ。
hamlet
シェークスピアの有名な戯曲 ハムレットに有名なフレーズが出て来る。
To be, or Not to be.
それに倣えばおいらの今の心境は、
To be, or Not to be ocaml.
ocamlを使うべきか否か。そんな心境を知ってか知らずか、 HaMLetなんてのが出てきた。 これ、INSTALL.txtを読むと、SML界の統一理論っぽい。
To build a stand-alone HaMLet program under Unix-like systems,
invoke one of the following commands:
make with-alice (for Alice ML 1.4+)
make with-mlkit (for ML Kit 4.3+)
make with-mlton (for MLton 20010706+)
make with-mosml (for Moscow ML 2.0+)
make with-poly (for Poly/ML 5.0+)
make with-smlnj (for SML/NJ 110+)
make with-smlsharp (for SML# 0.20+)
depending on what SML system you want to compile with.
This will produce an executable named "hamlet".
ocamlを除くML系だったら、何でもお任せあれっていう悩み解消アプリっぽい。んでもって 早速入れてみた。
[sakae@pcbsd ~]$ /usr/local/hamlet/hamlet HaMLet 2.0.0 - To Be Or Not To Be Standard ML [loading standard basis library] -
manをみると
OPTIONS
The mode option controls how HaMLet processes its input. It is one of
:
-x execution mode (parse, elaborate, and evaluate input) [default]
-j compilation mode (parse, elaborate, and compile to JavaScript)
ここにも、JavaScriptへの変換モードが組み込まれていて、美味しい水ありますよと、 誘ってる。（お前は、ホタルか！）そして美味しいのは、ソースコードに有り。 上から下までsmlで書かれていて、お腹一杯になるぞ。
試しにJavascriptをやってみた。まずは、元ネタ。
[sakae@pcbsd ~/src/sml]$ cat aaa.sml fun f 0 = 1 | f n = n * f (n - 1) ; print( Int.toString (f 10) ^ "\n" ) ;
変換したぞ。
[sakae@pcbsd ~/src/sml]$ /usr/local/hamlet/hamlet -j aaa.sml
[loading standard basis library]
[processing aaa.sml]
var f =
function(_x2) {
try {
return (function() {
if (_x2 !== 0) throw "FAIL";
return 1;
})();
} catch(_x3) {
if (_x3 !== "FAIL") throw _x3;
return (function() {
var n = _x2;
return _SML._checkOverflow(n * f(_SML._checkOverflow(n - 1)));
})();
}
};
var it = print(_caret($Int.toString(f(10)), "\n"));
js用のライブラリが必要そうだなあ。hamlet-2.0.0/compile-js/runtime.jsがそれ用なのかなあ？ 付属のdocを見たら、make js して出来上がる、basis.js と一緒に使えとな。
でも、何のかんの言っても、 結局結論はお決まりの vi vs. emacs 宗教論争に還元される訳ですよ。（ありきたりで御免）
不完全なコード
翻訳する旅に品質が劣化してくのは世の常で（伝言ゲームを思い出して納得してくれ） 劣化版を、晒しておきます。
(* import from z.ml *)
open Array ;
val mem_size = 1000000 ;
val image_file = "retroImage" ;
val ports_size = 12 ;
val pc = ref 0 ;
val ports = array( ports_size, 0) ;
val ram = array( mem_size, 0xdeadbee) ;
val halt = ref false ;
val data = ref (nil : int list) ;
val address = ref (nil : int list) ;
exception Underflow ;
fun pushVal d (x:int) = d := x :: !d ;
fun popVal d = case !d of
car :: cdr => ( d := cdr; car )
| _ => raise Underflow ;
fun push v = pushVal data v ;
fun pushr v = pushVal address v ;
fun pop () = popVal data ;
fun popr () = popVal address ;
fun tos () = List.hd (!data) ;
fun |> (x, f) = f x ;
infix |> ;
(* for debug, monitor data or address stack *)
fun si i =
if i < 0 then "-" ^ Int.toString (~i) else Int.toString i ;
fun mon3 rx =
let
fun sis i = si i ^ "; "
in
case !rx of
[] => "[]"
| [a] => "[" ^ si a ^ "]"
| [a, b] => "[" ^ sis a ^ si b ^ "]"
| [a, b, c] => "[" ^ sis a ^ sis b ^ si c ^ "]"
| a::b::c::_ => "[" ^ sis a ^ sis b ^ sis c ^ "..]"
end
fun load () =
let
open BinIO
val p = openIn image_file
fun buildInt (SOME a, SOME b, SOME c, SOME d) =
if Word8.andb(d, 0wx40) = 0wx40 then (* negative *)
(Word8.toInt (Word8.andb ((Word8.notb d), 0wx3f)) * 16777216
+ Word8.toInt (Word8.notb c) * 65536
+ Word8.toInt (Word8.notb b) * 256
+ Word8.toInt (Word8.notb a)) * ~1 - 1
else (* positive *)
Word8.toInt d * 16777216
+ Word8.toInt c * 65536
+ Word8.toInt b * 256
+ Word8.toInt a
fun rom (_, NONE, _, _, _ ) = ()
| rom (i,a,b,c,d) = (
update(ram, i, buildInt(a,b,c,d));
rom(i + 1, input1 p, input1 p, input1 p, input1 p)
)
in
rom(0, input1 p, input1 p, input1 p, input1 p) ;
closeIn p
end
fun key () = ord (valOf (TextIO.input1 TextIO.stdIn)) ;
fun ioProcess () =
if sub(ports,0) = 0 then (
update(ports, 0, 1) ;
if sub(ports,1) = 1 then update(ports, 1, key ()) else () ;
if sub(ports,2) = 1 then (
update(ports,2, 0) ;
let val x = pop () in
(print (String.str (chr x)) ; TextIO.flushOut TextIO.stdOut ) end
) else () ;
update(ports, 5,
(case sub(ports,5) of
~1 => mem_size
| ~5 => List.length (!data)
| ~6 => List.length (!address)
| ~9 => (halt := true; 0 )
| _ => 0
))) else ()
fun incPC () = pc := (!pc) + 1 ;
fun condJump f =
let val x = pop (); in
if f (pop (), x) then pc := sub(ram, !pc + 1) - 1 else incPC () end
fun jump () = (
pc := sub (ram, !pc) - 1 ;
if sub (ram, !pc + 1) = 0 then incPC () else () ;
if sub (ram, !pc + 1) = 0 then incPC () else () ) ;
fun drop () = pop () |> ignore ;
fun loop () = (
pop () - 1 |> push ;
if tos () > 0 then pc := sub (ram, !pc + 1) - 1
else (incPC (); drop ()) ) ;
fun logic f =
let
val x = Word.fromInt (pop ()) ;
val y = Word.fromInt (pop ()) ;
val z = f (x, y) ;
val v = if Word.andb (z, 0wx40000000) = 0wx40000000 then
Word.toInt (Word.andb(Word.notb z, 0wx3fffffff)) * ~1 - 1
else
Word.toInt z
in v |> push end
nonfix >;
nonfix <;
nonfix =;
nonfix <>;
fun doInst () =
case sub (ram, !pc) of
0 => () (* nop *)
| 1 => ( incPC () ; sub (ram, !pc) |> push ) (* lit *)
| 2 => tos () |> push (* dup *)
| 3 => drop () (* drop *)
| 4 => let val x = pop (); val y = pop () in x |> push; y |> push end (* swap *)
| 5 => pop () |> pushr (* push *)
| 6 => popr () |> push (* pop *)
| 7 => loop () (* call *)
| 8 => ( incPC () ; jump () ) (* jmp *)
| 9 => pc := popr () (* return *)
| 10 => condJump > (* gt_jmp *)
| 11 => condJump < (* lt_jmp *)
| 12 => condJump <> (* ne_jmp *)
| 13 => condJump = (* eq_jmp *)
| 14 => sub (ram, pop ()) |> push (* fetch *)
| 15 => let val p = pop (); val v = pop () in update(ram, p, v) end (* store *)
| 16 => push (pop () + pop ()) (* add *)
| 17 => push (pop () - pop ()) (* sub *)
| 18 => push (pop () * pop ()) (* mul *)
| 19 => let val x = pop(); val y = pop() in x div y |> push; x mod y |> push end (* divmod *)
| 20 => logic (Word.andb) (* and *)
| 21 => logic (Word.orb) (* or *)
| 22 => logic (Word.xorb) (* xor *)
| 23 => logic (Word.<<) (* lsl *)
| 24 => logic (Word.>>) (* asr *)
| 25 => if = (tos (), 0) then (drop (); pc := popr ()) else () (* z_ret *)
| 26 => pop () + 1 |> push (* inc *)
| 27 => pop () - 1 |> push (* dec *)
| 28 => let val x = pop () in sub (ports, x) |> push; update (ports, x, 0) end (* in *)
| 29 => let val p = pop (); val v = pop () in update (ports, p, v) end (* out *)
| 30 => ioProcess () (* wait *)
| _ => (!pc |> pushr ; jump ()) ; (* call by op-data *)
fun runme () =
if not (!halt) then (
(* print( (si (!pc)) ^ ":\t\t" ^ (mon3 data)^ " "^ (mon3 address)^"\n") ; *)
doInst ();
pc := !pc + 1 ;
runme ()
) else () ;
load () ;
runme () ;
smlで実行ファイル作成
ML演習を見てたら、exportFnの使い方なんてのが出てたんだけど、指示通りにやっても エラーになるばかり、例によって例を探してみたら見つかった。礼。
fun yes (_, args) =
let
val msg =
case args of
[] => "yes\n"
| x::_ => x ^ "\n"
in
while true do print msg;
OS.Process.success
end;
SMLofNJ.exportFn ("hoge",yes);
これをsmlに喰わせると、hoge.x86-bsdが出来るんで、これをロードする薄いラッパーを 用意する。
sml @SMLload=hoge "$@"
これを実行すれば、yesって永遠に答え続ける。yesはデフォなんで、コマンドラインから 引数として、別のものを与えても良い。