Skip to content

Commit 9f5335d

Browse files
BodigrimLysxia
Bodigrim
authored and
Lysxia
committed
Change arity and remove {-# INLINE #-} for scanl, scanr, mapAccumL, mapAccumR
It's unlikely that anyone has any application for these functions, let alone a performance-critical application, so let's reduce code bloat and make implementation a tiny bit more straightforward.
1 parent 01614eb commit 9f5335d

File tree

1 file changed

+92
-104
lines changed

1 file changed

+92
-104
lines changed

‎src/Data/Text.hs‎

Lines changed: 92 additions & 104 deletions
Original file line numberDiff line numberDiff line change
@@ -1210,33 +1210,30 @@ minimum = foldl1' min
12101210
--
12111211
-- @'last' ('scanl' f z xs) = 'foldl' f z xs@
12121212
scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
1213-
scanl f c0 = go
1213+
scanl f c0 (Text src o l) = runST $ do
1214+
let l' = l + 4
1215+
c0' = safe c0
1216+
marr <- A.new l'
1217+
d' <- unsafeWrite marr 0 c0'
1218+
outer marr l' o d' c0'
12141219
where
1215-
go (Text src o l) = runST $ do
1216-
let l' = l + 4
1217-
c0' = safe c0
1218-
marr <- A.new l'
1219-
d' <- unsafeWrite marr 0 c0'
1220-
outer marr l' o d' c0'
1220+
outer :: forall s. A.MArray s -> Int -> Int -> Int -> Char -> ST s Text
1221+
outer !dst !dstLen = inner
12211222
where
1222-
outer :: forall s. A.MArray s -> Int -> Int -> Int -> Char -> ST s Text
1223-
outer !dst !dstLen = inner
1224-
where
1225-
inner !srcOff !dstOff !c
1226-
| srcOff >= l + o = do
1227-
A.shrinkM dst dstOff
1228-
arr <- A.unsafeFreeze dst
1229-
pure $ Text arr 0 dstOff
1230-
| dstOff + 4 > dstLen = do
1231-
let !dstLen' = dstLen + (l + o) - srcOff + 4
1232-
dst' <- A.resizeM dst dstLen'
1233-
outer dst' dstLen' srcOff dstOff c
1234-
| otherwise = do
1235-
let !(Iter c' d) = iterArray src srcOff
1236-
c'' = safe $ f c c'
1237-
d' <- unsafeWrite dst dstOff c''
1238-
inner (srcOff + d) (dstOff + d') c''
1239-
{-# INLINE scanl #-}
1223+
inner !srcOff !dstOff !c
1224+
| srcOff >= l + o = do
1225+
A.shrinkM dst dstOff
1226+
arr <- A.unsafeFreeze dst
1227+
pure $ Text arr 0 dstOff
1228+
| dstOff + 4 > dstLen = do
1229+
let !dstLen' = dstLen + (l + o) - srcOff + 4
1230+
dst' <- A.resizeM dst dstLen'
1231+
outer dst' dstLen' srcOff dstOff c
1232+
| otherwise = do
1233+
let !(Iter c' d) = iterArray src srcOff
1234+
c'' = safe $ f c c'
1235+
d' <- unsafeWrite dst dstOff c''
1236+
inner (srcOff + d) (dstOff + d') c''
12401237

12411238
-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
12421239
-- value argument. Performs replacement on invalid scalar values.
@@ -1252,38 +1249,35 @@ scanl1 f t | null t = empty
12521249
--
12531250
-- > scanr f v == reverse . scanl (flip f) v . reverse
12541251
scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
1255-
scanr f c0 = go
1252+
scanr f c0 (Text src o l) = runST $ do
1253+
let l' = l + 4
1254+
c0' = safe c0
1255+
!d' = utf8Length c0'
1256+
marr <- A.new l'
1257+
_ <- unsafeWrite marr (l' - d') c0'
1258+
outer marr (l + o - 1) (l' - d' - 1) c0'
12561259
where
1257-
go (Text src o l) = runST $ do
1258-
let l' = l + 4
1259-
c0' = safe c0
1260-
!d' = utf8Length c0'
1261-
marr <- A.new l'
1262-
_ <- unsafeWrite marr (l' - d') c0'
1263-
outer marr (l + o - 1) (l' - d' - 1) c0'
1260+
outer :: forall s. A.MArray s -> Int -> Int -> Char -> ST s Text
1261+
outer !dst = inner
12641262
where
1265-
outer :: forall s. A.MArray s -> Int -> Int -> Char -> ST s Text
1266-
outer !dst = inner
1267-
where
1268-
inner !srcOff !dstOff !c
1269-
| srcOff < o = do
1270-
dstLen <- A.getSizeofMArray dst
1271-
arr <- A.unsafeFreeze dst
1272-
pure $ Text arr (dstOff + 1) (dstLen - dstOff - 1)
1273-
| dstOff < 3 = do
1274-
dstLen <- A.getSizeofMArray dst
1275-
let !dstLen' = dstLen + (srcOff - o) + 4
1276-
dst' <- A.new dstLen'
1277-
A.copyM dst' (dstLen' - dstLen) dst 0 dstLen
1278-
outer dst' srcOff (dstOff + dstLen' - dstLen) c
1279-
| otherwise = do
1280-
let !(Iter c' d) = reverseIterArray src srcOff
1281-
c'' = safe $ f c' c
1282-
!d' = utf8Length c''
1283-
dstOff' = dstOff - d'
1284-
_ <- unsafeWrite dst (dstOff' + 1) c''
1285-
inner (srcOff + d) dstOff' c''
1286-
{-# INLINE scanr #-}
1263+
inner !srcOff !dstOff !c
1264+
| srcOff < o = do
1265+
dstLen <- A.getSizeofMArray dst
1266+
arr <- A.unsafeFreeze dst
1267+
pure $ Text arr (dstOff + 1) (dstLen - dstOff - 1)
1268+
| dstOff < 3 = do
1269+
dstLen <- A.getSizeofMArray dst
1270+
let !dstLen' = dstLen + (srcOff - o) + 4
1271+
dst' <- A.new dstLen'
1272+
A.copyM dst' (dstLen' - dstLen) dst 0 dstLen
1273+
outer dst' srcOff (dstOff + dstLen' - dstLen) c
1274+
| otherwise = do
1275+
let !(Iter c' d) = reverseIterArray src srcOff
1276+
c'' = safe $ f c' c
1277+
!d' = utf8Length c''
1278+
dstOff' = dstOff - d'
1279+
_ <- unsafeWrite dst (dstOff' + 1) c''
1280+
inner (srcOff + d) dstOff' c''
12871281

12881282
-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
12891283
-- value argument. Performs replacement on invalid scalar values.
@@ -1297,30 +1291,27 @@ scanr1 f t | null t = empty
12971291
-- parameter from left to right, and returns a final 'Text'. Performs
12981292
-- replacement on invalid scalar values.
12991293
mapAccumL :: forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
1300-
mapAccumL f z0 = go
1294+
mapAccumL f z0 (Text src o l) = runST $ do
1295+
marr <- A.new (l + 4)
1296+
outer marr (l + 4) o 0 z0
13011297
where
1302-
go (Text src o l) = runST $ do
1303-
marr <- A.new (l + 4)
1304-
outer marr (l + 4) o 0 z0
1298+
outer :: forall s. A.MArray s -> Int -> Int -> Int -> a -> ST s (a, Text)
1299+
outer !dst !dstLen = inner
13051300
where
1306-
outer :: forall s. A.MArray s -> Int -> Int -> Int -> a -> ST s (a, Text)
1307-
outer !dst !dstLen = inner
1308-
where
1309-
inner !srcOff !dstOff !z
1310-
| srcOff >= l + o = do
1311-
A.shrinkM dst dstOff
1312-
arr <- A.unsafeFreeze dst
1313-
return (z, Text arr 0 dstOff)
1314-
| dstOff + 4 > dstLen = do
1315-
let !dstLen' = dstLen + (l + o) - srcOff + 4
1316-
dst' <- A.resizeM dst dstLen'
1317-
outer dst' dstLen' srcOff dstOff z
1318-
| otherwise = do
1319-
let !(Iter c d) = iterArray src srcOff
1320-
(z', c') = f z c
1321-
d' <- unsafeWrite dst dstOff (safe c')
1322-
inner (srcOff + d) (dstOff + d') z'
1323-
{-# INLINE mapAccumL #-}
1301+
inner !srcOff !dstOff !z
1302+
| srcOff >= l + o = do
1303+
A.shrinkM dst dstOff
1304+
arr <- A.unsafeFreeze dst
1305+
return (z, Text arr 0 dstOff)
1306+
| dstOff + 4 > dstLen = do
1307+
let !dstLen' = dstLen + (l + o) - srcOff + 4
1308+
dst' <- A.resizeM dst dstLen'
1309+
outer dst' dstLen' srcOff dstOff z
1310+
| otherwise = do
1311+
let !(Iter c d) = iterArray src srcOff
1312+
(z', c') = f z c
1313+
d' <- unsafeWrite dst dstOff (safe c')
1314+
inner (srcOff + d) (dstOff + d') z'
13241315

13251316
-- | The 'mapAccumR' function behaves like a combination of 'map' and
13261317
-- a strict 'foldr'; it applies a function to each element of a
@@ -1329,35 +1320,32 @@ mapAccumL f z0 = go
13291320
-- 'Text'.
13301321
-- Performs replacement on invalid scalar values.
13311322
mapAccumR :: forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
1332-
mapAccumR f z0 = go
1323+
mapAccumR f z0 (Text src o l) = runST $ do
1324+
marr <- A.new (l + 4)
1325+
outer marr (l + o - 1) (l + 4 - 1) z0
13331326
where
1334-
go (Text src o l) = runST $ do
1335-
marr <- A.new (l + 4)
1336-
outer marr (l + o - 1) (l + 4 - 1) z0
1327+
outer :: forall s. A.MArray s -> Int -> Int -> a -> ST s (a, Text)
1328+
outer !dst = inner
13371329
where
1338-
outer :: forall s. A.MArray s -> Int -> Int -> a -> ST s (a, Text)
1339-
outer !dst = inner
1340-
where
1341-
inner !srcOff !dstOff !z
1342-
| srcOff < o = do
1343-
dstLen <- A.getSizeofMArray dst
1344-
arr <- A.unsafeFreeze dst
1345-
return (z, Text arr (dstOff + 1) (dstLen - dstOff - 1))
1346-
| dstOff < 3 = do
1347-
dstLen <- A.getSizeofMArray dst
1348-
let !dstLen' = dstLen + (srcOff - o) + 4
1349-
dst' <- A.new dstLen'
1350-
A.copyM dst' (dstLen' - dstLen) dst 0 dstLen
1351-
outer dst' srcOff (dstOff + dstLen' - dstLen) z
1352-
| otherwise = do
1353-
let !(Iter c d) = reverseIterArray src (srcOff)
1354-
(z', c') = f z c
1355-
c'' = safe c'
1356-
!d' = utf8Length c''
1357-
dstOff' = dstOff - d'
1358-
_ <- unsafeWrite dst (dstOff' + 1) c''
1359-
inner (srcOff + d) dstOff' z'
1360-
{-# INLINE mapAccumR #-}
1330+
inner !srcOff !dstOff !z
1331+
| srcOff < o = do
1332+
dstLen <- A.getSizeofMArray dst
1333+
arr <- A.unsafeFreeze dst
1334+
return (z, Text arr (dstOff + 1) (dstLen - dstOff - 1))
1335+
| dstOff < 3 = do
1336+
dstLen <- A.getSizeofMArray dst
1337+
let !dstLen' = dstLen + (srcOff - o) + 4
1338+
dst' <- A.new dstLen'
1339+
A.copyM dst' (dstLen' - dstLen) dst 0 dstLen
1340+
outer dst' srcOff (dstOff + dstLen' - dstLen) z
1341+
| otherwise = do
1342+
let !(Iter c d) = reverseIterArray src srcOff
1343+
(z', c') = f z c
1344+
c'' = safe c'
1345+
!d' = utf8Length c''
1346+
dstOff' = dstOff - d'
1347+
_ <- unsafeWrite dst (dstOff' + 1) c''
1348+
inner (srcOff + d) dstOff' z'
13611349

13621350
-- -----------------------------------------------------------------------------
13631351
-- ** Generating and unfolding 'Text's

0 commit comments

Comments
 (0)