{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}

module Data.Set.Unboxed.Internal
  ( Set(..)
  , toList
  , fromList
  ) where

import Prelude hiding (foldr)

import Data.Hashable (Hashable)
import Data.Primitive (Prim,PrimArray(..))
import Data.Semigroup (Semigroup)
import Data.Primitive.Unlifted.Class (PrimUnlifted(..))

import qualified Data.Foldable as F
import qualified Data.Hashable as H
import qualified Data.Semigroup as SG
import qualified Data.Set.Internal as I
import qualified GHC.Exts as E

-- | A set of elements.
newtype Set a = Set (I.Set PrimArray a)

instance (Prim a, Ord a) => Semigroup (Set a) where
  Set Set PrimArray a
x <> :: Set a -> Set a -> Set a
<> Set Set PrimArray a
y = forall a. Set PrimArray a -> Set a
Set (forall (arr :: * -> *) a.
(ContiguousU arr, Element arr a, Ord a) =>
Set arr a -> Set arr a -> Set arr a
I.append Set PrimArray a
x Set PrimArray a
y)
  stimes :: forall b. Integral b => b -> Set a -> Set a
stimes = forall b a. (Integral b, Monoid a) => b -> a -> a
SG.stimesIdempotentMonoid
  sconcat :: NonEmpty (Set a) -> Set a
sconcat NonEmpty (Set a)
xs = forall a. Set PrimArray a -> Set a
Set (forall (arr :: * -> *) a.
(ContiguousU arr, Element arr a, Ord a) =>
[Set arr a] -> Set arr a
I.concat (coerce :: forall a b. Coercible a b => a -> b
E.coerce (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList NonEmpty (Set a)
xs)))

instance (Prim a, Ord a) => Monoid (Set a) where
  mempty :: Set a
mempty = forall a. Set PrimArray a -> Set a
Set forall (arr :: * -> *) a. Contiguous arr => Set arr a
I.empty
  mappend :: Set a -> Set a -> Set a
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)
  mconcat :: [Set a] -> Set a
mconcat [Set a]
xs = forall a. Set PrimArray a -> Set a
Set (forall (arr :: * -> *) a.
(ContiguousU arr, Element arr a, Ord a) =>
[Set arr a] -> Set arr a
I.concat (coerce :: forall a b. Coercible a b => a -> b
E.coerce [Set a]
xs))

instance (Prim a, Eq a) => Eq (Set a) where
  Set Set PrimArray a
x == :: Set a -> Set a -> Bool
== Set Set PrimArray a
y = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Eq a) =>
Set arr a -> Set arr a -> Bool
I.equals Set PrimArray a
x Set PrimArray a
y

instance (Prim a, Ord a) => Ord (Set a) where
  compare :: Set a -> Set a -> Ordering
compare (Set Set PrimArray a
x) (Set Set PrimArray a
y) = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Ord a) =>
Set arr a -> Set arr a -> Ordering
I.compare Set PrimArray a
x Set PrimArray a
y

instance (Hashable a, Prim a) => Hashable (Set a) where
  hashWithSalt :: Int -> Set a -> Int
hashWithSalt Int
s (Set Set PrimArray a
arr) = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
(Int -> a -> Int) -> Int -> Set arr a -> Int
I.liftHashWithSalt forall a. Hashable a => Int -> a -> Int
H.hashWithSalt Int
s Set PrimArray a
arr

instance PrimUnlifted (Set a) where
  type Unlifted (Set a) = E.ByteArray#
  {-# inline toUnlifted# #-}
  {-# inline fromUnlifted# #-}
  {-# inline writeUnliftedArray# #-}
  {-# inline readUnliftedArray# #-}
  {-# inline indexUnliftedArray# #-}
  toUnlifted# :: Set a -> Unlifted (Set a)
toUnlifted# (Set (I.Set PrimArray a
p)) = forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# PrimArray a
p
  fromUnlifted# :: Unlifted (Set a) -> Set a
fromUnlifted# Unlifted (Set a)
b# = forall a. Set PrimArray a -> Set a
Set (forall (arr :: * -> *) a. arr a -> Set arr a
I.Set (forall a. ByteArray# -> PrimArray a
PrimArray Unlifted (Set a)
b#))
  writeUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> Set a -> State# s -> State# s
writeUnliftedArray# MutableArrayArray# s
a Int#
i Set a
s = forall d.
MutableArrayArray# d -> Int# -> ByteArray# -> State# d -> State# d
E.writeByteArrayArray# MutableArrayArray# s
a Int#
i (forall a. PrimUnlifted a => a -> Unlifted a
toUnlifted# Set a
s)
  readUnliftedArray# :: forall s.
MutableArrayArray# s -> Int# -> State# s -> (# State# s, Set a #)
readUnliftedArray# MutableArrayArray# s
a Int#
i State# s
s0 = case forall d.
MutableArrayArray# d
-> Int# -> State# d -> (# State# d, ByteArray# #)
E.readByteArrayArray# MutableArrayArray# s
a Int#
i State# s
s0 of
    (# State# s
s1, ByteArray#
x #) -> (# State# s
s1, forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# ByteArray#
x #)
  indexUnliftedArray# :: ArrayArray# -> Int# -> Set a
indexUnliftedArray# ArrayArray#
a Int#
i = forall a. PrimUnlifted a => Unlifted a -> a
fromUnlifted# (ArrayArray# -> Int# -> ByteArray#
E.indexByteArrayArray# ArrayArray#
a Int#
i)

-- | The functions that convert a list to a 'Set' are asymptotically
-- better that using @'foldMap' 'singleton'@, with a cost of /O(n*log n)/
-- rather than /O(n^2)/. If the input list is sorted, even if duplicate
-- elements are present, the algorithm further improves to /O(n)/. The
-- fastest option available is calling 'fromListN' on a presorted list
-- and passing the correct size size of the resulting 'Set'. However, even
-- if an incorrect size is given to this function,
-- it will still correctly convert the list into a 'Set'.
instance (Prim a, Ord a) => E.IsList (Set a) where
  type Item (Set a) = a
  fromListN :: Int -> [Item (Set a)] -> Set a
fromListN Int
n = forall a. Set PrimArray a -> Set a
Set forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (arr :: * -> *) a.
(ContiguousU arr, Element arr a, Ord a) =>
Int -> [a] -> Set arr a
I.fromListN Int
n
  fromList :: [Item (Set a)] -> Set a
fromList = forall a. Set PrimArray a -> Set a
Set forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (arr :: * -> *) a.
(ContiguousU arr, Element arr a, Ord a) =>
[a] -> Set arr a
I.fromList
  toList :: Set a -> [Item (Set a)]
toList = forall a. Prim a => Set a -> [a]
toList

instance (Prim a, Show a) => Show (Set a) where
  showsPrec :: Int -> Set a -> ShowS
showsPrec Int
p (Set Set PrimArray a
s) = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a, Show a) =>
Int -> Set arr a -> ShowS
I.showsPrec Int
p Set PrimArray a
s

-- | Convert a set to a list. The elements are given in ascending order.
toList :: Prim a => Set a -> [a]
toList :: forall a. Prim a => Set a -> [a]
toList (Set Set PrimArray a
s) = forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
Set arr a -> [a]
I.toList Set PrimArray a
s

-- | Convert a list to a set.
fromList :: (Ord a, Prim a) => [a] -> Set a
fromList :: forall a. (Ord a, Prim a) => [a] -> Set a
fromList [a]
xs = forall a. Set PrimArray a -> Set a
Set (forall (arr :: * -> *) a.
(ContiguousU arr, Element arr a, Ord a) =>
[a] -> Set arr a
I.fromList [a]
xs)