Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 17 additions & 1 deletion Data/HashMap/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -148,6 +148,9 @@ module Data.HashMap.Internal
, adjust#
) where

import Data.Traversable -- MicroHs needs this since its Prelude does not have Foldable&Traversable.
-- It's harmless for GHC, and putting it first avoid a warning.
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
-- It's harmless for GHC, and putting it first avoid a warning.
-- It's harmless for GHC, and putting it first avoids a warning.


import Control.Applicative (Const (..))
import Control.DeepSeq (NFData (..), NFData1 (..), NFData2 (..))
import Control.Monad.ST (ST, runST)
Expand Down Expand Up @@ -191,9 +194,11 @@ data Leaf k v = L !k v
instance (NFData k, NFData v) => NFData (Leaf k v) where
rnf (L k v) = rnf k `seq` rnf v

#if defined(__GLASGOW_HASKELL__)
-- | @since 0.2.17.0
instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where
liftTyped (L k v) = [|| L k $! v ||]
#endif

-- | @since 0.2.14.0
instance NFData k => NFData1 (Leaf k) where
Expand Down Expand Up @@ -700,7 +705,11 @@ lookupRecordCollision# h k m =
-- this whole thing is always inlined, we don't have to worry about
-- any extra CPS overhead.
lookupCont ::
#if defined(__GLASGOW_HASKELL__)
forall rep (r :: TYPE rep) k v.
#else
forall r k v.
#endif
Eq k
=> ((# #) -> r) -- Absent continuation
-> (v -> Int -> r) -- Present continuation
Expand Down Expand Up @@ -914,10 +923,11 @@ setAtPosition i k x ary = A.update ary i (L k x)


-- | In-place update version of insert
unsafeInsert :: (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
unsafeInsert :: forall k v. (Eq k, Hashable k) => k -> v -> HashMap k v -> HashMap k v
unsafeInsert k0 v0 m0 = runST (go h0 k0 v0 0 m0)
where
h0 = hash k0
go :: forall s. Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go !h !k x !_ Empty = return $! Leaf h (L k x)
go h k x s t@(Leaf hy l@(L ky y))
| hy == h = if ky == k
Expand Down Expand Up @@ -2413,7 +2423,11 @@ fromListWithKey f = List.foldl' (\ m (k, v) -> unsafeInsertWithKey (\k' a b -> (
-- | \(O(n)\) Look up the value associated with the given key in an
-- array.
lookupInArrayCont ::
#if defined(__GLASGOW_HASKELL__)
forall rep (r :: TYPE rep) k v.
#else
forall r k v.
#endif
Eq k => ((# #) -> r) -> (v -> Int -> r) -> k -> A.Array (Leaf k v) -> r
lookupInArrayCont absent present k0 ary0 = go k0 ary0 0 (A.length ary0)
where
Expand Down Expand Up @@ -2666,9 +2680,11 @@ otherOfOneOrZero :: Int -> Int
otherOfOneOrZero i = 1 - i
{-# INLINE otherOfOneOrZero #-}

#if defined(__GLASGOW_HASKELL__)
------------------------------------------------------------------------
-- IsList instance
instance (Eq k, Hashable k) => Exts.IsList (HashMap k v) where
type Item (HashMap k v) = (k, v)
fromList = fromList
toList = toList
#endif
17 changes: 12 additions & 5 deletions Data/HashMap/Internal/Array.hs
Original file line number Diff line number Diff line change
Expand Up @@ -464,14 +464,15 @@ deleteM ary idx = do
where !count = length ary
{-# INLINE deleteM #-}

map :: (a -> b) -> Array a -> Array b
map :: forall a b . (a -> b) -> Array a -> Array b
map f = \ ary ->
let !n = length ary
in run $ do
mary <- new_ n
go ary mary 0 n
return mary
where
go :: forall s. Array a -> MArray s b -> Int -> Int -> ST s ()
go ary mary i n
| i >= n = return ()
| otherwise = do
Expand All @@ -481,14 +482,15 @@ map f = \ ary ->
{-# INLINE map #-}

-- | Strict version of 'map'.
map' :: (a -> b) -> Array a -> Array b
map' :: forall a b . (a -> b) -> Array a -> Array b
map' f = \ ary ->
let !n = length ary
in run $ do
mary <- new_ n
go ary mary 0 n
return mary
where
go :: forall s . Array a -> MArray s b -> Int -> Int -> ST s ()
go ary mary i n
| i >= n = return ()
| otherwise = do
Expand All @@ -497,7 +499,7 @@ map' f = \ ary ->
go ary mary (i+1) n
{-# INLINE map' #-}

filter :: (a -> Bool) -> Array a -> Array a
filter :: forall a . (a -> Bool) -> Array a -> Array a
filter f = \ ary ->
let !n = length ary
in run $ do
Expand All @@ -508,6 +510,7 @@ filter f = \ ary ->
-- Without the @!@ on @ary@ we end up reboxing the array when using
-- 'differenceCollisions'. See
-- https://gitlab.haskell.org/ghc/ghc/-/issues/26525.
go_filter :: forall s . Array a -> MArray s a -> Int -> Int -> Int -> ST s Int
go_filter !ary !mary !iAry !iMary !n
| iAry >= n = return iMary
| otherwise = do
Expand All @@ -519,36 +522,40 @@ filter f = \ ary ->
else go_filter ary mary (iAry + 1) iMary n
{-# INLINE filter #-}

fromList :: Int -> [a] -> Array a
fromList :: forall a . Int -> [a] -> Array a
fromList n xs0 =
CHECK_EQ("fromList", n, Prelude.length xs0)
run $ do
mary <- new_ n
go xs0 mary 0
return mary
where
go :: forall s . [a] -> MArray s a -> Int -> ST s ()
go [] !_ !_ = return ()
go (x:xs) mary i = do write mary i x
go xs mary (i+1)

fromList' :: Int -> [a] -> Array a
fromList' :: forall a . Int -> [a] -> Array a
fromList' n xs0 =
CHECK_EQ("fromList'", n, Prelude.length xs0)
run $ do
mary <- new_ n
go xs0 mary 0
return mary
where
go :: forall s . [a] -> MArray s a -> Int -> ST s ()
go [] !_ !_ = return ()
go (!x:xs) mary i = do write mary i x
go xs mary (i+1)

#if defined(__GLASGOW_HASKELL__)
-- | @since 0.2.17.0
instance TH.Lift a => TH.Lift (Array a) where
liftTyped ar = [|| fromList' arlen arlist ||]
where
arlen = length ar
arlist = toList ar
#endif

toList :: Array a -> [a]
toList = foldr (:) []
Expand Down
6 changes: 4 additions & 2 deletions Data/HashMap/Internal/Strict.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_HADDOCK not-home #-}
Expand Down Expand Up @@ -123,7 +124,7 @@ module Data.HashMap.Internal.Strict
) where

import Control.Applicative (Const (..))
import Control.Monad.ST (runST)
import Control.Monad.ST (runST, ST)
import Data.Bits ((.&.), (.|.))
import Data.Coerce (coerce)
import Data.Functor.Identity (Identity (..))
Expand Down Expand Up @@ -227,11 +228,12 @@ unsafeInsertWith :: (Eq k, Hashable k) => (v -> v -> v) -> k -> v -> HashMap k v
unsafeInsertWith f k0 v0 m0 = unsafeInsertWithKey (const f) k0 v0 m0
{-# INLINABLE unsafeInsertWith #-}

unsafeInsertWithKey :: (Eq k, Hashable k) => (k -> v -> v -> v) -> k -> v -> HashMap k v
unsafeInsertWithKey :: forall k v. (Eq k, Hashable k) => (k -> v -> v -> v) -> k -> v -> HashMap k v
-> HashMap k v
unsafeInsertWithKey f k0 v0 m0 = runST (go h0 k0 v0 0 m0)
where
h0 = hash k0
go :: forall s. Hash -> k -> v -> Int -> HashMap k v -> ST s (HashMap k v)
go !h !k x !_ Empty = return $! leaf h k x
go h k x s t@(Leaf hy l@(L ky y))
| hy == h = if ky == k
Expand Down
2 changes: 2 additions & 0 deletions Data/HashSet/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -450,7 +450,9 @@ fromList :: (Eq a, Hashable a) => [a] -> HashSet a
fromList = HashSet . List.foldl' (\ m k -> H.unsafeInsert k () m) H.empty
{-# INLINE fromList #-}

#if defined(__GLASGOW_HASKELL__)
instance (Eq a, Hashable a) => Exts.IsList (HashSet a) where
type Item (HashSet a) = a
fromList = fromList
toList = toList
#endif
6 changes: 4 additions & 2 deletions unordered-containers.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -57,8 +57,10 @@ library
build-depends:
base >= 4.14 && < 5,
deepseq >= 1.4.3,
hashable >= 1.4 && < 1.6,
template-haskell >= 2.16 && < 2.24
hashable >= 1.4 && < 1.6
if impl(ghc)
build-depends:
template-haskell >= 2.16 && < 2.24

default-language: Haskell2010

Expand Down