Utils.hs

{-# LANGUAGE StandaloneDeriving #-}
{-|
 Misc utilities used accross modules
 -}
module Data.Equality.Utils where

-- import GHC.Conc
import Data.Foldable
import Data.Bits

-- import qualified Data.Set    as S
-- import qualified Data.IntSet as IS
import Data.Functor.Classes

-- | Fixed point newtype.
--
-- Ideally we should use the data-fix package, but right now we're rolling our
-- own due to an initial idea to avoid dependencies to be easier to upstream
-- into GHC (for improvements to the pattern match checker involving equality
-- graphs). I no longer think we can do that without vendoring in some part of
-- just e-graphs, but until I revert the decision we use this type.
newtype Fix f = Fix { unFix :: f (Fix f) }

instance Eq1 f => Eq (Fix f) where
    (==) (Fix a) (Fix b) = liftEq (==) a b
    {-# INLINE (==) #-}

instance Show1 f => Show (Fix f) where
    showsPrec d (Fix f) = liftShowsPrec showsPrec showList d f
    {-# INLINE showsPrec #-}

-- | Catamorphism
cata :: Functor f => (f a -> a) -> (Fix f -> a)
cata f = f . fmap (cata f) . unFix
{-# INLINE cata #-}

-- | Get the hash of a string.
--
-- This util is currently used to generate an 'Int' used for the internal
-- pattern variable representation from the external pattern variable
-- representation ('String')
hashString :: String -> Int
hashString = foldl' (\h c -> 33*h `xor` fromEnum c) 5381
{-# INLINE hashString #-}

-- -- | We don't have the parallel package, so roll our own simple parMap
-- parMap :: (a -> b) -> [a] -> [b]
-- parMap _ [] = []
-- parMap f (x:xs) = fx `par` (fxs `pseq` (fx : fxs))
--     where fx = f x; fxs = parMap f xs

-- toSet :: (Ord a, Foldable f) => f a -> S.Set a
-- toSet = foldl' (flip S.insert) mempty
-- {-# INLINE toSet #-}

-- toIntSet :: (Foldable f) => f Int -> IS.IntSet
-- toIntSet = foldl' (flip IS.insert) mempty
-- {-# INLINE toIntSet #-}