\begin{code}
{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -Wall #-}
module Apr5b where
import Prelude hiding (sum,product,or,and)
import Control.Arrow ((>>>))
— (>>>) is going to be (flip (.)) — same as ‘pipe’
— (<<<) is a synonym for (.)
\end{code}
Learning objectives:
\begin{itemize}
\item Recursion Schemes
\end{itemize}
\begin{code}
sum, product :: Num a => [a] -> a
sum = foldr (+) 0
product = foldr (*) 1
and, or :: [Bool] -> Bool
and = foldr (&&) True
or = foldr (||) False
myflatten :: [[a]] -> [a]
myflatten = foldr (++) []
\end{code}
A language to use for examples:
\begin{code}
data Lit
= StrLit String
| IntLit Int
| Ident String
deriving (Show, Eq)
data Expr
= Index Expr Expr
| Call Expr [Expr]
| Unary String Expr
| Binary Expr String Expr
| Paren Expr
| Literal Lit
deriving (Show, Eq)
data Stmt
= Break
| Continue
| Empty
| IfElse Expr [Stmt] [Stmt]
| Return (Maybe Expr)
| While Expr [Stmt]
| Expression Expr
deriving (Show, Eq)
\end{code}
Flattening of expressions, i.e. remove parens
\begin{code}
flatten :: Expr -> Expr
— what we really want to do:
flatten (Paren e) = flatten e
— recurse, blindly:
flatten (Index e1 e2) = Index (flatten e1) (flatten e2)
flatten (Call e l) = Call (flatten e) (map flatten l)
flatten (Unary s e) = Unary s (flatten e)
flatten (Binary e1 s e2) = Binary (flatten e1) s (flatten e2)
flatten (Literal lit) = Literal lit
\end{code}
\begin{code}
applyExpr :: (Expr -> Expr) -> Expr -> Expr
— recurse everywhere:
applyExpr f (Index e1 e2) = Index (f e1) (f e2)
applyExpr f (Call e l) = Call (f e) (map f l)
applyExpr f (Unary s e) = Unary s (f e)
applyExpr f (Binary e1 s e2) = Binary (f e1) s (f e2)
applyExpr f (Paren e) = Paren (f e)
applyExpr _ (Literal lit) = Literal lit
flatten’ :: Expr -> Expr
flatten’ (Paren e) = flatten’ e
flatten’ other = applyExpr flatten’ other
\end{code}
Functor to the rescue. First, the flat version of Expr:
\begin{code}
data ExprF e
= IndexF e e
| CallF e [e]
| UnaryF String e
| BinaryF e String e
| ParenF e
| LiteralF Lit
deriving (Show, Eq, Functor)
newtype Expr’ = ExprF Expr’
\end{code}
We can generalize even more: fixpoint at the type level.
\begin{code}
— f :: * -> *
— so Fix :: (* -> *) -> *
newtype Fix f = In { out :: f (Fix f) }
type Expr” = Fix ExprF
bottomUp :: Functor f => (Fix f -> Fix f) -> Fix f -> Fix f
bottomUp fn =
out >>> — unpack
fmap (bottomUp fn) >>> — recurse
In >>> — repack
fn — apply
— one level only
flattenTerm :: Expr” -> Expr”
flattenTerm (In (ParenF e)) = e
flattenTerm x = x
— recurse
flatten” :: Expr” -> Expr”
flatten” = bottomUp flattenTerm
\end{code}