Commit 4f358c5a authored by Ryan Scott's avatar Ryan Scott
Browse files

Merge branch '2021-02-09' into 'master'

Add patches for boomerang, modern-uri, and more

See merge request ghc/head.hackage!140
parents bc9b276f 2194980d
......@@ -72,7 +72,6 @@ echo "Found GHC $version, commit $commit."
case $version in
9.0.*)
# package ticket
broken "plots" 19315
;;
9.1.*)
......
diff --git a/src/Web/Spock/Core.hs b/src/Web/Spock/Core.hs
index 88d31cc..31345c3 100644
--- a/src/Web/Spock/Core.hs
+++ b/src/Web/Spock/Core.hs
@@ -77,7 +77,7 @@ instance RouteM SpockCtxT where
addMiddleware = SpockCtxT . AR.middleware
wireAny m action =
SpockCtxT $
- do hookLift <- lift $ asks unLiftHooked
+ do hookLift <- lift $ asks (\e -> unLiftHooked e)
case m of
MethodAny ->
do forM_ allStdMethods $ \mReg ->
@@ -103,7 +103,7 @@ withPrehookImpl hook (SpockCtxT hookBody) =
wireRouteImpl :: forall xs ctx m ps. (HasRep xs, Monad m) => SpockMethod -> Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
wireRouteImpl m path action =
SpockCtxT $
- do hookLift <- lift $ asks unLiftHooked
+ do hookLift <- lift $ asks (\e -> unLiftHooked e)
let actionPacker :: HVectElim xs (ActionCtxT ctx m ()) -> HVect xs -> ActionCtxT () m ()
actionPacker act captures = hookLift (uncurry act captures)
case m of
diff --git a/Text/Boomerang/TH.hs b/Text/Boomerang/TH.hs
index 8a635da..d9020fb 100644
--- a/Text/Boomerang/TH.hs
+++ b/Text/Boomerang/TH.hs
@@ -41,7 +41,7 @@ derivePrinterParsers = makeBoomerangs
{-# DEPRECATED derivePrinterParsers "Use makeBoomerangs instead" #-}
-- Derive a router for a single constructor.
-deriveBoomerang :: (Name, [TyVarBndr]) -> Con -> Q [Dec]
+deriveBoomerang :: (Name, [TyVarBndrUnit]) -> Con -> Q [Dec]
deriveBoomerang (tName, tParams) con =
case con of
NormalC name tys -> go name (map snd tys)
@@ -50,8 +50,8 @@ deriveBoomerang (tName, tParams) con =
runIO $ putStrLn $ "Skipping unsupported constructor " ++ show (conName con)
return []
where
- takeName (PlainTV n) = n
- takeName (KindedTV n _) = n
+ takeName (PlainTV n _) = n
+ takeName (KindedTV n _ _) = n
go name tys = do
let name' = mkBoomerangName name
let tok' = mkName "tok"
@@ -66,7 +66,7 @@ deriveBoomerang (tName, tParams) con =
expr <- [| xpure $(deriveConstructor name (length tys))
$(deriveDestructor name tys) |]
return [ SigD name'
- (ForallT (map PlainTV ([tok', e', r'] ++ (map takeName tParams)))
+ (ForallT (map (`PlainTV` SpecifiedSpec) ([tok', e', r'] ++ (map takeName tParams)))
[]
(AppT (AppT ppType inT) outT))
, FunD name' [Clause [] (NormalB expr) []]
@@ -98,13 +98,21 @@ deriveDestructor name tys = do
ConE cons <- [| (:-) |]
- let conPat = ConP name (map VarP fieldNames)
+ let conPat = ConP name
+#if __GLASGOW_HASKELL__ >= 901
+ []
+#endif
+ (map VarP fieldNames)
let okBody = ConE just `AppE`
foldr
(\h t -> ConE cons `AppE` VarE h `AppE` t)
(VarE r)
fieldNames
- let okCase = Match (ConP cons [conPat, VarP r]) (NormalB okBody) []
+ let okCase = Match (ConP cons
+#if __GLASGOW_HASKELL__ >= 901
+ []
+#endif
+ [conPat, VarP r]) (NormalB okBody) []
let nStr = show name
let failCase = Match WildP (NormalB nothing) []
diff --git a/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs b/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
index 69ba0ff..e130f2c 100644
--- a/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
+++ b/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
@@ -62,8 +62,8 @@ shiftr_w w s = fromIntegral $ (`shiftr_w64` s) $ fromIntegral w
#endif
#if !defined(__HADDOCK__)
-shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#` i)
-shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#` i)
+shiftr_w16 (W16# w) (I# i) = W16# (narrowWord16Compat# (extendWord16Compat# w `uncheckedShiftRL#` i))
+shiftr_w32 (W32# w) (I# i) = W32# (narrowWord32Compat# (extendWord32Compat# w `uncheckedShiftRL#` i))
#if WORD_SIZE_IN_BITS < 64
shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
@@ -77,6 +77,32 @@ shiftr_w32 = shiftR
shiftr_w64 = shiftR
#endif
+#if MIN_VERSION_base(4,16,0)
+extendWord16Compat# :: Word16# -> Word#
+extendWord16Compat# = extendWord16#
+
+narrowWord16Compat# :: Word# -> Word16#
+narrowWord16Compat# = narrowWord16#
+
+extendWord32Compat# :: Word32# -> Word#
+extendWord32Compat# = extendWord32#
+
+narrowWord32Compat# :: Word# -> Word32#
+narrowWord32Compat# = narrowWord32#
+#else
+extendWord16Compat# :: Word# -> Word#
+extendWord16Compat# x = x
+
+narrowWord16Compat# :: Word# -> Word#
+narrowWord16Compat# x = x
+
+extendWord32Compat# :: Word# -> Word#
+extendWord32Compat# x = x
+
+narrowWord32Compat# :: Word# -> Word#
+narrowWord32Compat# x = x
+#endif
+
-- | Select an implementation depending on the bit-size of 'Word's.
-- Currently, it produces a runtime failure if the bitsize is different.
diff --git a/library/ByteString/StrictBuilder/UTF8.hs b/library/ByteString/StrictBuilder/UTF8.hs
index c1bb7f4..7e6d964 100644
--- a/library/ByteString/StrictBuilder/UTF8.hs
+++ b/library/ByteString/StrictBuilder/UTF8.hs
@@ -19,8 +19,8 @@ type UTF8Char =
{-# INLINE char #-}
char :: Char -> UTF8Char
-char =
- unicodeCodePoint . ord
+char x =
+ unicodeCodePoint (ord x)
{-# INLINE unicodeCodePoint #-}
unicodeCodePoint :: Int -> UTF8Char
@@ -28,7 +28,7 @@ unicodeCodePoint x f1 f2 f3 f4 =
if x <= 0x7F
then
f1 (fromIntegral x)
- else
+ else
if x <= 0x07FF
then
f2
diff --git a/charset.cabal b/charset.cabal
index 4824684..63db0e0 100644
--- a/charset.cabal
+++ b/charset.cabal
@@ -1,5 +1,6 @@
name: charset
version: 0.3.7.1
+x-revision: 2
license: BSD3
license-File: LICENSE
copyright: (c) Edward Kmett 2010-2012
@@ -26,8 +27,8 @@ library
build-depends:
base >= 4 && < 5,
array >= 0.2 && < 0.6,
- bytestring >= 0.9 && < 0.11,
- containers >= 0.2 && < 0.6,
+ bytestring >= 0.9 && < 0.12,
+ containers >= 0.2 && < 0.7,
semigroups >= 0.8.3.1 && < 1,
unordered-containers >= 0.1.4.6 && < 0.3
diff --git a/src/Data/CharSet/ByteSet.hs b/src/Data/CharSet/ByteSet.hs
index 78e9e7f..8e576c4 100644
--- a/src/Data/CharSet/ByteSet.hs
+++ b/src/Data/CharSet/ByteSet.hs
@@ -30,7 +30,7 @@ module Data.CharSet.ByteSet
import Data.Bits ((.&.), (.|.))
import Foreign.Storable (peekByteOff, pokeByteOff)
-import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#)
+import GHC.Base
import GHC.Word (Word8(W8#))
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as I
@@ -44,7 +44,21 @@ shiftR :: Int -> Int -> Int
shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)
shiftL :: Word8 -> Int -> Word8
-shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#))
+shiftL (W8# x#) (I# i#) = W8# (narrow8WordCompat# (extendWord8Compat# x# `shiftL#` i#))
+
+#if MIN_VERSION_base(4,16,0)
+extendWord8Compat# :: Word8# -> Word#
+extendWord8Compat# = extendWord8#
+
+narrow8WordCompat# :: Word# -> Word8#
+narrow8WordCompat# = narrowWord8#
+#else
+extendWord8Compat# :: Word# -> Word#
+extendWord8Compat# x = x
+
+narrow8WordCompat# :: Word# -> Word#
+narrow8WordCompat# = narrow8Word#
+#endif
index :: Int -> I
index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7))
diff --git a/src/Data/Deserializer.hs b/src/Data/Deserializer.hs
index 5975e37..eb9c78d 100644
--- a/src/Data/Deserializer.hs
+++ b/src/Data/Deserializer.hs
@@ -637,16 +637,16 @@ instance Deserializer μ ⇒ Deserializer (BigEndianDeserializer μ) where
-- | Force the default byte order.
deserializeIn ∷ Deserializer μ
⇒ Endian → (∀ μ' . (Deserializer μ') ⇒ μ' α) → μ α
-deserializeIn LittleEndian = deserializeL
-deserializeIn BigEndian = deserializeB
+deserializeIn LittleEndian f = deserializeL f
+deserializeIn BigEndian f = deserializeB f
{-# INLINE deserializeIn #-}
-- | Force the default byte order to be the host byte order.
deserializeH ∷ Deserializer μ ⇒ (∀ μ' . (Deserializer μ') ⇒ μ' α) → μ α
#ifdef WORDS_BIGENDIAN
-deserializeH = deserializeB
+deserializeH f = deserializeB f
#else
-deserializeH = deserializeL
+deserializeH f = deserializeL f
#endif
-- | Deserialization result.
diff --git a/src/Data/Serializer.hs b/src/Data/Serializer.hs
index 1b87a3f..dd82799 100644
--- a/src/Data/Serializer.hs
+++ b/src/Data/Serializer.hs
@@ -576,16 +576,16 @@ instance Serializer s ⇒ Serializer (BigEndianSerializer s) where
-- | Force the default byte order.
serializeIn ∷ Serializer s ⇒ Endian → (∀ s' . (Serializer s') ⇒ s') → s
-serializeIn LittleEndian = serializeL
-serializeIn BigEndian = serializeB
+serializeIn LittleEndian f = serializeL f
+serializeIn BigEndian f = serializeB f
{-# INLINE serializeIn #-}
-- | Force the default byte order to be the host byte order.
serializeH ∷ Serializer s ⇒ (∀ s' . (Serializer s') ⇒ s') → s
#ifdef WORDS_BIGENDIAN
-serializeH = serializeB
+serializeH f = serializeB f
#else
-serializeH = serializeL
+serializeH f = serializeL f
#endif
{-# INLINE serializeH #-}
diff --git a/src/Hedgehog/Internal/TH.hs b/src/Hedgehog/Internal/TH.hs
index 39b3bc1..b6913a6 100644
--- a/src/Hedgehog/Internal/TH.hs
+++ b/src/Hedgehog/Internal/TH.hs
@@ -15,7 +15,7 @@ import Hedgehog.Internal.Discovery
import Hedgehog.Internal.Property
import Language.Haskell.TH (Exp(..), Q, TExp, location, runIO)
-import Language.Haskell.TH.Syntax (Loc(..), mkName, unTypeQ, unsafeTExpCoerce)
+import Language.Haskell.TH.Syntax (Loc(..), mkName, unsafeTExpCoerce, Code, liftCode, examineCode, unsafeCodeCoerce, unTypeCode)
type TExpQ a =
Q (TExp a)
@@ -24,11 +24,11 @@ type TExpQ a =
--
-- Functions starting with `prop_` are assumed to be properties.
--
-discover :: TExpQ Group
+discover :: Code Q Group
discover = discoverPrefix "prop_"
-discoverPrefix :: String -> TExpQ Group
-discoverPrefix prefix = do
+discoverPrefix :: String -> Code Q Group
+discoverPrefix prefix = liftCode $ do
file <- getCurrentFile
properties <- Map.toList <$> runIO (readProperties prefix file)
@@ -44,24 +44,24 @@ discoverPrefix prefix = do
fmap (mkNamedProperty . fst) $
List.sortBy startLine properties
- [|| Group $$(moduleName) $$(listTE names) ||]
+ examineCode [|| Group $$(moduleName) $$(listTE names) ||]
-mkNamedProperty :: PropertyName -> TExpQ (PropertyName, Property)
+mkNamedProperty :: PropertyName -> Code Q (PropertyName, Property)
mkNamedProperty name = do
[|| (name, $$(unsafeProperty name)) ||]
-unsafeProperty :: PropertyName -> TExpQ Property
+unsafeProperty :: PropertyName -> Code Q Property
unsafeProperty =
- unsafeTExpCoerce . pure . VarE . mkName . unPropertyName
+ unsafeCodeCoerce . pure . VarE . mkName . unPropertyName
-listTE :: [TExpQ a] -> TExpQ [a]
-listTE xs = do
- unsafeTExpCoerce . pure . ListE =<< traverse unTypeQ xs
+listTE :: [Code Q a] -> Code Q [a]
+listTE xs = liftCode $ do
+ unsafeTExpCoerce . pure . ListE =<< traverse unTypeCode xs
-moduleName :: TExpQ GroupName
-moduleName = do
+moduleName :: Code Q GroupName
+moduleName = liftCode $ do
loc <- GroupName . loc_module <$> location
- [|| loc ||]
+ examineCode [|| loc ||]
getCurrentFile :: Q FilePath
getCurrentFile =
diff --git a/src/Data/HVect.hs b/src/Data/HVect.hs
index 9922e80..ce3a3d3 100644
--- a/src/Data/HVect.hs
+++ b/src/Data/HVect.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
diff --git a/Text/URI/Types.hs b/Text/URI/Types.hs
index 116359a..553af6f 100644
--- a/Text/URI/Types.hs
+++ b/Text/URI/Types.hs
@@ -126,7 +126,7 @@ instance TH.Lift URI where
lift = liftData
#if MIN_VERSION_template_haskell(2,16,0)
- liftTyped = TH.unsafeTExpCoerce . TH.lift
+ liftTyped = TH.unsafeCodeCoerce . TH.lift
#endif
-- | Make a given 'URI' reference absolute using the supplied @'RText'
@@ -169,7 +169,7 @@ instance TH.Lift Authority where
lift = liftData
#if MIN_VERSION_template_haskell(2,16,0)
- liftTyped = TH.unsafeTExpCoerce . TH.lift
+ liftTyped = TH.unsafeCodeCoerce . TH.lift
#endif
-- | User info as a combination of username and password.
@@ -195,7 +195,7 @@ instance TH.Lift UserInfo where
lift = liftData
#if MIN_VERSION_template_haskell(2,16,0)
- liftTyped = TH.unsafeTExpCoerce . TH.lift
+ liftTyped = TH.unsafeCodeCoerce . TH.lift
#endif
-- | Query parameter either in the form of flag or as a pair of key and
@@ -221,7 +221,7 @@ instance TH.Lift QueryParam where
lift = liftData
#if MIN_VERSION_template_haskell(2,16,0)
- liftTyped = TH.unsafeTExpCoerce . TH.lift
+ liftTyped = TH.unsafeCodeCoerce . TH.lift
#endif
-- | Parse exception thrown by 'mkURI' when a given 'Text' value cannot be
@@ -267,7 +267,7 @@ instance Typeable l => TH.Lift (RText l) where
lift = liftData
#if MIN_VERSION_template_haskell(2,16,0)
- liftTyped = TH.unsafeTExpCoerce . TH.lift
+ liftTyped = TH.unsafeCodeCoerce . TH.lift
#endif
-- | Refined text labels.
@@ -547,8 +547,8 @@ arbText' f = fromJust . f . T.pack <$> listOf1 arbitrary
----------------------------------------------------------------------------
-- TH lifting helpers
-liftData :: Data a => a -> TH.Q TH.Exp
+liftData :: (TH.Quote m, Data a) => a -> m TH.Exp
liftData = TH.dataToExpQ (fmap liftText . cast)
-liftText :: Text -> TH.Q TH.Exp
+liftText :: TH.Quote m => Text -> m TH.Exp
liftText t = TH.AppE (TH.VarE 'T.pack) <$> TH.lift (T.unpack t)
diff --git a/src/Control/Monad/Validate/Internal.hs b/src/Control/Monad/Validate/Internal.hs
index cfb1d6b..96aee8e 100644
--- a/src/Control/Monad/Validate/Internal.hs
+++ b/src/Control/Monad/Validate/Internal.hs
@@ -296,7 +296,7 @@ instance (Monad m) => Applicative (ValidateT e m) where
{-# INLINABLE (<*>) #-}
instance (Monad m) => Monad (ValidateT e m) where
- ValidateT x >>= f = ValidateT (x >>= (getValidateT . f))
+ ValidateT x >>= f = ValidateT (x >>= (\a -> getValidateT (f a)))
{-# INLINE (>>=) #-}
instance MonadTrans (ValidateT e) where
diff --git a/src/Pipes.hs b/src/Pipes.hs
index 7382826..b1cd820 100644
--- a/src/Pipes.hs
+++ b/src/Pipes.hs
@@ -138,7 +138,7 @@ f '~>' 'yield' = f
@
-}
yield :: Functor m => a -> Producer' a m ()
-yield = respond
+yield x = respond x
{-# INLINABLE [1] yield #-}
{-| @(for p body)@ loops over @p@ replacing each 'yield' with @body@.
@@ -183,7 +183,7 @@ for = (//>)
{-# RULES
"for (for p f) g" forall p f g . for (for p f) g = for p (\a -> for (f a) g)
- ; "for p yield" forall p . for p yield = p
+ ; "for p yield" forall p . for p (\x -> yield x) = p
; "for (yield x) f" forall x f . for (yield x) f = f x
@@ -637,7 +637,7 @@ next = go
-- | Convert a 'F.Foldable' to a 'Producer'
each :: (Functor m, Foldable f) => f a -> Producer' a m ()
-each = F.foldr (\a p -> yield a >> p) (return ())
+each f = F.foldr (\a p -> yield a >> p) (return ()) f
{-# INLINABLE each #-}
{- The above code is the same as:
diff --git a/src/Pipes/Prelude.hs b/src/Pipes/Prelude.hs
index 4ab3e0f..f37e20a 100644
--- a/src/Pipes/Prelude.hs
+++ b/src/Pipes/Prelude.hs
@@ -403,12 +403,12 @@ As a result of the second law,
> mapMaybe return = mapMaybe Just = cat
-}
mapMaybe :: Functor m => (a -> Maybe b) -> Pipe a b m r
-mapMaybe f = for cat $ maybe (pure ()) yield . f
+mapMaybe f = for cat $ maybe (pure ()) (\x -> yield x) . f
{-# INLINABLE [1] mapMaybe #-}
{-# RULES
"p >-> mapMaybe f" forall p f.
- p >-> mapMaybe f = for p $ maybe (pure ()) yield . f
+ p >-> mapMaybe f = for p $ maybe (pure ()) (\x -> yield x) . f
#-}
{-| @(filterM predicate)@ only forwards values that satisfy the monadic
@@ -453,12 +453,12 @@ As a result of the third law,
> wither (pure . const Nothing) = wither (const (pure Nothing)) = drain
-}
wither :: Monad m => (a -> m (Maybe b)) -> Pipe a b m r
-wither f = for cat $ lift . f >=> maybe (pure ()) yield
+wither f = for cat $ lift . f >=> maybe (pure ()) (\x -> yield x)
{-# INLINABLE [1] wither #-}
{-# RULES
"p >-> wither f" forall p f .
- p >-> wither f = for p $ lift . f >=> maybe (pure ()) yield
+ p >-> wither f = for p $ lift . f >=> maybe (pure ()) (\x -> yield x)
#-}
{-| @(take n)@ only allows @n@ values to pass through
@@ -474,8 +474,8 @@ wither f = for cat $ lift . f >=> maybe (pure ()) yield
take :: Functor m => Int -> Pipe a a m ()
take = go
where
- go 0 = return ()
- go n = do
+ go 0 = return ()
+ go n = do
a <- await
yield a
go (n-1)
@@ -555,11 +555,11 @@ dropWhile predicate = go
-- | Flatten all 'Foldable' elements flowing downstream
concat :: (Functor m, Foldable f) => Pipe (f a) a m r
-concat = for cat each
+concat = for cat (\x -> each x)
{-# INLINABLE [1] concat #-}
{-# RULES
- "p >-> concat" forall p . p >-> concat = for p each
+ "p >-> concat" forall p . p >-> concat = for p (\x -> each x)
#-}
-- | Outputs the indices of all elements that match the given element
@@ -653,7 +653,7 @@ show = map Prelude.show
-- | Evaluate all values flowing downstream to WHNF
seq :: Functor m => Pipe a a m r
-seq = for cat $ \a -> yield $! a
+seq = for cat $ \a -> (\x -> yield x) $! a
{-# INLINABLE seq #-}
{-| Create a `Pipe` from a `ListT` transformation
@@ -663,7 +663,7 @@ seq = for cat $ \a -> yield $! a
> loop return = cat
-}
loop :: Monad m => (a -> ListT m b) -> Pipe a b m r
-loop k = for cat (every . k)
+loop k = for cat (\x -> every (k x))
{-# INLINABLE loop #-}
{- $folds
@@ -926,7 +926,7 @@ zipWith :: Monad m
-> (Producer a m r)
-> (Producer b m r)
-> (Producer' c m r)
-zipWith f = go
+zipWith f pi1 pi2 = go pi1 pi2
where
go p1 p2 = do
e1 <- lift $ next p1
@@ -981,18 +981,18 @@ generalize p x0 = evalStateP x0 $ up >\\ hoist lift p //> dn
lift $ put x
{-# INLINABLE generalize #-}
-{-| The natural unfold into a 'Producer' with a step function and a seed
+{-| The natural unfold into a 'Producer' with a step function and a seed
> unfoldr next = id
-}
-unfoldr :: Monad m
+unfoldr :: Monad m
=> (s -> m (Either r (a, s))) -> s -> Producer a m r
unfoldr step = go where
go s0 = do
e <- lift (step s0)
case e of
Left r -> return r
- Right (a,s) -> do
+ Right (a,s) -> do
yield a
go s
{-# INLINABLE unfoldr #-}
diff --git a/library/PrimitiveExtras/Bitmap.hs b/library/PrimitiveExtras/Bitmap.hs
index d9a1fe0..ccbab8b 100644
--- a/library/PrimitiveExtras/Bitmap.hs
+++ b/library/PrimitiveExtras/Bitmap.hs
@@ -2,7 +2,7 @@ module PrimitiveExtras.Bitmap
(
Bitmap,
empty,
- singleton,
+ PrimitiveExtras.Bitmap.singleton,
insert,
invert,
indexList,
diff --git a/library/PrimitiveExtras/SparseSmallArray.hs b/library/PrimitiveExtras/SparseSmallArray.hs
index fec94db..ff6ef42 100644
--- a/library/PrimitiveExtras/SparseSmallArray.hs
+++ b/library/PrimitiveExtras/SparseSmallArray.hs
@@ -2,7 +2,7 @@ module PrimitiveExtras.SparseSmallArray
(
SparseSmallArray,
empty,
- singleton,
+ PrimitiveExtras.SparseSmallArray.singleton,
maybeList,
pair,
insert,
@@ -50,7 +50,7 @@ empty = SparseSmallArray Bitmap.empty Prelude.empty
-- An array with a single element at the specified index.
{-# INLINE singleton #-}
singleton :: Int -> e -> SparseSmallArray e
-singleton i e =
+singleton i e =
let b = Bitmap.singleton i
a = runST $ newSmallArray 1 e >>= unsafeFreezeSmallArray
in SparseSmallArray b a
@@ -58,9 +58,9 @@ singleton i e =
{-# INLINE pair #-}
pair :: Int -> e -> Int -> e -> SparseSmallArray e
pair i1 e1 i2 e2 =
- {-# SCC "pair" #-}
+ {-# SCC "pair" #-}
SparseSmallArray bitmap array
- where
+ where
bitmap = Bitmap.pair i1 i2
array = SmallArray.orderedPair i1 e1 i2 e2
@@ -76,15 +76,15 @@ It's your obligation to ensure that the index is empty before the operation.
{-# INLINE insert #-}
insert :: Int -> e -> SparseSmallArray e -> SparseSmallArray e
insert i e (SparseSmallArray b a) =
- {-# SCC "insert" #-}
+ {-# SCC "insert" #-}
let
sparseIndex = Bitmap.populatedIndex i b
in SparseSmallArray (Bitmap.insert i b) (SmallArray.insert sparseIndex e a)
-
+
{-# INLINE replace #-}
replace :: Int -> e -> SparseSmallArray e -> SparseSmallArray e
replace i e (SparseSmallArray b a) =
- {-# SCC "replace" #-}
+ {-# SCC "replace" #-}
let
sparseIndex = Bitmap.populatedIndex i b
in SparseSmallArray b (SmallArray.set sparseIndex e a)
@@ -109,7 +109,7 @@ unset i (SparseSmallArray b a) =
{-# INLINE lookup #-}
lookup :: Int -> SparseSmallArray e -> Maybe e