blob: 1fae4499cd43e102257539ed8ffe26e751506523 (
plain) (
blame)
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
|
-- Fantastic Morphisms
newtype Free f = Free {unFree :: f (Free f)}
cata :: Functor f => (f a -> a) -> Free f -> a
cata phi (Free x) = phi $ fmap (cata phi) x
ana :: Functor f => (a -> f a) -> a -> Free f
ana phi x = Free $ fmap (ana phi) (phi x)
data FibF a =
Fib0
| Fib1
| FibN a a
deriving (Eq, Show)
instance Functor FibF where
fmap f Fib0 = Fib0
fmap f Fib1 = Fib1
fmap f (FibN l r) = FibN (f l) (f r)
type Fib a = Free FibF
gen :: Int -> FibF Int
gen 0 = Fib0
gen 1 = Fib1
gen n = FibN (n-1) (n-2)
interp :: FibF Int -> Int
interp Fib0 = 0
interp Fib1 = 1
interp (FibN l r) = l + r
bif :: Int -> Fib Int
bif = ana gen
fib' :: Fib Int -> Int
fib' = cata interp
fib :: Int -> Int
fib = fib' . bif
main :: IO ()
main = print (fib 14)
|
