d177568e4b56a8854dd3a36ff44bf780324c6e2a
[ghc.git] / testsuite / tests / simplCore / should_run / simplrun005.hs
1 module Main where
2
3 main = print (fib' 100)
4 -- This will time out unless memoing works properly
5
6 data Nat = Z | S Nat
7 deriving (Show, Eq)
8
9 memo f = g
10 where
11 fz = f Z
12 fs = memo (f . S)
13 g Z = fz
14 g (S n) = fs n
15 -- It is a BAD BUG to inline 'fs' inside g
16 -- and that happened in 6.4.1, resulting in exponential behaviour
17
18 -- memo f = g (f Z) (memo (f . S))
19 -- = g (f Z) (g (f (S Z)) (memo (f . S . S)))
20 -- = g (f Z) (g (f (S Z)) (g (f (S (S Z))) (memo (f . S . S . S))))
21
22 fib' :: Nat -> Integer
23 fib' = memo fib
24 where
25 fib Z = 0
26 fib (S Z) = 1
27 fib (S (S n)) = fib' (S n) + fib' n
28
29 instance Num Nat where
30 fromInteger 0 = Z
31 fromInteger n = S (fromInteger (n - 1))
32 Z + n = n
33 S m + n = S (m + n)
34 Z * n = Z
35 S m * n = (m * n) + n
36 Z - n = Z
37 S m - Z = S m
38 S m - S n = m - n
39
40 instance Enum Nat where
41 succ = S
42 pred Z = Z
43 pred (S n) = n
44 toEnum = fromInteger . toInteger
45 fromEnum Z = 0
46 fromEnum (S n) = fromEnum n + 1
47