summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/simplCore/should_run/simplrun005.hs
blob: d177568e4b56a8854dd3a36ff44bf780324c6e2a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
module Main where

main = print (fib' 100)
	-- This will time out unless memoing works properly

data Nat = Z | S Nat
           deriving (Show, Eq)

memo f = g
  where
    fz = f Z
    fs = memo (f . S) 
    g  Z    = fz
    g (S n) = fs n
	-- It is a BAD BUG to inline 'fs' inside g
	-- and that happened in 6.4.1, resulting in exponential behaviour

-- memo f = g (f Z) (memo (f . S))
--        = g (f Z) (g (f (S Z)) (memo (f . S . S)))
--        = g (f Z) (g (f (S Z)) (g (f (S (S Z))) (memo (f . S . S . S))))

fib' :: Nat -> Integer
fib'             =  memo fib
  where
  fib Z          =  0
  fib (S Z)      =  1
  fib (S (S n))  =  fib' (S n) + fib' n

instance Num Nat where
  fromInteger 0        =  Z
  fromInteger n        =  S (fromInteger (n - 1))
  Z + n                =  n
  S m + n              =  S (m + n)
  Z * n                =  Z
  S m * n              =  (m * n) + n
  Z - n                =  Z
  S m - Z              =  S m
  S m - S n            =  m - n

instance Enum Nat where
  succ                 =  S
  pred Z               =  Z
  pred (S n)           =  n
  toEnum               =  fromInteger . toInteger
  fromEnum Z           =  0
  fromEnum (S n)       =  fromEnum n + 1