Pervasives.( = )は自力定義できるか？
そういう話をしたのを思い出しましたので、OCaml Meeting 2010 in Nagoyaの聴講メモを書く代わりにやってみました。ていうか何聴いたかうろ覚えですすみません。
O'Camlの値は、RTTIこそ持ちませんが、rubyのように下位ビットでブロックか整数値かどうか区別されます。整数値の場合はintかcharかboolかバリアントのofなしコンストラクタか、いずれにせよ直接比較してOK*1。ブロックの場合はサイズとタグを取得できますので、やっぱり再帰的に比較できます。
というわけで単純に……。
(* same as x = y, without Pervasives.( = ) *) let int_eq (x: int) (y: int): bool = try [| true |].(x - y) with Invalid_argument _ -> false;; (* same as the above, TODO... *) let float_eq (x: float) (y: float): bool = x = y;; let string_eq (x: string) (y: string): bool = x = y;; let eq (type t) (a: t) (b: t): bool = let rec rec_eq (a: Obj.t) (b: Obj.t): bool = let tag = Obj.tag a in if Obj.tag b <> tag then false else if tag = Obj.lazy_tag then ( rec_eq (Lazy.force (Obj.obj a)) (Lazy.force (Obj.obj b)) ) else if tag = Obj.closure_tag then ( raise (Invalid_argument "equal: functional value") ) else if tag = Obj.object_tag then ( int_eq (Obj.obj a) (Obj.obj b) (* compare by address *) ) else if tag = Obj.infix_tag then ( failwith "equal: sorry! what is infix?" ) else if tag = Obj.forward_tag then ( failwith "equal: sorry! what is forward?" ) else if tag = Obj.no_scan_tag then ( failwith "equal: sorry! what is no_scan?" ) else if tag = Obj.abstract_tag then ( failwith "equal: sorry! what is abstract?" ) else if int_eq tag Obj.string_tag then ( string_eq (Obj.obj a) (Obj.obj b) ) else if int_eq tag Obj.double_tag then ( float_eq (Obj.double_field a 0) (Obj.double_field b 0) ) else if int_eq tag Obj.double_array_tag then ( let size = Obj.size a in if Obj.size b <> size then false else let rec double_field_loop (i: int): bool = if int_eq i size then true else if not (float_eq (Obj.double_field a i) (Obj.double_field b i)) then false else double_field_loop (succ i) in double_field_loop 0 ) else if tag = Obj.custom_tag then ( failwith "equal: sorry! no way to call custom-operators directly..." ) else if tag = Obj.final_tag then ( failwith "equal: sorry! what is final?" ) else if tag = Obj.int_tag then ( int_eq (Obj.obj a) (Obj.obj b) ) else if tag = Obj.out_of_heap_tag then ( int_eq (Obj.obj a) (Obj.obj b) (* compare by address *) ) else if tag = Obj.unaligned_tag then ( failwith "equal: sorry! what is unaligned?" ) else ( (* normal block *) let size = Obj.size a in if Obj.size b <> size then false else let rec field_loop (i: int): bool = if int_eq i size then true else if not (rec_eq (Obj.field a i) (Obj.field b i)) then false else field_loop (succ i) in field_loop 0 ) in rec_eq (Obj.repr a) (Obj.repr b);; assert (eq [] []);; assert (eq true true);; assert (eq [1; 2] [1; 2]);; assert (not (eq [1; 2] [1; 3]));; assert (not (eq [1; 2] [1; 2; 3]));; assert (eq 1.3 1.3);; assert (not (eq 1.3 1.4));; assert (eq [1.1; 1.2; 1.3] [1.1; 1.2; 1.3]);; assert (not (eq "a" "b"));; assert (try ignore (eq ignore ignore); false with Invalid_argument _ -> true);; assert (eq (lazy 1) (lazy 1));; assert (not (eq (lazy 1) (lazy 2)));; assert (eq (lazy 1) (let b = lazy 1 in ignore (Lazy.force b); b));; assert (eq (1, true) (1, true));; assert (eq [| "a" |] [| "a" |]);; type s = {a: int; b:int option};; assert (eq {a = 100; b = Some 200} {a = 100; b = Some 200});; assert (not (eq {a = 100; b = Some 200} {a = 100; b = None}));; type v = A | B of int;; assert (eq (B 10) (B 10));; assert (eq (object end) (object end));;
Objモジュールにはよくわからないタグが沢山定義されてますが、よくわかりません。どんな時に使われるんでしょうね？
struct custom_operationsの中にあるcompare関数をO'Camlから呼ぶ方法がないのでint32なんかは無理げ。C言語でヘルパー書けばできそうですけれども。
あと見ての通りfloat arrayだけ特殊です。これがありなら、char arrayも同じように特別扱いしてstring = char arrayにもできそうなものです。そうすれば.( )と.[ ]で迷うこともなくなるのに……。
