HaxeでStrictとLazyなリストを実装する

HaxeでQueueとDequeを作るために必要になったので作ってみました。

# データ構造

まずStrictなリストとLazyなリストのデータ構造を定義します。

```hx:StrictList.hx
enum StrictList<T> {
    Cons(h : T, t : StrictList<T>, n : Int);
	Nil;
}
```

```hx:StreamCell.hx
enum StreamCell<T> {
    Cons(h : T, t : Stream<T>, n : Int) : StreamCell<T>;
    Nil : StreamCell<T>;
}
```

```hx:Stream.hx
typedef Stream<T> = Void -> StreamCell<T>
```

## Abstract Types

これらStrictとLazyなリストを抽象的に取り扱うためにAbstract Typesを定義します。これらは後にこれらのリストを取り扱うクラスのインターフェースを定義する時に使います。

```hx:List.hx
enum List<X> {
	Strict<T>(x : StrictList<T>) : List<StrictList<T>>;
	Lazy<T>(x : Stream<T>) : List<Stream<T>>;
} 
```

```hx:AbsList.hx
abstract AbsList<X>(List<X>) {
	public function new(x) {
		this = x;
	}

	@:from public static function fromStrict<T>(x : StrictList<T>) : AbsList<StrictList<T>> {
		return new AbsList(Strict(x));
	}

	@:from public static function fromLazy<T>(x : Stream<T>) : AbsList<Stream<T>> {
		return new AbsList(Lazy(x));
	}

	@:from public static function fromList<T>(x : List<T>) : AbsList<T> {
		return new AbsList(x);
	}

	@:to public function toX() : X {
		return switch (this) {
			case Strict(x) : x;
			case Lazy(x)   : x;
		}
	}

	@:to public function toAbsList() : AbsList<X> {
		return this;
	}
}
```

# インターフェース

これら2種類のリストを取り扱うようなクラスが持つべきメソッドを定義します。
この型パラメータ`X`は`Int`や`String`などリストの要素の型であり、また`Y`は`StrictList<T>`や`Stream<T>`といったリストの型が入ることになっています。

```hx:ListFactoryInterface.hx
interface ListFactoryInterface<X, Y> {
	public function nil() : AbsList<Y>;
	public function cons(x : X, l : AbsList<Y>) : AbsList<Y>;
	public function hd(l : AbsList<Y>) : X;
	public function tl(l : AbsList<Y>) : AbsList<Y>;
	public function append(a : AbsList<Y>, b : AbsList<Y>) : AbsList<Y>;
	public function reverse(l : AbsList<Y>) : AbsList<Y>;
	public function take(l : AbsList<Y>, n : Int) : AbsList<Y>;
	public function drop(l : AbsList<Y>, n : Int) : AbsList<Y>;
	public function length(l : AbsList<Y>) : Int;
	public function toArray(l : AbsList<Y>) : Array<X>;
	public function switchCase<T>(l : AbsList<Y>, f : {cons : X -> AbsList<Y> -> Int -> T, nil : Void -> T}) : T;
	public function pp(l : AbsList<Y>) : String;
}
```

# 実装

## Strict

```hx:StrictListFactory.hx
class StrictListFactory<T> implements ListFactoryInterface<T, StrictList<T>> {
    public function new() {}
    
	public function nil() : AbsList<StrictList<T>> {
		return StrictList.Nil;
	}

    public inline function cons(x : T, l : AbsList<StrictList<T>>) : AbsList<StrictList<T>> {
		return StrictList.Cons(x, l, length(l) + 1);
    }
    
    public inline function hd(l : AbsList<StrictList<T>>) : T {
		var x : StrictList<T> = l;
        return switch(x) {
            case StrictList.Cons(h, _, _): h;
            case StrictList.Nil: throw "error!";
        }
    }
    
    public inline function tl(l : AbsList<StrictList<T>>) : AbsList<StrictList<T>> {
		var x : StrictList<T> = l;
        return switch(x) {
            case StrictList.Cons(_, t, _): t;
            case StrictList.Nil: StrictList.Nil;
        }
    }
    
    public inline function append(a : AbsList<StrictList<T>>, b : AbsList<StrictList<T>>) : AbsList<StrictList<T>> {
		function loop (l : StrictList<T>, k : StrictList<T> -> StrictList<T>) {
			return switch(l) {
				case StrictList.Cons(h, t, _):
					loop(t, function (x) { return k( cons(h, x) ); });
				case StrictList.Nil:
					k(b);
			}
		}

		return loop(a, function (x) { return x; });
    }
    
	public function length(l : AbsList<StrictList<T>>) : Int {
		var x : StrictList<T> = l;
		return switch (x) {
			case StrictList.Cons(_, _, n): n;
			case StrictList.Nil: 0;
		}
	}

	public inline function take(l : AbsList<StrictList<T>>, n : Int) : AbsList<StrictList<T>> {
		return switch(n) {
			case i if (i <= 0): l;
			case i: cons(hd(l), take(tl(l), i - 1));
		}
	}

	public inline function drop(l : AbsList<StrictList<T>>, n : Int) : AbsList<StrictList<T>> {
		return switch(n) {
			case i if (i <= 0): l;
			case i: drop(tl(l), i - 1);
		}
	}

    public inline function reverse(l : AbsList<StrictList<T>>) : AbsList<StrictList<T>> {
		function loop(l : StrictList<T>, a : StrictList<T>) {
			return return switch(l) {
				case StrictList.Cons(h, t, n): loop(t, StrictList.Cons(h, a, n));
				case StrictList.Nil: a;
			}
		}

		return loop(l, StrictList.Nil);
    }

    public inline function toArray(l : AbsList<StrictList<T>>) : Array<T> {
        function loop(l : StrictList<T>, a : Array<T>) : Array<T> {
            return switch(l) {
                case StrictList.Cons(h, t, _): a.push(h); loop(t, a);
                case StrictList.Nil: a;
            };
        }
        
        return loop(l, []);
    }

	public inline function switchCase<U>(l : AbsList<StrictList<T>>, f : {cons : T -> AbsList<StrictList<T>> -> Int -> U, nil : Void -> U}) : U {
		var x : StrictList<T> = l;
		return switch(x) {
			case Cons(h, t, n): f.cons(h, t, n);
			case Nil: f.nil();
		}
	}

	public inline function pp(l : AbsList<StrictList<T>>) : String {
		var x : StrictList<T> = l;
		return switch(x) {
			case Cons(h, t, n): "Cons[" + n + "](" + Std.string(h) + ", " + pp(t) + ")";
			case Nil: "Nil";
		}
	}
}
```

## Lazy

```hx:LazyListFactory.hx
class LazyListFactory<T> implements ListFactoryInterface<T, Stream<T>> {
	public function new () { }

	public inline function nil() : AbsList<Stream<T>> {
		return function () { return StreamCell.Nil; };
	}

    public inline function cons(x : T, s : AbsList<Stream<T>>) : AbsList<Stream<T>> {
        return function() : StreamCell<T> {
            return Cons(x, s, length(s) + 1);
        };
    }

	public inline function length(s : AbsList<Stream<T>>) : Int {
		var x : Stream<T> = s;
		return switch(x()) {
			case Cons(h, t, n) : n;
			case Nil: 0;
		}
	}
    
    public inline function hd(s : AbsList<Stream<T>>) : T  {
		var x : Stream<T> = s;
        return switch(x()) {
            case Cons(h, _, _): h;
            case Nil: throw "stream headd error!";
        }
    }
    
    public inline function tl(s : AbsList<Stream<T>>) : AbsList<Stream<T>> {
		var x : Stream<T> = s;
        return switch(x()) {
            case Cons(_, t, _): t;
            case Nil: nil();
        }
    }

	public inline function append(a : AbsList<Stream<T>>, b : AbsList<Stream<T>>) : AbsList<Stream<T>> {
		var x : Stream<T> = b;
		function loop (s : Stream<T>) : StreamCell<T> {
			return switch(s()) {
				case Cons(h, t, n): Cons(h, function () { return loop(t); }, n + length(b));
				case Nil: x();
			}
		}
		return function () { return loop(a); }
	} 
    
    public inline function reverse(s : AbsList<Stream<T>>) : AbsList<Stream<T>> {
		var x : Stream<T> = s;
		var n = switch (x()) {
			case Cons(_, _, n): n;
			case Nil: 0;
		}

        function loop(s : Stream<T>, a : StreamCell<T>) : StreamCell<T> {
            return switch(s()) {
				case Cons(h, t, i):
					loop(t, Cons(h, function () { return a; }, n - i + 1));
                case Nil : a;
			}
		}
        
		return function () { return loop(s, Nil); };
    }

	public inline function toArray(s : AbsList<Stream<T>>) : Array<T> {
		var x : Stream<T> = s;
		return switch (x()) {
			case Cons(h, t, _): [h].concat( toArray(t) );
			case Nil: [];
		}
	}
    
    public inline function take(s : AbsList<Stream<T>>, n : Int) : AbsList<Stream<T>> {
		return switch(n) {
			case i if (i == 0): nil();
			case i if (i > 0): cons(hd(s), take(tl(s), i - 1));
			case _: throw "error!";
		}
    }

	public inline function drop(s : AbsList<Stream<T>>, n : Int) : AbsList<Stream<T>> {
		return switch(n) {
			case i if (i <= 0): s;
			case i : drop(tl(s), i - 1);
		}
	}

	public inline function switchCase<U>(s : AbsList<Stream<T>>, f : {cons : T -> AbsList<Stream<T>> -> Int -> U, nil : Void -> U}) : U {
		var x : Stream<T> = s;
		return switch(x()) {
			case Cons(h, t, n): f.cons(h, t, n);
			case Nil: f.nil();
		}
	}

	public inline function pp(s : AbsList<Stream<T>>) : String {
		var x : Stream<T> = s;

		return switch(x()) {
			case Cons(h, t, n): "Cons[" + n + "](" + Std.string(h) + ", " + pp(t) + ")";
			case Nil: "Nil";
		}
	}
}
```

# テスト

http://try.haxe.org/#738C7

```hx:Test.hx
class Test {
	static function listBenchmark<T> (maker : ListFactoryInterface<Int, T>, n : Int, ?str : String, f : Bool) {
		var a : Float = 0.0;

		for (i in 0 ... 10) {
            var timer = Date.now().getTime();
            
			{
				var x = maker.cons(1, maker.nil());
				var y = maker.cons(2, maker.nil());

				if (f) 
					for (j in 0 ... n)
						x = maker.append(x, y);
				else
					for (j in 0 ... n)
						y = maker.append(x, y);
			}

            a += Date.now().getTime() - timer;
        }
        trace("---- " + str + " ----");
        trace(a / 10);
        trace("---- end ----");
	}

	static function main() {
		listBenchmark(new StrictListFactory<Int>(), 200, "StrictList 200 A", true);
		listBenchmark(new StrictListFactory<Int>(), 200, "StrictList 200 B", false);
		listBenchmark(new StrictListFactory<Int>(), 400, "StrictList 400 A", true);
		listBenchmark(new StrictListFactory<Int>(), 400, "StrictList 400 B", false);
        
		listBenchmark(new LazyListFactory<Int>(), 200, "LazyList 200 A", true);
		listBenchmark(new LazyListFactory<Int>(), 200, "LazyList 200 B", false);
		listBenchmark(new LazyListFactory<Int>(), 400, "LazyList 400 A", true);
		listBenchmark(new LazyListFactory<Int>(), 400, "LazyList 400 B", false);
	}
}
```

# 感想

Haxeの部分型の判定についてはまだ十分じゃないところがあるので、ところどころに無駄なコードを入れなければならず、まだまだ処理系に改良の余地があると。