{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Agda.Utils.SmallSet
( SmallSet()
, Ix
, (\\)
, complement
, delete
, difference
, elems
, empty
, fromList, fromAscList, fromDistinctAscList
, insert
, intersection
, isSubsetOf
, mapMemberShip
, member
, notMember
, null
, singleton
, toList, toAscList
, total
, union
, zipMemberShipWith
) where
import Prelude hiding (null)
import Data.Array.IArray (Ix, Array)
import qualified Data.Array.IArray as Array
import Data.Data (Data)
type SmallSetElement a = (Bounded a, Ix a)
newtype SmallSet a = SmallSet { theSmallSet :: Array a Bool }
deriving (Eq, Ord, Show, Data)
null :: SmallSetElement a => SmallSet a -> Bool
null = all (== False) . Array.elems . theSmallSet
member :: SmallSetElement a => a -> SmallSet a -> Bool
member a s = theSmallSet s Array.! a
notMember :: SmallSetElement a => a -> SmallSet a -> Bool
notMember a = not . member a
isSubsetOf :: SmallSetElement a => SmallSet a -> SmallSet a -> Bool
isSubsetOf s t = and $ toBoolListZipWith implies s t
where implies a b = if a then b else True
empty :: SmallSetElement a => SmallSet a
empty = fromBoolList (repeat False)
total :: SmallSetElement a => SmallSet a
total = fromBoolList (repeat True)
singleton :: SmallSetElement a => a -> SmallSet a
singleton a = fromList [a]
insert :: SmallSetElement a => a -> SmallSet a -> SmallSet a
insert a = update [(a,True)]
delete :: SmallSetElement a => a -> SmallSet a -> SmallSet a
delete a = update [(a,False)]
complement :: SmallSetElement a => SmallSet a -> SmallSet a
complement = mapMemberShip not
difference, (\\) :: SmallSetElement a => SmallSet a -> SmallSet a -> SmallSet a
difference = zipMemberShipWith $ \ b c -> b && not c
(\\) = difference
intersection :: SmallSetElement a => SmallSet a -> SmallSet a -> SmallSet a
intersection = zipMemberShipWith (&&)
union :: SmallSetElement a => SmallSet a -> SmallSet a -> SmallSet a
union = zipMemberShipWith (||)
mapMemberShip :: SmallSetElement a => (Bool -> Bool) -> SmallSet a -> SmallSet a
mapMemberShip f = SmallSet . Array.amap f . theSmallSet
zipMemberShipWith :: SmallSetElement a => (Bool -> Bool -> Bool) -> SmallSet a -> SmallSet a -> SmallSet a
zipMemberShipWith f s t = fromBoolList $ toBoolListZipWith f s t
elems, toList, toAscList :: SmallSetElement a => SmallSet a -> [a]
elems = map fst . filter snd . Array.assocs . theSmallSet
toList = elems
toAscList = elems
fromList, fromAscList, fromDistinctAscList :: SmallSetElement a => [a] -> SmallSet a
fromList = flip update empty . map (,True)
fromAscList = fromList
fromDistinctAscList = fromList
fromBoolList :: SmallSetElement a => [Bool] -> SmallSet a
fromBoolList = SmallSet . Array.listArray (minBound, maxBound)
toBoolList :: SmallSetElement a => SmallSet a -> [Bool]
toBoolList = Array.elems . theSmallSet
toBoolListZipWith :: SmallSetElement a => (Bool -> Bool -> Bool) -> SmallSet a -> SmallSet a -> [Bool]
toBoolListZipWith f s t = zipWith f (toBoolList s) (toBoolList t)
update :: SmallSetElement a => [(a,Bool)] -> SmallSet a -> SmallSet a
update u s = SmallSet $ theSmallSet s Array.// u