SICP : 3.1.2 : Concurrent Clean : モンテカルロ法 : 一意型の扱いについて （２）

[id:lethevert:20060217:p1]では、リストを使っていろいろやってみたのだが、Heap Fullの件が解決できないので、別のアプローチを考えてみた。こちらは、正常に終了する。

Start = estimate_pi 1000000

cesaro_test r
    # (r1, r) = nextRand r
    # (r2, r) = nextRand r
    = (1 == gcd r1 r2, r)

estimate_pi trials
    = (\x y z = sqrt (6.0 / x * y))
        $$$ try 0.0 0.0
              $ uniqF (repeatn trials cesaro_test) mkRandomInt
  where
    try :: Real Real *(UniqF Bool *(Random Int)) -> (Real, Real, *(Random Int))
    try r n u
        # (h, u) = hasNext u
        | h
            # (b, u) = next u
            = try (if b (r+1.0) r) (n+1.0) u
        | otherwise
            = (r, n, end u)

::*UniqF a *u = UniqF [(u -> .(a, u))] u

uniqF :: [(*u -> (a, *u))] *u -> *(UniqF a *u)
uniqF f u = UniqF f u

hasNext :: *(UniqF a *u) -> (Bool, *(UniqF a *u))
hasNext u=:(UniqF [] _) = (False, u)
hasNext u               = (True , u)

next :: *(UniqF a *u) -> (a, *(UniqF a *u))
next (UniqF [f:fs] u)
    # (a, u) = f u
    = (a, UniqF fs u)

end :: *(UniqF a *u) -> *u
end (UniqF _ u) = u