{-# 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 { forall (f :: * -> *). Fix f -> f (Fix f)
unFix :: f (Fix f) }

instance Eq1 f => Eq (Fix f) where
    == :: Fix f -> Fix f -> Bool
(==) (Fix f (Fix f)
a) (Fix f (Fix f)
b) = (Fix f -> Fix f -> Bool) -> f (Fix f) -> f (Fix f) -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq Fix f -> Fix f -> Bool
forall a. Eq a => a -> a -> Bool
(==) f (Fix f)
a f (Fix f)
b
    {-# INLINE (==) #-}

instance Show1 f => Show (Fix f) where
    showsPrec :: Int -> Fix f -> ShowS
showsPrec Int
d (Fix f (Fix f)
f) = (Int -> Fix f -> ShowS)
-> ([Fix f] -> ShowS) -> Int -> f (Fix f) -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> Fix f -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [Fix f] -> ShowS
forall a. Show a => [a] -> ShowS
showList Int
d f (Fix f)
f
    {-# INLINE showsPrec #-}

-- | Catamorphism
cata :: Functor f => (f a -> a) -> (Fix f -> a)
cata :: forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata f a -> a
f = f a -> a
f (f a -> a) -> (Fix f -> f a) -> Fix f -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Fix f -> a) -> f (Fix f) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> a) -> Fix f -> a
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
cata f a -> a
f) (f (Fix f) -> f a) -> (Fix f -> f (Fix f)) -> Fix f -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix f -> f (Fix f)
forall (f :: * -> *). Fix f -> f (Fix 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 :: String -> Int
hashString = (Int -> Char -> Int) -> Int -> String -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
h Char
c -> Int
33Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
h Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) Int
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 #-}