\begin{code}
{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -Wall #-}
module Apr6 where
import Control.Arrow ((>>>), (<<<))
import Apr5b hiding (sum)
-- (>>>) is going to be (flip (.)) — same as ‘pipe’
— (<<<) is a synonym for (.)
\end{code}
Learning objectives:
\begin{itemize}
\item Recursion Schemes (cata, ana)
\end{itemize}
\begin{spec}
bottomUp :: Functor f => (Fix f -> Fix f) -> Fix f -> Fix f
bottomUp fn =
out >>> — unpack
fmap (bottomUp fn) >>> — recurse
In >>> — repack
fn — apply
— bottomUp fn = out >>> fmap (bottomUp fn) >>> In >>> fn
\end{spec}
\begin{code}
topDown :: Functor f => (Fix f -> Fix f) -> Fix f -> Fix f
— topDown fn = In <<< fmap (topDown fn) <<< out <<< fn
topDown fn = -- should read from down to up
In <<< -- repack
fmap (topDown fn) <<< -- recurse
out <<< -- unpack
fn -- apply
\end{code}
Even more general!
\begin{code}
cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = out >>> fmap (cata f) >>> f
\end{code}
Short for catamorphism. From Greek $\kappa\alpha\tau\alpha$
meaning downward, into, collapse
The ‘pattern’ (f a -> a) occurs so often, it gets named: an Algebra
\begin{code}
type Algebra f a = f a -> a
\end{code}
This is a huge generalization of |foldr| for wide class of datatypes:
\begin{code}
cata’ :: Functor f => Algebra f a -> Fix f -> a
cata’ f = out >>> fmap (cata f) >>> f
\end{code}
Example 1: first, the Algebra:
\begin{code}
count :: Algebra ExprF Int — i.e. Expr” Int -> Int
count (IndexF e1 e2) = 1 + e1 + e2
count (CallF e l) = 1 + e + sum l
count (UnaryF _ e) = 1 + e
count (BinaryF e1 _ e2) = 1 + e1 + e2
count (ParenF e) = 1 + e
count (LiteralF _) = 1
countTerms :: Expr” -> Int
countTerms = cata count
ex1 :: Expr” — synonym for Fix ExprF
ex1 = In $ CallF (In $ LiteralF (Ident “max”))
[In $ ParenF (In $ LiteralF (IntLit 5)),
In $ LiteralF (IntLit 3),
In $ LiteralF (StrLit “alsdk”)]
— typically, create “smart” constructors, like
int :: Int -> Expr”
int n = In $ LiteralF (IntLit n)
bottomUp’ :: Functor f => (Fix f -> Fix f) -> Fix f -> Fix f
bottomUp’ f = cata (In >>> f)
\end{code}
How does this compare to built-in types?
Let’s look at list!
\begin{code}
data ListF a l = Nil | Cons a l
deriving Functor
type List a = Fix (ListF a)
— smart constructors
nil :: List a
nil = In Nil
cons :: a -> List a -> List a
cons x xs = In $ Cons x xs
toList :: [a] -> List a
toList = foldr cons nil
fromList :: List a -> [a]
fromList = cata go
where
go :: ListF a [a] -> [a]
go Nil = []
go (Cons x xs) = x : xs
sum’ :: Num a => List a -> a
sum’ = cata go
where
go :: Num b => ListF b b -> b
go Nil = 0
go (Cons x s) = x + s
\end{code}