Utilities module for the fully lazy lambda lifter
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> module Utilities(
> Assn, assLookup,
> NameSupply, initialNameSupply, newName,
> Set, setFromList, setEmpty, setSingleton, setToList,
> setUnion, setIntersect, setDifference, setUnionList,
> Bag, bagFromList, bagEmpty, bagSingleton, bagToList,
> bagInsert, bagUnion,
> mapAccuml
> ) where
>
\section{Association lists}
Association lists are represented using a transparent type, because
it is so convenient to be able to use the usual list functions on them.
> type Assn key value = [(key, value)]
>
> assLookup :: Eq key => Assn key value -> key -> value
> assLookup alist key = head [value | (key',value) <- alist, key == key']
\section{Name supply}
> data NameSupply = MkNS Int
>
> initialNameSupply :: NameSupply
> initialNameSupply = MkNS 0
> newName :: NameSupply -> String -> (NameSupply, String)
> newName (MkNS n) prefix = (MkNS (n+1), prefix ++ show n)
\section{Sets}
We represent sets as {\em ordered} lists, where later elements
are greater than earlier elements.
> data Set a = MkSet [a]
Note: I could have made this |data Ord a => Set a = MkSet [a]|, but
then |setEmpty| would be an overloaded constant, and hence not
exportable. So I left out the |Ord =>|.
Getting into and out of the representation is pretty easy.
> setFromList xs = MkSet (sortNoDups xs)
> setEmpty = MkSet []
> setSingleton x = MkSet [x]
> setToList (MkSet xs) = xs
Now the basic combining functions.
> setUnion (MkSet xs) (MkSet ys) =
> MkSet (merge xs ys) where
> merge xs [] = xs
> merge [] ys = ys
> merge xs@(x:xs') ys@(y:ys') | x | x==y = x : merge xs' ys'
> | x>y = y : merge xs ys'
> setIntersect (MkSet xs) (MkSet ys) =
> MkSet (intersect xs ys) where
> intersect [] ys = []
> intersect xs [] = []
> intersect xs@(x:xs') ys@(y:ys') | x | x==y = x : intersect xs' ys'
> | x>y = intersect xs ys'
> setDifference (MkSet xs) (MkSet ys) =
> MkSet (difference xs ys) where
> difference [] ys = []
> difference xs [] = xs
> difference xs@(x:xs') ys@(y:ys') | x | x==y = difference xs' ys'
> | x>y = difference xs ys'
> setUnionList ss = foldr setUnion setEmpty ss
\section{Bags}
MkBags are represented by unordered lists
> data Bag a = MkBag [a]
> bagEmpty = MkBag []
> bagSingleton x = MkBag [x]
> bagFromList xs = MkBag xs
> bagToList (MkBag xs) = xs
> bagInsert x (MkBag xs) = MkBag (x:xs)
> bagUnion (MkBag xs) (MkBag ys) = MkBag (xs ++ ys)
\section{Generally useful functions}
> mapAccuml :: (b -> a -> (b, c)) -- Function of elt of input list
> -- and accumulator, returning new
> -- accumulator and elt of result list
> -> b -- Initial accumulator
> -> [a] -- Input list
> -> (b, [c]) -- Final accumulator and result list
>
> mapAccuml f b [] = (b, [])
> mapAccuml f b (x:xs) = (b'', x':xs') where
> (b', x') = f b x
> (b'', xs') = mapAccuml f b' xs
|sortNoDups| sorts a list and removes duplicates from it.
> sortNoDups :: Ord a => [a] -> [a]
> sortNoDups [] = []
> sortNoDups (x:xs) = sortNoDups [y | y <- xs, y < x]
> ++ [x] ++
> sortNoDups [y | y <- xs, y > x]