Ticket #3320: idfs.hs

File idfs.hs, 1.1 KB (added by sebf, 5 years ago)

program to reproduce the bug

Line 
1{-# LANGUAGE RankNTypes #-}
2{-# OPTIONS_GHC -O -fno-full-laziness #-}
3
4import Control.Parallel            ( par )
5import Control.Parallel.Strategies ( using, seqList, r0 )
6
7newtype Search a = S { search :: forall b . (a -> Int -> [b]) -> Int -> [b] }
8
9idfs :: Int -> Search a -> [a]
10idfs n a = parconcat [ search a result d | d <- [0,n..] ]
11 where result x d = if d<n then [x] else []
12
13parconcat :: [[a]] -> [a]
14parconcat []     = []
15parconcat (x:xs) = ys `par` ((x `using` seqList r0) ++ ys)
16 where ys = parconcat xs
17
18ret :: a -> Search a
19ret x = S ($x)
20
21bind :: Search a -> (a -> Search b) -> Search b
22bind (S a) k = S (\c -> a (\x -> search (k x) c))
23
24zero :: Search a
25zero = S (\_ _ -> [])
26
27plus :: Search a -> Search a -> Search a
28plus (S a) (S b) = S (\c d -> if d==0 then [] else a c (d-1) ++ b c (d-1))
29
30anyof :: [a] -> Search a
31anyof = foldr plus zero . map ret
32
33pytriple :: Search (Int,Int,Int)
34pytriple = anyof [1..]   `bind` \a ->
35           anyof [a+1..] `bind` \b ->
36           anyof [b+1..] `bind` \c ->
37           if a*a + b*b == c*c then ret (a,b,c) else zero
38
39main = print . length . take 500 . idfs 100 $ pytriple
40