44ceb33 · text · git.iko.soy

git.iko.soy/text

on master help sign in

lazy bits

44ceb33Luigy Leon10 years ago

Data/Text/Internal/Lazy.hs+27−16

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}

1+{-# LANGUAGE BangPatterns, DeriveDataTypeable, CPP #-}

2{-# OPTIONS_HADDOCK not-home #-}

4-- |

@@ -44,9 +44,9 @@ import Data.Typeable (Typeable)

44import Foreign.Storable (sizeOf)

45import qualified Data.Text.Internal as T

47−-- GHCJS

47+#ifdef __GHCJS__

48import qualified Data.Text as TT

49−--

49+#endif

51data Text = Empty

52 | Chunk {-# UNPACK #-} !T.Text Text

@@ -61,20 +61,28 @@ data Text = Empty

61-- | Check the invariant strictly.

62strictInvariant :: Text -> Bool

63strictInvariant Empty = True

64−-- TODO only used for QuickCheck ?

64+#ifndef __GHCJS__

65−-- strictInvariant x@(Chunk (T.Text _ _ len) cs)

65+strictInvariant x@(Chunk (T.Text _ _ len) cs)

66−-- | len > 0 = strictInvariant cs

66+ | len > 0 = strictInvariant cs

67+#else

68+strictInvariant x@(Chunk t cs)

69+ | TT.length t > 0 = strictInvariant cs

70+#endif

67−-- | otherwise = error $ "Data.Text.Lazy: invariant violation: "

71+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "

68−-- ++ showStructure x

72+ ++ showStructure x

70-- | Check the invariant lazily.

74-- | Check the invariant lazily.

71lazyInvariant :: Text -> Text

75lazyInvariant :: Text -> Text

72lazyInvariant Empty = Empty

76lazyInvariant Empty = Empty

73−-- TODO only used for quickcheck

77+#ifndef __GHCJS__

74−-- lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)

78+lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)

75−-- | len > 0 = Chunk c (lazyInvariant cs)

79+ | len > 0 = Chunk c (lazyInvariant cs)

80+#else

81+lazyInvariant x@(Chunk c cs)

82+ | TT.length c > 0 = Chunk c (lazyInvariant cs)

83+#endif

76−-- | otherwise = error $ "Data.Text.Lazy: invariant violation: "

84+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "

77−-- ++ showStructure x

85+ ++ showStructure x

79-- | Display the internal structure of a lazy 'Text'.

87-- | Display the internal structure of a lazy 'Text'.

80showStructure :: Text -> String

88showStructure :: Text -> String

@@ -86,10 +94,13 @@ showStructure (Chunk t ts) =

86-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.

94-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.

87chunk :: T.Text -> Text -> Text

95chunk :: T.Text -> Text -> Text

88{-# INLINE chunk #-}

96{-# INLINE chunk #-}

97+#ifndef __GHCJS__

89−chunk t ts | TT.length t == 0 = ts

98+chunk t@(T.Text _ _ len) ts | len == 0 = ts

99+ | otherwise = Chunk t ts

100+#else

101+chunk t ts | TT.null t = ts

90 | otherwise = Chunk t ts

102 | otherwise = Chunk t ts

91−-- chunk t@(T.Text _ _ len) ts | len == 0 = ts

103+#endif

92−-- | otherwise = Chunk t ts

104

94-- | Smart constructor for 'Empty'.

105-- | Smart constructor for 'Empty'.

95empty :: Text

106empty :: Text

Data/Text/Lazy.hs+97−54

@@ -6,7 +6,9 @@

6#if __GLASGOW_HASKELL__ >= 708

7{-# LANGUAGE TypeFamilies #-}

8#endif

9−

9+#ifdef __GHCJS__

10+{-# LANGUAGE ForeignFunctionInterface #-}

11+#endif

10-- |

12-- |

11-- Module : Data.Text.Lazy

13-- Module : Data.Text.Lazy

@@ -244,6 +246,9 @@ import GHC.Prim (Addr#)

244#if MIN_VERSION_base(4,7,0)

246#if MIN_VERSION_base(4,7,0)

245import Text.Printf (PrintfArg, formatArg, formatString)

247import Text.Printf (PrintfArg, formatArg, formatString)

246#endif

248#endif

249+#ifdef __GHCJS__

250+import Data.JSString (JSString)

251+#endif

247

252

248-- $fusion

253-- $fusion

249--

254--

@@ -301,16 +306,15 @@ equal :: Text -> Text -> Bool

301equal Empty Empty = True

306equal Empty Empty = True

302equal Empty _ = False

307equal Empty _ = False

303equal _ Empty = False

308equal _ Empty = False

304−equal _ _ = error "Data.Text.Lazy.equal: not implemented."

305−-- equal (Chunk a as) (Chunk b bs) =

309+equal (Chunk a as) (Chunk b bs) =

306−-- case compare lenA lenB of

310+ case compare lenA lenB of

307−-- LT -> a == (T.takeWord16 lenA b) &&

311+ LT -> a == (T.takeWord16 lenA b) &&

308−-- as `equal` Chunk (T.dropWord16 lenA b) bs

312+ as `equal` Chunk (T.dropWord16 lenA b) bs

309−-- EQ -> a == b && as `equal` bs

313+ EQ -> a == b && as `equal` bs

310−-- GT -> T.takeWord16 lenB a == b &&

314+ GT -> T.takeWord16 lenB a == b &&

311−-- Chunk (T.dropWord16 lenB a) as `equal` bs

315+ Chunk (T.dropWord16 lenB a) as `equal` bs

312−-- where lenA = T.lengthWord16 a

316+ where lenA = T.lengthWord16 a

313−-- lenB = T.lengthWord16 b

317+ lenB = T.lengthWord16 b

314

318

315instance Eq Text where

319instance Eq Text where

316 (==) = equal

320 (==) = equal

@@ -323,19 +327,33 @@ compareText :: Text -> Text -> Ordering

323compareText Empty Empty = EQ

327compareText Empty Empty = EQ

324compareText Empty _ = LT

328compareText Empty _ = LT

325compareText _ Empty = GT

329compareText _ Empty = GT

326−compareText (Chunk a0 as) (Chunk b0 bs) = error "Data.Text.Lazy.compareText: not implemented."

330+compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0

327−-- compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0

328−-- where

331+ where

332+#ifndef __GHCJS__

329−-- outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0

333+ outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0

330−-- where

334+ where

331−-- go !i !j

335+ go !i !j

332−-- | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)

336+ | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)

333−-- | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs

337+ | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs

338+ | a < b = LT

339+ | a > b = GT

340+ | otherwise = go (i+di) (j+dj)

341+ where T.Iter a di = T.iter ta i

342+ T.Iter b dj = T.iter tb j

343+#else

344+ outer ta@(T.Text jsa) tb@(T.Text jsb) = go 0 0

345+ where

346+ go !i !j

347+ | i >= lenA = compareText as (chunk (T.Text (js_substr1 j jsb)) bs)

348+ | j >= lenB = compareText (chunk (T.Text (js_substr1 i jsa)) as) bs

334−-- | a < b = LT

349+ | a < b = LT

335−-- | a > b = GT

350+ | a > b = GT

336−-- | otherwise = go (i+di) (j+dj)

351+ | otherwise = go (i+di) (j+dj)

337−-- where T.Iter a di = T.iter ta i

352+ where T.Iter a di = T.iter ta i

338−-- T.Iter b dj = T.iter tb j

353+ T.Iter b dj = T.iter tb j

354+ lenA = T.length ta

355+ lenB = T.length tb

356+#endif

339

357

340instance Show Text where

358instance Show Text where

341 showsPrec p ps r = showsPrec p (unpack ps) r

359 showsPrec p ps r = showsPrec p (unpack ps) r

@@ -547,7 +565,7 @@ tail Empty = emptyError "tail"

547 unstream (S.tail (stream t)) = tail t

565 unstream (S.tail (stream t)) = tail t

548 #-}

566 #-}

549

567

550−-- | /O(1)/ Returns all but the last character of a 'Text', which must

568+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must

551-- be non-empty. Subject to fusion.

569-- be non-empty. Subject to fusion.

552init :: Text -> Text

570init :: Text -> Text

553init (Chunk t0 ts0) = go t0 ts0

571init (Chunk t0 ts0) = go t0 ts0

@@ -583,7 +601,7 @@ isSingleton :: Text -> Bool

583isSingleton = S.isSingleton . stream

601isSingleton = S.isSingleton . stream

584{-# INLINE isSingleton #-}

602{-# INLINE isSingleton #-}

585

603

586−-- | /O(1)/ Returns the last character of a 'Text', which must be

604+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be

587-- non-empty. Subject to fusion.

605-- non-empty. Subject to fusion.

588last :: Text -> Char

606last :: Text -> Char

589last Empty = emptyError "last"

607last Empty = emptyError "last"

@@ -1116,17 +1134,25 @@ dropEnd n t0

1116-- values dropped, or the empty 'Text' if @n@ is greater than the

1134-- values dropped, or the empty 'Text' if @n@ is greater than the

1117-- number of 'Word16' values present.

1135-- number of 'Word16' values present.

1118dropWords :: Int64 -> Text -> Text

1136dropWords :: Int64 -> Text -> Text

1119−dropWords = P.undefined

1137+dropWords i t0

1120−-- dropWords i t0

1121−-- | i <= 0 = t0

1138+ | i <= 0 = t0

1122−-- | otherwise = drop' i t0

1139+ | otherwise = drop' i t0

1123−-- where drop' 0 ts = ts

1140+ where drop' 0 ts = ts

1124−-- drop' _ Empty = Empty

1141+ drop' _ Empty = Empty

1142+#ifndef __GHCJS__

1125−-- drop' n (Chunk (T.Text arr off len) ts)

1143+ drop' n (Chunk (T.Text arr off len) ts)

1126−-- | n < len' = chunk (text arr (off+n') (len-n')) ts

1144+ | n < len' = chunk (text arr (off+n') (len-n')) ts

1145+ | otherwise = drop' (n - len') ts

1146+ where len' = fromIntegral len

1147+ n' = fromIntegral n

1148+#else

1149+ drop' n (Chunk t@(T.Text jst) ts)

1150+ | n < len' = chunk (T.Text $ js_substr1 n' jst) ts

1127−-- | otherwise = drop' (n - len') ts

1151+ | otherwise = drop' (n - len') ts

1128−-- where len' = fromIntegral len

1152+ where len' = fromIntegral len

1153+ len = T.length t

1129−-- n' = fromIntegral n

1154+ n' = fromIntegral n

1155+#endif

1130

1156

1131-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',

1157-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',

1132-- returns the longest prefix (possibly empty) of elements that

1158-- returns the longest prefix (possibly empty) of elements that

@@ -1247,13 +1273,22 @@ splitAt = loop

1247-- values, and whose second is the remainder of the string.

1273-- values, and whose second is the remainder of the string.

1248splitAtWord :: Int64 -> Text -> PairS Text Text

1274splitAtWord :: Int64 -> Text -> PairS Text Text

1249splitAtWord _ Empty = empty :*: empty

1275splitAtWord _ Empty = empty :*: empty

1250−splitAtWord _ _ = P.undefined

1276+#ifndef __GHCJS__

1251−-- splitAtWord x (Chunk c@(T.Text arr off len) cs)

1277+splitAtWord x (Chunk c@(T.Text arr off len) cs)

1252−-- | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

1278+ | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

1253−-- in Chunk c h :*: t

1279+ in Chunk c h :*: t

1254−-- | otherwise = chunk (text arr off y) empty :*:

1280+ | otherwise = chunk (text arr off y) empty :*:

1255−-- chunk (text arr (off+y) (len-y)) cs

1281+ chunk (text arr (off+y) (len-y)) cs

1256−-- where y = fromIntegral x

1282+ where y = fromIntegral x

1283+#else

1284+splitAtWord x (Chunk c@(T.Text jst) cs)

1285+ | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

1286+ in Chunk c h :*: t

1287+ | otherwise = chunk (T.Text (js_substr 0 (y-1) jst)) empty :*:

1288+ chunk (T.Text (js_substr1 y jst)) cs

1289+ where y = fromIntegral x

1290+ len = T.length c

1291+#endif

1257

1292

1258-- | /O(n+m)/ Find the first instance of @needle@ (which must be

1293-- | /O(n+m)/ Find the first instance of @needle@ (which must be

1259-- non-'null') in @haystack@. The first element of the returned tuple

1294-- non-'null') in @haystack@. The first element of the returned tuple

@@ -1425,16 +1460,19 @@ splitOn :: Text

1425 -> Text

1460 -> Text

1426 -- ^ Input text.

1461 -- ^ Input text.

1427 -> [Text]

1462 -> [Text]

1428−splitOn = P.undefined

1463+splitOn pat src

1429−-- splitOn pat src

1430−-- | null pat = emptyError "splitOn"

1464+ | null pat = emptyError "splitOn"

1431−-- | isSingleton pat = split (== head pat) src

1465+ | isSingleton pat = split (== head pat) src

1432−-- | otherwise = go 0 (indices pat src) src

1466+ | otherwise = go 0 (indices pat src) src

1433−-- where

1467+ where

1434−-- go _ [] cs = [cs]

1468+ go _ [] cs = [cs]

1435−-- go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs

1469+ go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs

1436−-- in h : go (x+l) xs (dropWords l t)

1470+ in h : go (x+l) xs (dropWords l t)

1471+#ifndef __GHCJS__

1437−-- l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat

1472+ l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat

1473+#else

1474+ l = foldlChunks (\a t -> a + fromIntegral (T.length t)) 0 pat

1475+#endif

1438{-# INLINE [1] splitOn #-}

1476{-# INLINE [1] splitOn #-}

1439

1477

1440{-# RULES

1478{-# RULES

@@ -1699,3 +1737,8 @@ emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")

1699

1737

1700impossibleError :: String -> a

1738impossibleError :: String -> a

1701impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")

1739impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")

1740+

1741+#ifdef __GHCJS__

1742+foreign import javascript unsafe "$2.substr($1)" js_substr1 :: Exts.Int -> JSString -> JSString

1743+foreign import javascript unsafe "$3.substr($1,$2)" js_substr :: Exts.Int -> Exts.Int -> JSString -> JSString

1744+#endif