-- Code from Section 3.2
module Lists where
data List a = Nil | Cons a (List a)
instance Show a => Show (List a) where
show xs = show (fromL xs)
toL :: [a] -> List a
toL = unfoldL null head tail
fromL :: List a -> [a]
fromL = foldL (:) []
wrap :: a -> List a
wrap x = Cons x Nil
nil :: List a -> Bool
nil Nil = True
nil (Cons x xs) = False
foldL :: (a->b->b) -> b -> List a -> b
foldL f e Nil = e
foldL f e (Cons x xs) = f x (foldL f e xs)
-- answer to exercise 3.2, needed for the Trees module
mapL :: (a -> b) -> List a -> List b
mapL f = foldL (Cons . f) Nil
appendL :: List a -> List a -> List a
appendL xs ys = foldL Cons ys xs
concatL :: List (List a) -> List a
concatL = foldL appendL Nil
isort :: Ord a => List a -> List a
isort = foldL insert Nil
where
insert :: Ord a => a -> List a -> List a
insert y Nil = wrap y
insert y (Cons x xs) | y < x = Cons y (Cons x xs)
| otherwise = Cons x (insert y xs)
paraL :: (a -> (List a, b) -> b) -> b -> List a -> b
paraL f e Nil = e
paraL f e (Cons x xs) = f x (xs, paraL f e xs)
unfoldL' :: (b -> Maybe (a,b)) -> b -> List a
unfoldL' f u = case f u of
Nothing -> Nil
Just (x,v) -> Cons x (unfoldL' f v)
unfoldL :: (b->Bool) -> (b->a) -> (b->b) -> b -> List a
unfoldL p f g b = if p b then Nil else Cons (f b) (unfoldL p f g (g b))
foldL' :: (Maybe (a, b) -> b) -> List a -> b
foldL' f Nil = f Nothing
foldL' f (Cons x xs) = f (Just (x, foldL' f xs))
delmin :: Ord a => List a -> Maybe (a, List a)
delmin Nil = Nothing
delmin xs = Just (y, deleteL y xs) where y = minimumL xs
minimumL :: Ord a => List a -> a
minimumL (Cons x xs) = foldL min x xs
deleteL :: Eq a => a -> List a -> List a
deleteL y Nil = Nil
deleteL y (Cons x xs) | y == x = xs
| otherwise = Cons x (deleteL y xs)
ssort :: Ord a => List a -> List a
ssort = unfoldL' delmin
bubble :: Ord a => List a -> Maybe (a, List a)
bubble = foldL step Nothing where
step :: Ord a => a -> Maybe (a, List a) -> Maybe (a, List a)
step x Nothing = Just (x, Nil)
step x (Just (y, ys))
| x List a -> List a
bsort = unfoldL' bubble
apoL' :: (b -> Maybe (a, Either b (List a))) -> b -> List a
apoL' f u = case f u of
Nothing -> Nil
Just (x, Left v) -> Cons x (apoL' f v)
Just (x, Right xs) -> Cons x xs
fact :: Integer -> Integer
fact = foldL (*) 1 . unfoldL (==0) id pred
hyloL :: (a->c->c) -> c -> (b->Bool) -> (b->a) -> (b->b) -> (b->c)
hyloL f e p g h
-- the specification
| False = foldL f e . unfoldL p g h
-- the deforested implementation
| True = \ b -> if p b then e else f (g b) (hyloL f e p g h (h b))