-- 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))