Commit 0c85ab52 authored by Ryan Scott's avatar Ryan Scott
Browse files

Merge branch 'T43' into 'master'

Use better text-2.0–accommodating patches for cribit, double-conversion

See merge request !204
parents 4be96eb0 0ac2b250
Pipeline #47721 failed with stages
in 53 minutes and 31 seconds
......@@ -98,7 +98,7 @@ esac
#
# These are packages which we don't have patches for but want to test anyways.
extra_package lens 5.0.1
extra_package aeson 2.0.2.0
extra_package aeson 2.0.3.0
extra_package criterion
extra_package scotty
extra_package generic-lens 2.2.0.0
......
diff --git a/src-pure/Data/Aeson/Parser/UnescapePure.hs b/src-pure/Data/Aeson/Parser/UnescapePure.hs
index 26e9ac8..fbdb448 100644
--- a/src-pure/Data/Aeson/Parser/UnescapePure.hs
+++ b/src-pure/Data/Aeson/Parser/UnescapePure.hs
@@ -5,6 +5,9 @@
-- The security check at the end (pos > length) only works if pos grows
-- monotonously, if this condition does not hold, the check is flawed.
+
+{-# LANGUAGE CPP #-}
+
module Data.Aeson.Parser.UnescapePure
(
unescapeText
@@ -13,7 +16,6 @@ module Data.Aeson.Parser.UnescapePure
import Control.Exception (evaluate, throw, try)
import Control.Monad (when)
import Data.ByteString as B
-import Data.Bits (Bits, shiftL, shiftR, (.&.), (.|.))
import Data.Text (Text)
import qualified Data.Text.Array as A
import Data.Text.Encoding.Error (UnicodeException (..))
@@ -22,6 +24,22 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)
import Data.Word (Word8, Word16, Word32)
import GHC.ST (ST)
+#if MIN_VERSION_text(2,0,0)
+import Data.Bits (Bits, shiftL, (.&.), (.|.))
+import Data.Text.Internal.Encoding.Utf16 (chr2)
+import Data.Text.Internal.Unsafe.Char (unsafeChr16, unsafeChr32, unsafeWrite)
+#else
+import Data.Bits (Bits, shiftL, shiftR, (.&.), (.|.))
+#endif
+
+#if MIN_VERSION_text(2,0,0)
+import Data.Bits (Bits, shiftL, (.&.), (.|.))
+import Data.Text.Internal.Encoding.Utf16 (chr2)
+import Data.Text.Internal.Unsafe.Char (unsafeChr16, unsafeChr32, unsafeWrite)
+#else
+import Data.Bits (Bits, shiftL, shiftR, (.&.), (.|.))
+#endif
+
-- Different UTF states.
data Utf =
UtfGround
@@ -42,12 +60,12 @@ data State =
| StateU1 !Word16
| StateU2 !Word16
| StateU3 !Word16
- | StateS0
- | StateS1
- | StateSU0
- | StateSU1 !Word16
- | StateSU2 !Word16
- | StateSU3 !Word16
+ | StateS0 !Word16
+ | StateS1 !Word16
+ | StateSU0 !Word16
+ | StateSU1 !Word16 !Word16
+ | StateSU2 !Word16 !Word16
+ | StateSU3 !Word16 !Word16
deriving (Eq)
-- References:
@@ -144,11 +162,17 @@ unescapeText' bs = runText $ \done -> do
runUtf dest pos st point c = case decode st point c of
(UtfGround, 92) -> -- Backslash
return (pos, StateBackslash)
+#if MIN_VERSION_text(2,0,0)
+ (UtfGround, w) -> do
+ d <- unsafeWrite dest pos (unsafeChr32 w)
+ return (pos + d, StateNone)
+#else
(UtfGround, w) | w <= 0xffff ->
writeAndReturn dest pos (fromIntegral w) StateNone
(UtfGround, w) -> do
- write dest pos (0xd7c0 + fromIntegral (w `shiftR` 10))
+ A.unsafeWrite dest pos (0xd7c0 + fromIntegral (w `shiftR` 10))
writeAndReturn dest (pos + 1) (0xdc00 + fromIntegral (w .&. 0x3ff)) StateNone
+#endif
(st', p) ->
return (pos, StateUtf st' p)
@@ -195,53 +219,60 @@ unescapeText' bs = runText $ \done -> do
let u = w' .|. w in
-- Get next state based on surrogates.
- let st
- | u >= 0xd800 && u <= 0xdbff = -- High surrogate.
- StateS0
- | u >= 0xdc00 && u <= 0xdfff = -- Low surrogate.
- throwDecodeError
- | otherwise =
- StateNone
- in
- writeAndReturn dest pos u st
+ if u >= 0xd800 && u <= 0xdbff then -- High surrogate.
+ return (pos, StateS0 u)
+ else if u >= 0xdc00 && u <= 0xdfff then -- Low surrogate.
+ throwDecodeError
+ else do
+#if MIN_VERSION_text(2,0,0)
+ d <- unsafeWrite dest pos (unsafeChr16 u)
+ return (pos + d, StateNone)
+#else
+ writeAndReturn dest pos u StateNone
+#endif
-- Handle surrogates.
- f _ (pos, StateS0) 92 = return (pos, StateS1) -- Backslash
- f _ ( _, StateS0) _ = throwDecodeError
+ f _ (pos, StateS0 hi) 92 = return (pos, StateS1 hi) -- Backslash
+ f _ ( _, StateS0{}) _ = throwDecodeError
- f _ (pos, StateS1) 117 = return (pos, StateSU0) -- u
- f _ ( _, StateS1) _ = throwDecodeError
+ f _ (pos, StateS1 hi) 117 = return (pos, StateSU0 hi) -- u
+ f _ ( _, StateS1{}) _ = throwDecodeError
- f _ (pos, StateSU0) c =
+ f _ (pos, StateSU0 hi) c =
let w = decodeHex c in
- return (pos, StateSU1 (w `shiftL` 12))
+ return (pos, StateSU1 hi (w `shiftL` 12))
- f _ (pos, StateSU1 w') c =
+ f _ (pos, StateSU1 hi w') c =
let w = decodeHex c in
- return (pos, StateSU2 (w' .|. (w `shiftL` 8)))
+ return (pos, StateSU2 hi (w' .|. (w `shiftL` 8)))
- f _ (pos, StateSU2 w') c =
+ f _ (pos, StateSU2 hi w') c =
let w = decodeHex c in
- return (pos, StateSU3 (w' .|. (w `shiftL` 4)))
+ return (pos, StateSU3 hi (w' .|. (w `shiftL` 4)))
- f dest (pos, StateSU3 w') c =
+ f dest (pos, StateSU3 hi w') c =
let w = decodeHex c in
let u = w' .|. w in
-- Check if not low surrogate.
if u < 0xdc00 || u > 0xdfff then
throwDecodeError
- else
- writeAndReturn dest pos u StateNone
-
-write :: A.MArray s -> Int -> Word16 -> ST s ()
-write dest pos char =
- A.unsafeWrite dest pos char
-{-# INLINE write #-}
-
+ else do
+#if MIN_VERSION_text(2,0,0)
+ d <- unsafeWrite dest pos (chr2 hi u)
+ return (pos + d, StateNone)
+#else
+ A.unsafeWrite dest pos hi
+ writeAndReturn dest (pos + 1) u StateNone
+#endif
+
+#if MIN_VERSION_text(2,0,0)
+writeAndReturn :: A.MArray s -> Int -> Word8 -> t -> ST s (Int, t)
+#else
writeAndReturn :: A.MArray s -> Int -> Word16 -> t -> ST s (Int, t)
+#endif
writeAndReturn dest pos char res = do
- write dest pos char
+ A.unsafeWrite dest pos char
return (pos + 1, res)
{-# INLINE writeAndReturn #-}
diff --git a/src/Data/Aeson/Encoding/Builder.hs b/src/Data/Aeson/Encoding/Builder.hs
index fb3696d..07e29b7 100644
--- a/src/Data/Aeson/Encoding/Builder.hs
+++ b/src/Data/Aeson/Encoding/Builder.hs
@@ -44,7 +44,7 @@ import Data.Aeson.Internal.Time
import Data.Aeson.Types.Internal (Value (..), Key)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
-import Data.ByteString.Builder as B
+import Data.ByteString.Builder as B hiding (scientific)
import Data.ByteString.Builder.Prim as BP
import Data.ByteString.Builder.Scientific (scientificBuilder)
import Data.Char (chr, ord)
diff --git a/src/Data/Aeson/Parser/Internal.hs b/src/Data/Aeson/Parser/Internal.hs
index 5c75c3e..ab3d371 100644
--- a/src/Data/Aeson/Parser/Internal.hs
+++ b/src/Data/Aeson/Parser/Internal.hs
@@ -342,11 +342,16 @@ jstring_ = do
Just w | w < 0x20 -> fail "unescaped control character"
_ -> jstringSlow s
+#if MIN_VERSION_text(2,0,0)
+unsafeDecodeASCII :: B.ByteString -> Text
+unsafeDecodeASCII = TE.decodeASCII
+#else
-- | The input is assumed to contain only 7bit ASCII characters (i.e. @< 0x80@).
-- We use TE.decodeLatin1 here because TE.decodeASCII is currently (text-1.2.4.0)
-- deprecated and equal to TE.decodeUtf8, which is slower than TE.decodeLatin1.
unsafeDecodeASCII :: B.ByteString -> Text
unsafeDecodeASCII = TE.decodeLatin1
+#endif
jstringSlow :: B.ByteString -> Parser Text
{-# INLINE jstringSlow #-}
diff --git a/Data/Attoparsec/Text/Buffer.hs b/Data/Attoparsec/Text/Buffer.hs
index 47e72c3..6a51dd9 100644
--- a/Data/Attoparsec/Text/Buffer.hs
+++ b/Data/Attoparsec/Text/Buffer.hs
@@ -34,7 +34,8 @@ module Data.Attoparsec.Text.Buffer
, iter
, iter_
, substring
- , dropWord16
+ , lengthCodeUnits
+ , dropCodeUnits
) where
import Control.Exception (assert)
@@ -44,8 +45,14 @@ import Data.Monoid as Mon (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.Text ()
import Data.Text.Internal (Text(..))
+#if MIN_VERSION_text(2,0,0)
+import Data.Text.Internal.Encoding.Utf8 (utf8LengthByLeader)
+import Data.Text.Unsafe (iterArray, lengthWord8)
+#else
import Data.Text.Internal.Encoding.Utf16 (chr2)
import Data.Text.Internal.Unsafe.Char (unsafeChr)
+import Data.Text.Unsafe (lengthWord16)
+#endif
import Data.Text.Unsafe (Iter(..))
import Foreign.Storable (sizeOf)
import GHC.Exts (Int(..), indexIntArray#, unsafeCoerce#, writeIntArray#)
@@ -108,7 +115,11 @@ append (Buf arr0 off0 len0 cap0 gen0) !arr1 !off1 !len1 = runST $ do
let newgen = gen + 1
marr <- unsafeThaw arr0
writeGen marr newgen
+#if MIN_VERSION_text(2,0,0)
+ A.copyI newlen marr (off0+len0) arr1 off1
+#else
A.copyI marr (off0+len0) arr1 off1 (off0+newlen)
+#endif
arr2 <- A.unsafeFreeze marr
return (Buf arr2 off0 newlen cap0 newgen)
else do
@@ -116,8 +127,13 @@ append (Buf arr0 off0 len0 cap0 gen0) !arr1 !off1 !len1 = runST $ do
newgen = 1
marr <- A.new (newcap + woff)
writeGen marr newgen
+#if MIN_VERSION_text(2,0,0)
+ A.copyI len0 marr woff arr0 off0
+ A.copyI newlen marr (woff+len0) arr1 off1
+#else
A.copyI marr woff arr0 off0 (woff+len0)
A.copyI marr (woff+len0) arr1 off1 (woff+newlen)
+#endif
arr2 <- A.unsafeFreeze marr
return (Buf arr2 woff newlen newcap newgen)
@@ -132,11 +148,52 @@ substring s l (Buf arr off len _ _) =
Text arr (off+s) l
{-# INLINE substring #-}
-dropWord16 :: Int -> Buffer -> Text
-dropWord16 s (Buf arr off len _ _) =
+#if MIN_VERSION_text(2,0,0)
+
+lengthCodeUnits :: Text -> Int
+lengthCodeUnits = lengthWord8
+
+dropCodeUnits :: Int -> Buffer -> Text
+dropCodeUnits s (Buf arr off len _ _) =
+ assert (s >= 0 && s <= len) $
+ Text arr (off+s) (len-s)
+{-# INLINE dropCodeUnits #-}
+
+-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-8
+-- array, returning the current character and the delta to add to give
+-- the next offset to iterate at.
+iter :: Buffer -> Int -> Iter
+iter (Buf arr off _ _ _) i = iterArray arr (off + i)
+{-# INLINE iter #-}
+
+-- | /O(1)/ Iterate one step through a UTF-8 array, returning the
+-- delta to add to give the next offset to iterate at.
+iter_ :: Buffer -> Int -> Int
+iter_ (Buf arr off _ _ _) i = utf8LengthByLeader $ A.unsafeIndex arr (off+i)
+{-# INLINE iter_ #-}
+
+unsafeThaw :: A.Array -> ST s (A.MArray s)
+unsafeThaw (A.ByteArray a) = ST $ \s# ->
+ (# s#, A.MutableByteArray (unsafeCoerce# a) #)
+
+readGen :: A.Array -> Int
+readGen (A.ByteArray a) = case indexIntArray# a 0# of r# -> I# r#
+
+writeGen :: A.MArray s -> Int -> ST s ()
+writeGen (A.MutableByteArray a) (I# gen#) = ST $ \s0# ->
+ case writeIntArray# a 0# gen# s0# of
+ s1# -> (# s1#, () #)
+
+#else
+
+lengthCodeUnits :: Text -> Int
+lengthCodeUnits = lengthWord16
+
+dropCodeUnits :: Int -> Buffer -> Text
+dropCodeUnits s (Buf arr off len _ _) =
assert (s >= 0 && s <= len) $
Text arr (off+s) (len-s)
-{-# INLINE dropWord16 #-}
+{-# INLINE dropCodeUnits #-}
-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16
-- array, returning the current character and the delta to add to give
@@ -170,3 +227,5 @@ writeGen :: A.MArray s -> Int -> ST s ()
writeGen a (I# gen#) = ST $ \s0# ->
case writeIntArray# (A.maBA a) 0# gen# s0# of
s1# -> (# s1#, () #)
+
+#endif
diff --git a/Data/Attoparsec/Text/Internal.hs b/Data/Attoparsec/Text/Internal.hs
index 710d23e..02f04fd 100644
--- a/Data/Attoparsec/Text/Internal.hs
+++ b/Data/Attoparsec/Text/Internal.hs
@@ -176,7 +176,7 @@ string_ suspended f s0 = T.Parser $ \t pos more lose succ ->
| T.null ft -> suspended s s t pos more lose succ
| otherwise -> lose t pos more [] "string"
Just (pfx,ssfx,tsfx)
- | T.null ssfx -> let l = Pos (T.lengthWord16 pfx)
+ | T.null ssfx -> let l = Pos (Buf.lengthCodeUnits pfx)
in succ t (pos + l) more (substring pos l t)
| not (T.null tsfx) -> lose t pos more [] "string"
| otherwise -> suspended s ssfx t pos more lose succ
@@ -195,7 +195,7 @@ stringSuspended f s000 s0 t0 pos0 more0 lose0 succ0 =
in case T.commonPrefixes s0 s of
Nothing -> lose t pos more [] "string"
Just (_pfx,ssfx,tsfx)
- | T.null ssfx -> let l = Pos (T.lengthWord16 s000)
+ | T.null ssfx -> let l = Pos (Buf.lengthCodeUnits s000)
in succ t (pos + l) more (substring pos l t)
| T.null tsfx -> stringSuspended f s000 ssfx t pos more lose succ
| otherwise -> lose t pos more [] "string"
@@ -445,12 +445,12 @@ endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())
-- | Terminal failure continuation.
failK :: Failure a
-failK t (Pos pos) _more stack msg = Fail (Buf.dropWord16 pos t) stack msg
+failK t (Pos pos) _more stack msg = Fail (Buf.dropCodeUnits pos t) stack msg
{-# INLINE failK #-}
-- | Terminal success continuation.
successK :: Success a a
-successK t (Pos pos) _more a = Done (Buf.dropWord16 pos t) a
+successK t (Pos pos) _more a = Done (Buf.dropCodeUnits pos t) a
{-# INLINE successK #-}
-- | Run a parser.
@@ -477,7 +477,7 @@ parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of
get :: Parser Text
get = T.Parser $ \t pos more _lose succ ->
- succ t pos more (Buf.dropWord16 (fromPos pos) t)
+ succ t pos more (Buf.dropCodeUnits (fromPos pos) t)
{-# INLINE get #-}
endOfChunk :: Parser Bool
diff --git a/tests/QC/Buffer.hs b/tests/QC/Buffer.hs
index 7227b72..277e093 100644
--- a/tests/QC/Buffer.hs
+++ b/tests/QC/Buffer.hs
@@ -51,7 +51,7 @@ b_length :: BPB -> Property
b_length (BP _ts t buf) = B.length t === BB.length buf
t_length :: BPT -> Property
-t_length (BP _ts t buf) = T.lengthWord16 t === BT.length buf
+t_length (BP _ts t buf) = BT.lengthCodeUnits t === BT.length buf
b_unsafeIndex :: BPB -> Gen Property
b_unsafeIndex (BP _ts t buf) = do
@@ -61,14 +61,14 @@ b_unsafeIndex (BP _ts t buf) = do
t_iter :: BPT -> Gen Property
t_iter (BP _ts t buf) = do
- let l = T.lengthWord16 t
+ let l = BT.lengthCodeUnits t
i <- choose (0,l-1)
let it (T.Iter c q) = (c,q)
return $ l === 0 .||. it (T.iter t i) === it (BT.iter buf i)
t_iter_ :: BPT -> Gen Property
t_iter_ (BP _ts t buf) = do
- let l = T.lengthWord16 t
+ let l = BT.lengthCodeUnits t
i <- choose (0,l-1)
return $ l === 0 .||. T.iter_ t i === BT.iter_ buf i
@@ -77,10 +77,16 @@ b_unsafeDrop (BP _ts t buf) = do
i <- choose (0, B.length t)
return $ B.unsafeDrop i t === BB.unsafeDrop i buf
-t_dropWord16 :: BPT -> Gen Property
-t_dropWord16 (BP _ts t buf) = do
- i <- choose (0, T.lengthWord16 t)
- return $ T.dropWord16 i t === BT.dropWord16 i buf
+t_dropCodeUnits :: BPT -> Gen Property
+t_dropCodeUnits (BP _ts t buf) = do
+ i <- choose (0, BT.lengthCodeUnits t)
+ return $ dropCodeUnits i t === BT.dropCodeUnits i buf
+ where
+#if MIN_VERSION_text(2,0,0)
+ dropCodeUnits = T.dropWord8
+#else
+ dropCodeUnits = T.dropWord16
+#endif
tests :: [TestTree]
tests = [
@@ -92,5 +98,5 @@ tests = [
, testProperty "t_iter" t_iter
, testProperty "t_iter_" t_iter_
, testProperty "b_unsafeDrop" b_unsafeDrop
- , testProperty "t_dropWord16" t_dropWord16
+ , testProperty "t_dropCodeUnits" t_dropCodeUnits
]
diff --git a/src/Data/Constraint/Extras/TH.hs b/src/Data/Constraint/Extras/TH.hs
index 9259409..b22c80b 100644
--- a/src/Data/Constraint/Extras/TH.hs
+++ b/src/Data/Constraint/Extras/TH.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
@@ -52,7 +53,11 @@ matches c constrs argDictName = do
Nothing -> WildP : rest done
Just _ -> VarP v : rest True
pat = foldr patf (const []) ps False
- in [Match (ConP name pat) (NormalB $ AppE (VarE argDictName) (VarE v)) []]
+ in [Match (ConP name
+#if MIN_VERSION_template_haskell(2,18,0)
+ []
+#endif
+ pat) (NormalB $ AppE (VarE argDictName) (VarE v)) []]
ForallC _ _ (GadtC [name] _ _) -> return $
[Match (RecP name []) (NormalB $ ConE 'Dict) []]
a -> error $ "deriveArgDict matches: Unmatched 'Dec': " ++ show a
diff --git a/Data/CritBit/Set.hs b/Data/CritBit/Set.hs
index 0039925..eab81a5 100644
index 0039925..4a4ffc4 100644
--- a/Data/CritBit/Set.hs
+++ b/Data/CritBit/Set.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
@@ -90,6 +91,9 @@ import Data.CritBit.Types.Internal (CritBit(..), Set(..), CritBitKey, Node(..))
@@ -90,6 +90,7 @@ import Data.CritBit.Types.Internal (CritBit(..), Set(..), CritBitKey, Node(..))
import Data.Foldable (Foldable, foldMap)
import Data.Maybe (isJust)
import Data.Monoid (Monoid(..))
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup(..))
+#endif
import Prelude hiding (null, filter, map, foldl, foldr)
import qualified Data.CritBit.Tree as T
import qualified Data.List as List
@@ -97,9 +101,16 @@ import qualified Data.List as List
@@ -97,9 +98,12 @@ import qualified Data.List as List
instance (Show a) => Show (Set a) where
show s = "fromList " ++ show (toList s)
+#if MIN_VERSION_base(4,9,0)
+instance CritBitKey k => Semigroup (Set k) where
+ (<>) = union
+#endif
+
instance CritBitKey k => Monoid (Set k) where
mempty = empty
+#if !(MIN_VERSION_base(4,11,0))
mappend = union
+#endif
- mappend = union
+ mappend = (<>)
mconcat = unions
instance Foldable Set where
diff --git a/Data/CritBit/Tree.hs b/Data/CritBit/Tree.hs
index e50738b..9a3c3d4 100644
index e50738b..5eb95fa 100644
--- a/Data/CritBit/Tree.hs
+++ b/Data/CritBit/Tree.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, RecordWildCards, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, BangPatterns, RecordWildCards, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
@@ -153,21 +153,31 @@ import Data.CritBit.Core
@@ -153,15 +153,19 @@ import Data.CritBit.Core
import Data.CritBit.Types.Internal
import Data.Maybe (fromMaybe)
import Data.Monoid (Monoid(..))
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup (Semigroup(..))
+#endif
import Data.Traversable (Traversable(traverse))
import Prelude hiding (foldl, foldr, lookup, null, map, filter)
import qualified Data.Array as A
import qualified Data.Foldable as Foldable
import qualified Data.List as List
+#if MIN_VERSION_base(4,9,0)
+instance CritBitKey k => Semigroup (CritBit k v) where
+ (<>) = union
+#endif
+
instance CritBitKey k => Monoid (CritBit k v) where
mempty = empty
+#if !(MIN_VERSION_base(4,11,0))
mappend = union
+#endif
- mappend = union
+ mappend = (<>)
mconcat = unions
instance CritBitKey k => Traversable (CritBit k) where
traverse f m = traverseWithKey (\_ v -> f v) m
-infixl 9 !, \\
+infixl 9 !, \\ -- Comment needed here to avoid CPP bug
-- | /O(k)/. Find the value at a key.
-- Calls 'error' when the element can not be found.
@@ -1248,8 +1258,7 @@ deleteMax m = updateMaxWithKey (\_ _ -> Nothing) m
-- > deleteFindMin Error: can not return the minimal element of an empty map
deleteFindMin :: CritBit k v -> ((k, v), CritBit k v)
deleteFindMin = fromMaybe (error msg) . minViewWithKey
- where msg = "CritBit.deleteFindMin: cannot return the minimal \
- \element of an empty map"
+ where msg = "CritBit.deleteFindMin: cannot return the minimal element of an empty map"
{-# INLINABLE deleteFindMin #-}
-- | /O(k)/. Delete and find the maximal element.
@@ -1258,8 +1267,7 @@ deleteFindMin = fromMaybe (error msg) . minViewWithKey
-- > deleteFindMax Error: can not return the maximal element of an empty map
deleteFindMax :: CritBit k v -> ((k, v), CritBit k v)
deleteFindMax = fromMaybe (error msg) . maxViewWithKey
- where msg = "CritBit.deleteFindMax: cannot return the minimal \
- \element of an empty map"
+ where msg = "CritBit.deleteFindMax: cannot return the minimal element of an empty map"
{-# INLINABLE deleteFindMax #-}
-- | /O(k')/. Retrieves the value associated with minimal key of the
diff --git a/Data/CritBit/Types/Internal.hs b/Data/CritBit/Types/Internal.hs
index d278b5a..4008ec7 100644
index d278b5a..d537ad6 100644
--- a/Data/CritBit/Types/Internal.hs
+++ b/Data/CritBit/Types/Internal.hs
@@ -192,7 +192,11 @@ instance CritBitKey Text where
@@ -185,15 +185,25 @@ instance CritBitKey ByteString where
{-# INLINE getByte #-}
instance CritBitKey Text where
+#if MIN_VERSION_text(2,0,0)
+ byteCount (Text _ _ len) = len
+#else
byteCount (Text _ _ len) = len `shiftL` 1
+#endif
{-# INLINE byteCount #-}
+#if MIN_VERSION_text(2,0,0)
+ getByte (Text arr off len) n
+ | n < len = fromIntegral (T.unsafeIndex arr (off + n)) .|. 256
+ | otherwise = 0
+#else
getByte (Text arr off len) n
| n < len `shiftL` 1 =
let word = T.unsafeIndex arr (off + (n `shiftR` 1))
byteInWord = (word `shiftR` ((n .&. 1) `shiftL` 3)) .&. 0xff
+#if MIN_VERSION_text(2,0,0)
+ in fromIntegral (byteInWord .|. 256)
+#else
in byteInWord .|. 256
+#endif
| otherwise = 0
+#endif
{-# INLINE getByte #-}
#if WORD_SIZE_IN_BITS == 64
diff --git a/src/Data/DoubleWord/TH.hs b/src/Data/DoubleWord/TH.hs
index 78bbfa9..24f93e1 100644
--- a/src/Data/DoubleWord/TH.hs
+++ b/src/Data/DoubleWord/TH.hs
@@ -157,7 +157,7 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $
-}
[ funHiLo2 'compare $
CaseE (appVN 'compare [hi, hi'])
- [ Match (ConP 'EQ []) (NormalB (appVN 'compare [lo, lo'])) []
+ [ Match (conPCompat 'EQ []) (NormalB (appVN 'compare [lo, lo'])) []
, Match (VarP x) (NormalB (VarE x)) [] ]
, inlinable 'compare ]
, inst ''Bounded [tp]
@@ -213,10 +213,10 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $
fromEnum _ = ERROR
-}
, FunD 'fromEnum $
- Clause [ConP cn [LitP $ IntegerL 0, VarP lo]]
+ Clause [conPCompat cn [LitP $ IntegerL 0, VarP lo]]
(NormalB $ appVN 'fromEnum [lo]) [] :
if signed
- then [ Clause [ConP cn [LitP $ IntegerL (-1), VarP lo]]
+ then [ Clause [conPCompat cn [LitP $ IntegerL (-1), VarP lo]]
(NormalB $
appV 'negate
[appV 'fromEnum [appV 'negate [VarE lo]]])
@@ -257,9 +257,9 @@ mkDoubleWord' signed tp cn otp ocn hiS hiT loS loT ad = (<$> mkRules) $ (++) $