59ad741 · text · git.iko.soy

git.iko.soy/text

on master help sign in

Refactor common fusion code into one module

59ad741Bryan O'Sullivan18 years ago

Data/Text.hs+1−1

compare with master

unifiedsplit

@@ -158,7 +158,7 @@ import Data.Word (Word16)

158import Data.String (IsString(..))

159

160import qualified Data.Text.Fusion as S

161−import qualified Data.Text.Fusion.Internal as S

161+import qualified Data.Text.Fusion.Common as S

162import Data.Text.Fusion (stream, reverseStream, unstream)

163

164import Data.Text.Internal (Text(..), empty, text, textP)

Data/Text/Fusion.hs+7−647

@@ -22,77 +22,22 @@ module Data.Text.Fusion

23 -- * Creation and elimination

24 , stream

25− , streamList

26 , unstream

25 , unstream

27− , unstreamList

28 , reverseStream

26 , reverseStream

29− , empty

31− -- * Basic interface

32− , cons

33− , snoc

34− , append

35− , uncons

36− , head

37− , tail

38− , last

39− , init

40− , null

41 , length

28 , length

42− , length64

44 -- * Transformations

30 -- * Transformations

45− , map

46− , intercalate

47− , intersperse

48 , reverse

31 , reverse

50− -- * Folds

51− , foldl

52− , foldl'

53− , foldl1

54− , foldl1'

55− , foldr

56− , foldr1

57−

58− -- ** Special folds

59− , concat

60− , concatMap

61− , any

62− , all

63− , maximum

64− , minimum

65−

66 -- * Construction

33 -- * Construction

67 -- ** Scans

34 -- ** Scans

68− , scanl

69 , reverseScanr

35 , reverseScanr

71− -- ** Accumulating maps

72− , mapAccumL

73−

74 -- ** Generation and unfolding

37 -- ** Generation and unfolding

75− , replicate

76− , unfoldr

77 , unfoldrN

38 , unfoldrN

78− , unfoldrN64

79−

80− -- * Substrings

81− -- ** Breaking strings

82− , take

83− , drop

84− , takeWhile

85− , dropWhile

86−

87− -- * Predicates

88− , isPrefixOf

89−

90− -- * Searching

91− , elem

92− , filter

94 -- * Indexing

40 -- * Indexing

95− , find

96 , index

41 , index

97 , findIndex

42 , findIndex

98 , findIndices

43 , findIndices

@@ -100,22 +45,17 @@ module Data.Text.Fusion

100 , elemIndex

45 , elemIndex

101 , elemIndices

46 , elemIndices

102 , count

47 , count

103−

104− -- * Zipping and unzipping

105− , zipWith

106 ) where

48 ) where

107

108−import Prelude (Bool(..), Char, Either(..), Eq(..), Integral, Maybe(..),

50+import Prelude (Bool(..), Char, Eq(..), Maybe(..), Monad(..), Int,

109− Monad(..), Num(..), Ord(..), String, ($), (++), (.), (&&),

51+ Num(..), Ord(..), String, ($), (++), (&&),

110 fromIntegral, otherwise)

52 fromIntegral, otherwise)

111−import qualified Data.List as L

112−import GHC.Exts (Int(..), (+#))

113import Data.Bits ((.&.), shiftR)

53import Data.Bits ((.&.), shiftR)

114import Data.Char (ord)

54import Data.Char (ord)

115−import Data.Int (Int64)

116import Data.Text.Internal (Text(..))

55import Data.Text.Internal (Text(..))

117import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)

56import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)

118import qualified Data.Text.Array as A

57import qualified Data.Text.Array as A

58+import qualified Data.Text.Fusion.Common as S

119import Data.Text.Fusion.Internal

59import Data.Text.Fusion.Internal

120import qualified Data.Text.Internal as I

60import qualified Data.Text.Internal as I

121import qualified Data.Text.Encoding.Utf16 as U16

61import qualified Data.Text.Encoding.Utf16 as U16

@@ -173,198 +113,14 @@ unstream (Stream next0 s0 len)

173{-# INLINE [0] unstream #-}

113{-# INLINE [0] unstream #-}

174{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

114{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

175

115

176−streamError :: String -> String -> a

177−streamError func msg = P.error $ "Data.Text.Fusion." ++ func ++ ": " ++ msg

178−

179−internalError :: String -> a

180−internalError func = streamError func "Internal error"

181−

182−emptyError :: String -> a

183−emptyError func = internalError func "Empty input"

184

116

185-- ----------------------------------------------------------------------------

117-- ----------------------------------------------------------------------------

186-- * Basic stream functions

118-- * Basic stream functions

187

119

188−-- | /O(n)/ Adds a character to the front of a Stream Char.

189−cons :: Char -> Stream Char -> Stream Char

190−cons w (Stream next0 s0 len) = Stream next (S2 :!: s0) (len+2)

191− where

192− {-# INLINE next #-}

193− next (S2 :!: s) = Yield w (S1 :!: s)

194− next (S1 :!: s) = case next0 s of

195− Done -> Done

196− Skip s' -> Skip (S1 :!: s')

197− Yield x s' -> Yield x (S1 :!: s')

198−{-# INLINE [0] cons #-}

199−

200−-- | /O(n)/ Adds a character to the end of a stream.

201−snoc :: Stream Char -> Char -> Stream Char

202−snoc (Stream next0 xs0 len) w = Stream next (Just xs0) (len+2)

203− where

204− {-# INLINE next #-}

205− next (Just xs) = case next0 xs of

206− Done -> Yield w Nothing

207− Skip xs' -> Skip (Just xs')

208− Yield x xs' -> Yield x (Just xs')

209− next Nothing = Done

210−{-# INLINE [0] snoc #-}

211−

212−-- | /O(n)/ Appends one Stream to the other.

213−append :: Stream Char -> Stream Char -> Stream Char

214−append (Stream next0 s01 len1) (Stream next1 s02 len2) =

215− Stream next (Left s01) (len1 + len2)

216− where

217− {-# INLINE next #-}

218− next (Left s1) = case next0 s1 of

219− Done -> Skip (Right s02)

220− Skip s1' -> Skip (Left s1')

221− Yield x s1' -> Yield x (Left s1')

222− next (Right s2) = case next1 s2 of

223− Done -> Done

224− Skip s2' -> Skip (Right s2')

225− Yield x s2' -> Yield x (Right s2')

226−{-# INLINE [0] append #-}

227−

228−-- | /O(1)/ Returns the first character of a Text, which must be non-empty.

229−-- Subject to array fusion.

230−head :: Stream Char -> Char

231−head (Stream next s0 _len) = loop_head s0

232− where

233− loop_head !s = case next s of

234− Yield x _ -> x

235− Skip s' -> loop_head s'

236− Done -> streamError "head" "Empty stream"

237−{-# INLINE [0] head #-}

238−

239−-- | /O(1)/ Returns the first character and remainder of a 'Stream

240−-- Char', or 'Nothing' if empty. Subject to array fusion.

241−uncons :: Stream Char -> Maybe (Char, Stream Char)

242−uncons (Stream next s0 len) = loop_uncons s0

243− where

244− loop_uncons !s = case next s of

245− Yield x s1 -> Just (x, Stream next s1 (len-1))

246− Skip s' -> loop_uncons s'

247− Done -> Nothing

248−{-# INLINE [0] uncons #-}

249−

250−-- | /O(n)/ Returns the last character of a 'Stream Char', which must

251−-- be non-empty.

252−last :: Stream Char -> Char

253−last (Stream next s0 _len) = loop0_last s0

254− where

255− loop0_last !s = case next s of

256− Done -> emptyError "last"

257− Skip s' -> loop0_last s'

258− Yield x s' -> loop_last x s'

259− loop_last !x !s = case next s of

260− Done -> x

261− Skip s' -> loop_last x s'

262− Yield x' s' -> loop_last x' s'

263−{-# INLINE[0] last #-}

264−

265−-- | /O(1)/ Returns all characters after the head of a Stream Char, which must

266−-- be non-empty.

267−tail :: Stream Char -> Stream Char

268−tail (Stream next0 s0 len) = Stream next (False :!: s0) (len-1)

269− where

270− {-# INLINE next #-}

271− next (False :!: s) = case next0 s of

272− Done -> emptyError "tail"

273− Skip s' -> Skip (False :!: s')

274− Yield _ s' -> Skip (True :!: s')

275− next (True :!: s) = case next0 s of

276− Done -> Done

277− Skip s' -> Skip (True :!: s')

278− Yield x s' -> Yield x (True :!: s')

279−{-# INLINE [0] tail #-}

280−

281−

282−-- | /O(1)/ Returns all but the last character of a Stream Char, which

283−-- must be non-empty.

284−init :: Stream Char -> Stream Char

285−init (Stream next0 s0 len) = Stream next (Nothing :!: s0) (len-1)

286− where

287− {-# INLINE next #-}

288− next (Nothing :!: s) = case next0 s of

289− Done -> emptyError "init"

290− Skip s' -> Skip (Nothing :!: s')

291− Yield x s' -> Skip (Just x :!: s')

292− next (Just x :!: s) = case next0 s of

293− Done -> Done

294− Skip s' -> Skip (Just x :!: s')

295− Yield x' s' -> Yield x (Just x' :!: s')

296−{-# INLINE [0] init #-}

297−

298−-- | /O(1)/ Tests whether a Stream Char is empty or not.

299−null :: Stream Char -> Bool

300−null (Stream next s0 _len) = loop_null s0

301− where

302− loop_null !s = case next s of

303− Done -> True

304− Yield _ _ -> False

305− Skip s' -> loop_null s'

306−{-# INLINE[0] null #-}

307−

308−-- | /O(n)/ Returns the number of characters in a text.

309length :: Stream Char -> Int

120length :: Stream Char -> Int

310−length (Stream next s0 _len) = loop_length 0# s0

121+length = S.lengthI

311− where

312−

313− loop_length z# s = case next s of

314− Done -> (I# z#)

315− Skip s' -> loop_length z# s'

316− Yield _ s' -> loop_length (z# +# 1#) s'

317{-# INLINE[0] length #-}

122{-# INLINE[0] length #-}

318

123

319−-- | /O(n)/ Returns the number of characters in a text.

320−length64 :: Stream Char -> Int64

321−length64 (Stream next s0 _len) = loop_length 0 s0

322− where

323− loop_length z s = case next s of

324− Done -> z

325− Skip s' -> loop_length z s'

326− Yield _ s' -> let !z' = z + 1

327− in loop_length z' s'

328−{-# INLINE[0] length64 #-}

329−

330−-- ----------------------------------------------------------------------------

331−-- * Stream transformations

332−

333−-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@ to each element of

334−-- @xs@.

335−map :: (Char -> Char) -> Stream Char -> Stream Char

336−map f (Stream next0 s0 len) = Stream next s0 len

337− where

338− {-# INLINE next #-}

339− next !s = case next0 s of

340− Done -> Done

341− Skip s' -> Skip s'

342− Yield x s' -> Yield (f x) s'

343−{-# INLINE [0] map #-}

344−

345−{-#

346− RULES "STREAM map/map fusion" forall f g s.

347− map f (map g s) = map (\x -> f (g x)) s

348− #-}

349−

350−-- | /O(n)/ Take a character and place it between each of the

351−-- characters of a 'Stream Char'.

352−intersperse :: Char -> Stream Char -> Stream Char

353−intersperse c (Stream next0 s0 len) = Stream next (s0 :!: Nothing :!: S1) len

354− where

355− {-# INLINE next #-}

356− next (s :!: Nothing :!: S1) = case next0 s of

357− Done -> Done

358− Skip s' -> Skip (s' :!: Nothing :!: S1)

359− Yield x s' -> Skip (s' :!: Just x :!: S1)

360− next (s :!: Just x :!: S1) = Yield x (s :!: Nothing :!: S2)

361− next (s :!: Nothing :!: S2) = case next0 s of

362− Done -> Done

363− Skip s' -> Skip (s' :!: Nothing :!: S2)

364− Yield x s' -> Yield c (s' :!: Just x :!: S1)

365− next _ = internalError "intersperse"

366−{-# INLINE [0] intersperse #-}

367−

368-- | /O(n)/ Reverse the characters of a string.

124-- | /O(n)/ Reverse the characters of a string.

369reverse :: Stream Char -> Text

125reverse :: Stream Char -> Text

370reverse (Stream next s len0)

126reverse (Stream next s len0)

@@ -400,181 +156,6 @@ reverse (Stream next s len0)

400 loop t (j-2) l mar

156 loop t (j-2) l mar

401{-# INLINE [0] reverse #-}

157{-# INLINE [0] reverse #-}

402

158

403−-- ----------------------------------------------------------------------------

404−-- * Reducing Streams (folds)

405−

406−-- | foldl, applied to a binary operator, a starting value (typically the

407−-- left-identity of the operator), and a Stream, reduces the Stream using the

408−-- binary operator, from left to right.

409−foldl :: (b -> Char -> b) -> b -> Stream Char -> b

410−foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0

411− where

412− loop_foldl z !s = case next s of

413− Done -> z

414− Skip s' -> loop_foldl z s'

415− Yield x s' -> loop_foldl (f z x) s'

416−{-# INLINE [0] foldl #-}

417−

418−-- | A strict version of foldl.

419−foldl' :: (b -> Char -> b) -> b -> Stream Char -> b

420−foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0

421− where

422− loop_foldl' !z !s = case next s of

423− Done -> z

424− Skip s' -> loop_foldl' z s'

425− Yield x s' -> loop_foldl' (f z x) s'

426−{-# INLINE [0] foldl' #-}

427−

428−-- | foldl1 is a variant of foldl that has no starting value argument,

429−-- and thus must be applied to non-empty Streams.

430−foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char

431−foldl1 f (Stream next s0 _len) = loop0_foldl1 s0

432− where

433− loop0_foldl1 !s = case next s of

434− Skip s' -> loop0_foldl1 s'

435− Yield x s' -> loop_foldl1 x s'

436− Done -> emptyError "foldl1"

437− loop_foldl1 z !s = case next s of

438− Done -> z

439− Skip s' -> loop_foldl1 z s'

440− Yield x s' -> loop_foldl1 (f z x) s'

441−{-# INLINE [0] foldl1 #-}

442−

443−-- | A strict version of foldl1.

444−foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char

445−foldl1' f (Stream next s0 _len) = loop0_foldl1' s0

446− where

447− loop0_foldl1' !s = case next s of

448− Skip s' -> loop0_foldl1' s'

449− Yield x s' -> loop_foldl1' x s'

450− Done -> emptyError "foldl1"

451− loop_foldl1' !z !s = case next s of

452− Done -> z

453− Skip s' -> loop_foldl1' z s'

454− Yield x s' -> loop_foldl1' (f z x) s'

455−{-# INLINE [0] foldl1' #-}

456−

457−-- | 'foldr', applied to a binary operator, a starting value (typically the

458−-- right-identity of the operator), and a stream, reduces the stream using the

459−-- binary operator, from right to left.

460−foldr :: (Char -> b -> b) -> b -> Stream Char -> b

461−foldr f z (Stream next s0 _len) = loop_foldr s0

462− where

463− loop_foldr !s = case next s of

464− Done -> z

465− Skip s' -> loop_foldr s'

466− Yield x s' -> f x (loop_foldr s')

467−{-# INLINE [0] foldr #-}

468−

469−-- | foldr1 is a variant of 'foldr' that has no starting value argument,

470−-- and thus must be applied to non-empty streams.

471−-- Subject to array fusion.

472−foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char

473−foldr1 f (Stream next s0 _len) = loop0_foldr1 s0

474− where

475− loop0_foldr1 !s = case next s of

476− Done -> emptyError "foldr1"

477− Skip s' -> loop0_foldr1 s'

478− Yield x s' -> loop_foldr1 x s'

479−

480− loop_foldr1 x !s = case next s of

481− Done -> x

482− Skip s' -> loop_foldr1 x s'

483− Yield x' s' -> f x (loop_foldr1 x' s')

484−{-# INLINE [0] foldr1 #-}

485−

486−intercalate :: Stream Char -> [Stream Char] -> Stream Char

487−intercalate s = concat . (L.intersperse s)

488−{-# INLINE [0] intercalate #-}

489−

490−-- ----------------------------------------------------------------------------

491−-- ** Special folds

492−

493−-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.

494−concat :: [Stream Char] -> Stream Char

495−concat = L.foldr append (Stream next Done 0)

496− where

497− next Done = Done

498− next _ = internalError "concat"

499−

500−-- | Map a function over a stream that results in a stream and concatenate the

501−-- results.

502−concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char

503−concatMap f = foldr (append . f) empty

504−

505−-- | /O(n)/ any @p @xs determines if any character in the stream

506−-- @xs@ satisifes the predicate @p@.

507−any :: (Char -> Bool) -> Stream Char -> Bool

508−any p (Stream next0 s0 _len) = loop_any s0

509− where

510− loop_any !s = case next0 s of

511− Done -> False

512− Skip s' -> loop_any s'

513− Yield x s' | p x -> True

514− | otherwise -> loop_any s'

515−{-# INLINE [0] any #-}

516−

517−-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

518−-- @xs@ satisify the predicate @p@.

519−all :: (Char -> Bool) -> Stream Char -> Bool

520−all p (Stream next0 s0 _len) = loop_all s0

521− where

522− loop_all !s = case next0 s of

523− Done -> True

524− Skip s' -> loop_all s'

525− Yield x s' | p x -> loop_all s'

526− | otherwise -> False

527−{-# INLINE [0] all #-}

528−

529−-- | /O(n)/ maximum returns the maximum value from a stream, which must be

530−-- non-empty.

531−maximum :: Stream Char -> Char

532−maximum (Stream next0 s0 _len) = loop0_maximum s0

533− where

534− loop0_maximum !s = case next0 s of

535− Done -> emptyError "maximum"

536− Skip s' -> loop0_maximum s'

537− Yield x s' -> loop_maximum x s'

538− loop_maximum !z !s = case next0 s of

539− Done -> z

540− Skip s' -> loop_maximum z s'

541− Yield x s'

542− | x > z -> loop_maximum x s'

543− | otherwise -> loop_maximum z s'

544−{-# INLINE [0] maximum #-}

545−

546−-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be

547−-- non-empty.

548−minimum :: Stream Char -> Char

549−minimum (Stream next0 s0 _len) = loop0_minimum s0

550− where

551− loop0_minimum !s = case next0 s of

552− Done -> emptyError "minimum"

553− Skip s' -> loop0_minimum s'

554− Yield x s' -> loop_minimum x s'

555− loop_minimum !z !s = case next0 s of

556− Done -> z

557− Skip s' -> loop_minimum z s'

558− Yield x s'

559− | x < z -> loop_minimum x s'

560− | otherwise -> loop_minimum z s'

561−{-# INLINE [0] minimum #-}

562−

563−-- -----------------------------------------------------------------------------

564−-- * Building streams

565−

566−scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

567−scanl f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)

568− where

569− {-# INLINE next #-}

570− next (S1 :!: z :!: s) = Yield z (S2 :!: z :!: s)

571− next (S2 :!: z :!: s) = case next0 s of

572− Yield x s' -> let !x' = f z x

573− in Yield x' (S2 :!: x' :!: s')

574− Skip s' -> Skip (S2 :!: z :!: s')

575− Done -> Done

576−{-# INLINE [0] scanl #-}

577−

578-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with

159-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with

579-- the input and result reversed.

160-- the input and result reversed.

580reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

161reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

@@ -589,218 +170,14 @@ reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)

589 Done -> Done

170 Done -> Done

590{-# INLINE reverseScanr #-}

171{-# INLINE reverseScanr #-}

591

172

592−-- -----------------------------------------------------------------------------

593−-- ** Accumulating maps

594−

595−-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

596−-- function to each element of a stream, passing an accumulating

597−-- parameter from left to right, and returns a final stream.

598−--

599−-- /Note/: Unlike the version over lists, this function does not

600−-- return a final value for the accumulator, because the nature of

601−-- streams precludes it.

602−mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b

603−mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :!: z0) len

604− where

605− {-# INLINE next #-}

606− next (s :!: z) = case next0 s of

607− Yield x s' -> let (z',y) = f z x

608− in Yield y (s' :!: z')

609− Skip s' -> Skip (s' :!: z)

610− Done -> Done

611−{-# INLINE [0] mapAccumL #-}

612−

613−-- -----------------------------------------------------------------------------

614−-- ** Generating and unfolding streams

615−

616−replicate :: Int -> Char -> Stream Char

617−replicate n c

618− | n < 0 = empty

619− | otherwise = Stream next 0 n

620− where

621− {-# INLINE next #-}

622− next i | i >= n = Done

623− | otherwise = Yield c (i + 1)

624−{-# INLINE [0] replicate #-}

625−

626−-- | /O(n)/, where @n@ is the length of the result. The unfoldr function

627−-- is analogous to the List 'unfoldr'. unfoldr builds a stream

628−-- from a seed value. The function takes the element and returns

629−-- Nothing if it is done producing the stream or returns Just

630−-- (a,b), in which case, a is the next Char in the string, and b is

631−-- the seed value for further production.

632−unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char

633−unfoldr f s0 = Stream next s0 1

634− where

635− {-# INLINE next #-}

636− next !s = case f s of

637− Nothing -> Done

638− Just (w, s') -> Yield w s'

639−{-# INLINE [0] unfoldr #-}

640−

641−-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

642−-- value. However, the length of the result is limited by the

643−-- first argument to 'unfoldrN'. This function is more efficient than

644−-- 'unfoldr' when the length of the result is known.

645−unfoldrI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char

646−unfoldrI n f s0 | n < 0 = empty

647− | otherwise = Stream next (0 :!: s0) (fromIntegral (n*2))

648− where

649− {-# INLINE next #-}

650− next (z :!: s) = case f s of

651− Nothing -> Done

652− Just (w, s') | z >= n -> Done

653− | otherwise -> Yield w ((z + 1) :!: s')

654−{-# INLINE unfoldrI #-}

655−

656-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

173-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

657-- value. However, the length of the result is limited by the

174-- value. However, the length of the result is limited by the

658-- first argument to 'unfoldrN'. This function is more efficient than

175-- first argument to 'unfoldrN'. This function is more efficient than

659-- 'unfoldr' when the length of the result is known.

176-- 'unfoldr' when the length of the result is known.

660unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char

177unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char

661−unfoldrN n = unfoldrI (fromIntegral n :: Int)

178+unfoldrN n = S.unfoldrNI (fromIntegral n :: Int)

662{-# INLINE [0] unfoldrN #-}

179{-# INLINE [0] unfoldrN #-}

663

180

664−-- | /O(n)/ Like 'unfoldr', 'unfoldrN64' builds a stream from a seed

665−-- value. However, the length of the result is limited by the

666−-- first argument to 'unfoldrN64'. This function is more efficient than

667−-- 'unfoldr' when the length of the result is known.

668−unfoldrN64 :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char

669−unfoldrN64 n = unfoldrI (fromIntegral n :: Int64)

670−{-# INLINE [0] unfoldrN64 #-}

671−

672−-------------------------------------------------------------------------------

673−-- * Substreams

674−

675−-- | /O(n)/ take n, applied to a stream, returns the prefix of the

676−-- stream of length @n@, or the stream itself if @n@ is greater than the

677−-- length of the stream.

678−take :: Int -> Stream Char -> Stream Char

679−take n0 (Stream next0 s0 len) = Stream next (n0 :!: s0) len

680− where

681− {-# INLINE next #-}

682− next (n :!: s) | n <= 0 = Done

683− | otherwise = case next0 s of

684− Done -> Done

685− Skip s' -> Skip (n :!: s')

686− Yield x s' -> Yield x ((n-1) :!: s')

687−{-# INLINE [0] take #-}

688−

689−-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

690−-- stream of length @n@, or the empty stream if @n@ is greater than the

691−-- length of the stream.

692−drop :: Int -> Stream Char -> Stream Char

693−drop n0 (Stream next0 s0 len) = Stream next (Just ((max 0 n0)) :!: s0) (len - n0)

694− where

695− {-# INLINE next #-}

696− next (Just !n :!: s)

697− | n == 0 = Skip (Nothing :!: s)

698− | otherwise = case next0 s of

699− Done -> Done

700− Skip s' -> Skip (Just n :!: s')

701− Yield _ s' -> Skip (Just (n-1) :!: s')

702− next (Nothing :!: s) = case next0 s of

703− Done -> Done

704− Skip s' -> Skip (Nothing :!: s')

705− Yield x s' -> Yield x (Nothing :!: s')

706−{-# INLINE [0] drop #-}

707−

708−-- | takeWhile, applied to a predicate @p@ and a stream, returns the

709−-- longest prefix (possibly empty) of elements that satisfy p.

710−takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char

711−takeWhile p (Stream next0 s0 len) = Stream next s0 len

712− where

713− {-# INLINE next #-}

714− next !s = case next0 s of

715− Done -> Done

716− Skip s' -> Skip s'

717− Yield x s' | p x -> Yield x s'

718− | otherwise -> Done

719−{-# INLINE [0] takeWhile #-}

720−

721−-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

722−dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

723−dropWhile p (Stream next0 s0 len) = Stream next (S1 :!: s0) len

724− where

725− {-# INLINE next #-}

726− next (S1 :!: s) = case next0 s of

727− Done -> Done

728− Skip s' -> Skip (S1 :!: s')

729− Yield x s' | p x -> Skip (S1 :!: s')

730− | otherwise -> Yield x (S2 :!: s')

731− next (S2 :!: s) = case next0 s of

732− Done -> Done

733− Skip s' -> Skip (S2 :!: s')

734− Yield x s' -> Yield x (S2 :!: s')

735−{-# INLINE [0] dropWhile #-}

736−

737−-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

738−-- 'True' iff the first is a prefix of the second.

739−isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool

740−isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

741− where

742− loop Done _ = True

743− loop _ Done = False

744− loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

745− loop (Skip s1') x2 = loop (next1 s1') x2

746− loop x1 (Skip s2') = loop x1 (next2 s2')

747− loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

748− loop (next1 s1') (next2 s2')

749−{-# INLINE [0] isPrefixOf #-}

750−{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}

751−-- ----------------------------------------------------------------------------

752−-- * Searching

753−

754−-------------------------------------------------------------------------------

755−-- ** Searching by equality

756−

757−-- | /O(n)/ elem is the stream membership predicate.

758−elem :: Char -> Stream Char -> Bool

759−elem w (Stream next s0 _len) = loop_elem s0

760− where

761− loop_elem !s = case next s of

762− Done -> False

763− Skip s' -> loop_elem s'

764− Yield x s' | x == w -> True

765− | otherwise -> loop_elem s'

766−{-# INLINE [0] elem #-}

767−

768−-------------------------------------------------------------------------------

769−-- ** Searching with a predicate

770−

771−-- | /O(n)/ The 'find' function takes a predicate and a stream,

772−-- and returns the first element in matching the predicate, or 'Nothing'

773−-- if there is no such element.

774−

775−find :: (Char -> Bool) -> Stream Char -> Maybe Char

776−find p (Stream next s0 _len) = loop_find s0

777− where

778− loop_find !s = case next s of

779− Done -> Nothing

780− Skip s' -> loop_find s'

781− Yield x s' | p x -> Just x

782− | otherwise -> loop_find s'

783−{-# INLINE [0] find #-}

784−

785−-- | /O(n)/ 'filter', applied to a predicate and a stream,

786−-- returns a stream containing those characters that satisfy the

787−-- predicate.

788−filter :: (Char -> Bool) -> Stream Char -> Stream Char

789−filter p (Stream next0 s0 len) = Stream next s0 len

790− where

791− {-# INLINE next #-}

792− next !s = case next0 s of

793− Done -> Done

794− Skip s' -> Skip s'

795− Yield x s' | p x -> Yield x s'

796− | otherwise -> Skip s'

797−{-# INLINE [0] filter #-}

798−

799−{-# RULES

800− "Stream filter/filter fusion" forall p q s.

801− filter p (filter q s) = filter (\x -> q x && p x) s

802− #-}

803−

804-------------------------------------------------------------------------------

181-------------------------------------------------------------------------------

805-- ** Indexing streams

182-- ** Indexing streams

806

183

@@ -885,22 +262,5 @@ count a (Stream next s0 _len) = loop 0 s0

885 | otherwise -> loop i s'

262 | otherwise -> loop i s'

886{-# INLINE [0] count #-}

263{-# INLINE [0] count #-}

887

264

888−-------------------------------------------------------------------------------

265+streamError :: String -> String -> a

889−-- * Zipping

266+streamError func msg = P.error $ "Data.Text.Fusion." ++ func ++ ": " ++ msg

890−

891−-- | zipWith generalises 'zip' by zipping with the function given as

892−-- the first argument, instead of a tupling function.

893−zipWith :: (Char -> Char -> Char) -> Stream Char -> Stream Char -> Stream Char

894−zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) = Stream next (sa0 :!: sb0 :!: Nothing) (min len1 len2)

895− where

896− {-# INLINE next #-}

897− next (sa :!: sb :!: Nothing) = case next0 sa of

898− Done -> Done

899− Skip sa' -> Skip (sa' :!: sb :!: Nothing)

900− Yield a sa' -> Skip (sa' :!: sb :!: Just a)

901−

902− next (sa' :!: sb :!: Just a) = case next1 sb of

903− Done -> Done

904− Skip sb' -> Skip (sa' :!: sb' :!: Just a)

905− Yield b sb' -> Yield (f a b) (sa' :!: sb' :!: Nothing)

906−{-# INLINE [0] zipWith #-}

Data/Text/Fusion/Common.hsnew file+687

@@ -0,0 +1,687 @@

1+{-# LANGUAGE BangPatterns #-}

2+-- |

3+-- Module : Data.Text.Fusion.Common

4+-- Copyright : (c) Bryan O'Sullivan 2009

5+--

6+-- License : BSD-style

7+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,

8+-- duncan@haskell.org

9+-- Stability : experimental

10+-- Portability : GHC

11+--

12+-- Common stream fusion functionality for text.

13+

14+module Data.Text.Fusion.Common

15+ (

16+ -- * Creation and elimination

17+ singleton

18+ , streamList

19+ , unstreamList

20+

21+ -- * Basic interface

22+ , cons

23+ , snoc

24+ , append

25+ , head

26+ , uncons

27+ , last

28+ , tail

29+ , init

30+ , null

31+ , lengthI

32+

33+ -- * Transformations

34+ , map

35+ , intercalate

36+ , intersperse

37+

38+ -- * Folds

39+ , foldl

40+ , foldl'

41+ , foldl1

42+ , foldl1'

43+ , foldr

44+ , foldr1

45+

46+ -- ** Special folds

47+ , concat

48+ , concatMap

49+ , any

50+ , all

51+ , maximum

52+ , minimum

53+

54+ -- * Construction

55+ -- ** Scans

56+ , scanl

57+

58+ -- ** Accumulating maps

59+ , mapAccumL

60+

61+ -- ** Generation and unfolding

62+ , replicate

63+ , unfoldr

64+ , unfoldrNI

65+

66+ -- * Substrings

67+ -- ** Breaking strings

68+ , take

69+ , drop

70+ , takeWhile

71+ , dropWhile

72+

73+ -- * Predicates

74+ , isPrefixOf

75+

76+ -- * Searching

77+ , elem

78+ , filter

79+

80+ -- * Indexing

81+ , find

82+

83+ -- * Zipping and unzipping

84+ , zipWith

85+ ) where

86+

87+import Prelude (Bool(..), Char, Either(..), Eq(..), Int, Integral, Maybe(..),

88+ Ord(..), String, (.), ($), (+), (-), (*), (++), (&&),

89+ fromIntegral, otherwise)

90+import qualified Data.List as L

91+import qualified Prelude as P

92+import Data.Text.Fusion.Internal

93+

94+singleton :: Char -> Stream Char

95+singleton c = Stream next False 1

96+ where next False = Yield c True

97+ next True = Done

98+{-# INLINE singleton #-}

99+

100+streamList :: [a] -> Stream a

101+{-# INLINE streamList #-}

102+streamList [] = empty

103+streamList s = Stream next s unknownLength

104+ where next [] = Done

105+ next (x:xs) = Yield x xs

106+ unknownLength = 8

107+

108+unstreamList :: Stream a -> [a]

109+{-# INLINE unstreamList #-}

110+unstreamList (Stream next s0 _len) = unfold s0

111+ where unfold !s = case next s of

112+ Done -> []

113+ Skip s' -> unfold s'

114+ Yield x s' -> x : unfold s'

115+

116+-- ----------------------------------------------------------------------------

117+-- * Basic stream functions

118+

119+-- | /O(n)/ Adds a character to the front of a Stream Char.

120+cons :: Char -> Stream Char -> Stream Char

121+cons w (Stream next0 s0 len) = Stream next (S2 :!: s0) (len+2)

122+ where

123+ {-# INLINE next #-}

124+ next (S2 :!: s) = Yield w (S1 :!: s)

125+ next (S1 :!: s) = case next0 s of

126+ Done -> Done

127+ Skip s' -> Skip (S1 :!: s')

128+ Yield x s' -> Yield x (S1 :!: s')

129+{-# INLINE [0] cons #-}

130+

131+-- | /O(n)/ Adds a character to the end of a stream.

132+snoc :: Stream Char -> Char -> Stream Char

133+snoc (Stream next0 xs0 len) w = Stream next (Just xs0) (len+2)

134+ where

135+ {-# INLINE next #-}

136+ next (Just xs) = case next0 xs of

137+ Done -> Yield w Nothing

138+ Skip xs' -> Skip (Just xs')

139+ Yield x xs' -> Yield x (Just xs')

140+ next Nothing = Done

141+{-# INLINE [0] snoc #-}

142+

143+-- | /O(n)/ Appends one Stream to the other.

144+append :: Stream Char -> Stream Char -> Stream Char

145+append (Stream next0 s01 len1) (Stream next1 s02 len2) =

146+ Stream next (Left s01) (len1 + len2)

147+ where

148+ {-# INLINE next #-}

149+ next (Left s1) = case next0 s1 of

150+ Done -> Skip (Right s02)

151+ Skip s1' -> Skip (Left s1')

152+ Yield x s1' -> Yield x (Left s1')

153+ next (Right s2) = case next1 s2 of

154+ Done -> Done

155+ Skip s2' -> Skip (Right s2')

156+ Yield x s2' -> Yield x (Right s2')

157+{-# INLINE [0] append #-}

158+

159+-- | /O(1)/ Returns the first character of a Text, which must be non-empty.

160+-- Subject to array fusion.

161+head :: Stream Char -> Char

162+head (Stream next s0 _len) = loop_head s0

163+ where

164+ loop_head !s = case next s of

165+ Yield x _ -> x

166+ Skip s' -> loop_head s'

167+ Done -> streamError "head" "Empty stream"

168+{-# INLINE [0] head #-}

169+

170+-- | /O(1)/ Returns the first character and remainder of a 'Stream

171+-- Char', or 'Nothing' if empty. Subject to array fusion.

172+uncons :: Stream Char -> Maybe (Char, Stream Char)

173+uncons (Stream next s0 len) = loop_uncons s0

174+ where

175+ loop_uncons !s = case next s of

176+ Yield x s1 -> Just (x, Stream next s1 (len-1))

177+ Skip s' -> loop_uncons s'

178+ Done -> Nothing

179+{-# INLINE [0] uncons #-}

180+

181+-- | /O(n)/ Returns the last character of a 'Stream Char', which must

182+-- be non-empty.

183+last :: Stream Char -> Char

184+last (Stream next s0 _len) = loop0_last s0

185+ where

186+ loop0_last !s = case next s of

187+ Done -> emptyError "last"

188+ Skip s' -> loop0_last s'

189+ Yield x s' -> loop_last x s'

190+ loop_last !x !s = case next s of

191+ Done -> x

192+ Skip s' -> loop_last x s'

193+ Yield x' s' -> loop_last x' s'

194+{-# INLINE[0] last #-}

195+

196+-- | /O(1)/ Returns all characters after the head of a Stream Char, which must

197+-- be non-empty.

198+tail :: Stream Char -> Stream Char

199+tail (Stream next0 s0 len) = Stream next (False :!: s0) (len-1)

200+ where

201+ {-# INLINE next #-}

202+ next (False :!: s) = case next0 s of

203+ Done -> emptyError "tail"

204+ Skip s' -> Skip (False :!: s')

205+ Yield _ s' -> Skip (True :!: s')

206+ next (True :!: s) = case next0 s of

207+ Done -> Done

208+ Skip s' -> Skip (True :!: s')

209+ Yield x s' -> Yield x (True :!: s')

210+{-# INLINE [0] tail #-}

211+

212+

213+-- | /O(1)/ Returns all but the last character of a Stream Char, which

214+-- must be non-empty.

215+init :: Stream Char -> Stream Char

216+init (Stream next0 s0 len) = Stream next (Nothing :!: s0) (len-1)

217+ where

218+ {-# INLINE next #-}

219+ next (Nothing :!: s) = case next0 s of

220+ Done -> emptyError "init"

221+ Skip s' -> Skip (Nothing :!: s')

222+ Yield x s' -> Skip (Just x :!: s')

223+ next (Just x :!: s) = case next0 s of

224+ Done -> Done

225+ Skip s' -> Skip (Just x :!: s')

226+ Yield x' s' -> Yield x (Just x' :!: s')

227+{-# INLINE [0] init #-}

228+

229+-- | /O(1)/ Tests whether a Stream Char is empty or not.

230+null :: Stream Char -> Bool

231+null (Stream next s0 _len) = loop_null s0

232+ where

233+ loop_null !s = case next s of

234+ Done -> True

235+ Yield _ _ -> False

236+ Skip s' -> loop_null s'

237+{-# INLINE[0] null #-}

238+

239+-- | /O(n)/ Returns the number of characters in a text.

240+lengthI :: Integral a => Stream Char -> a

241+lengthI (Stream next s0 _len) = loop_length 0 s0

242+ where

243+ loop_length z s = case next s of

244+ Done -> z

245+ Skip s' -> loop_length z s'

246+ Yield _ s' -> let !z' = z + 1

247+ in loop_length z' s'

248+{-# INLINE[0] lengthI #-}

249+

250+-- ----------------------------------------------------------------------------

251+-- * Stream transformations

252+

253+-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@ to each element of

254+-- @xs@.

255+map :: (Char -> Char) -> Stream Char -> Stream Char

256+map f (Stream next0 s0 len) = Stream next s0 len

257+ where

258+ {-# INLINE next #-}

259+ next !s = case next0 s of

260+ Done -> Done

261+ Skip s' -> Skip s'

262+ Yield x s' -> Yield (f x) s'

263+{-# INLINE [0] map #-}

264+

265+{-#

266+ RULES "STREAM map/map fusion" forall f g s.

267+ map f (map g s) = map (\x -> f (g x)) s

268+ #-}

269+

270+-- | /O(n)/ Take a character and place it between each of the

271+-- characters of a 'Stream Char'.

272+intersperse :: Char -> Stream Char -> Stream Char

273+intersperse c (Stream next0 s0 len) = Stream next (s0 :!: Nothing :!: S1) len

274+ where

275+ {-# INLINE next #-}

276+ next (s :!: Nothing :!: S1) = case next0 s of

277+ Done -> Done

278+ Skip s' -> Skip (s' :!: Nothing :!: S1)

279+ Yield x s' -> Skip (s' :!: Just x :!: S1)

280+ next (s :!: Just x :!: S1) = Yield x (s :!: Nothing :!: S2)

281+ next (s :!: Nothing :!: S2) = case next0 s of

282+ Done -> Done

283+ Skip s' -> Skip (s' :!: Nothing :!: S2)

284+ Yield x s' -> Yield c (s' :!: Just x :!: S1)

285+ next _ = internalError "intersperse"

286+{-# INLINE [0] intersperse #-}

287+

288+-- ----------------------------------------------------------------------------

289+-- * Reducing Streams (folds)

290+

291+-- | foldl, applied to a binary operator, a starting value (typically the

292+-- left-identity of the operator), and a Stream, reduces the Stream using the

293+-- binary operator, from left to right.

294+foldl :: (b -> Char -> b) -> b -> Stream Char -> b

295+foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0

296+ where

297+ loop_foldl z !s = case next s of

298+ Done -> z

299+ Skip s' -> loop_foldl z s'

300+ Yield x s' -> loop_foldl (f z x) s'

301+{-# INLINE [0] foldl #-}

302+

303+-- | A strict version of foldl.

304+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b

305+foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0

306+ where

307+ loop_foldl' !z !s = case next s of

308+ Done -> z

309+ Skip s' -> loop_foldl' z s'

310+ Yield x s' -> loop_foldl' (f z x) s'

311+{-# INLINE [0] foldl' #-}

312+

313+-- | foldl1 is a variant of foldl that has no starting value argument,

314+-- and thus must be applied to non-empty Streams.

315+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char

316+foldl1 f (Stream next s0 _len) = loop0_foldl1 s0

317+ where

318+ loop0_foldl1 !s = case next s of

319+ Skip s' -> loop0_foldl1 s'

320+ Yield x s' -> loop_foldl1 x s'

321+ Done -> emptyError "foldl1"

322+ loop_foldl1 z !s = case next s of

323+ Done -> z

324+ Skip s' -> loop_foldl1 z s'

325+ Yield x s' -> loop_foldl1 (f z x) s'

326+{-# INLINE [0] foldl1 #-}

327+

328+-- | A strict version of foldl1.

329+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char

330+foldl1' f (Stream next s0 _len) = loop0_foldl1' s0

331+ where

332+ loop0_foldl1' !s = case next s of

333+ Skip s' -> loop0_foldl1' s'

334+ Yield x s' -> loop_foldl1' x s'

335+ Done -> emptyError "foldl1"

336+ loop_foldl1' !z !s = case next s of

337+ Done -> z

338+ Skip s' -> loop_foldl1' z s'

339+ Yield x s' -> loop_foldl1' (f z x) s'

340+{-# INLINE [0] foldl1' #-}

341+

342+-- | 'foldr', applied to a binary operator, a starting value (typically the

343+-- right-identity of the operator), and a stream, reduces the stream using the

344+-- binary operator, from right to left.

345+foldr :: (Char -> b -> b) -> b -> Stream Char -> b

346+foldr f z (Stream next s0 _len) = loop_foldr s0

347+ where

348+ loop_foldr !s = case next s of

349+ Done -> z

350+ Skip s' -> loop_foldr s'

351+ Yield x s' -> f x (loop_foldr s')

352+{-# INLINE [0] foldr #-}

353+

354+-- | foldr1 is a variant of 'foldr' that has no starting value argument,

355+-- and thus must be applied to non-empty streams.

356+-- Subject to array fusion.

357+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char

358+foldr1 f (Stream next s0 _len) = loop0_foldr1 s0

359+ where

360+ loop0_foldr1 !s = case next s of

361+ Done -> emptyError "foldr1"

362+ Skip s' -> loop0_foldr1 s'

363+ Yield x s' -> loop_foldr1 x s'

364+

365+ loop_foldr1 x !s = case next s of

366+ Done -> x

367+ Skip s' -> loop_foldr1 x s'

368+ Yield x' s' -> f x (loop_foldr1 x' s')

369+{-# INLINE [0] foldr1 #-}

370+

371+intercalate :: Stream Char -> [Stream Char] -> Stream Char

372+intercalate s = concat . (L.intersperse s)

373+{-# INLINE [0] intercalate #-}

374+

375+-- ----------------------------------------------------------------------------

376+-- ** Special folds

377+

378+-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.

379+concat :: [Stream Char] -> Stream Char

380+concat = L.foldr append (Stream next Done 0)

381+ where

382+ next Done = Done

383+ next _ = internalError "concat"

384+

385+-- | Map a function over a stream that results in a stream and concatenate the

386+-- results.

387+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char

388+concatMap f = foldr (append . f) empty

389+

390+-- | /O(n)/ any @p @xs determines if any character in the stream

391+-- @xs@ satisifes the predicate @p@.

392+any :: (Char -> Bool) -> Stream Char -> Bool

393+any p (Stream next0 s0 _len) = loop_any s0

394+ where

395+ loop_any !s = case next0 s of

396+ Done -> False

397+ Skip s' -> loop_any s'

398+ Yield x s' | p x -> True

399+ | otherwise -> loop_any s'

400+{-# INLINE [0] any #-}

401+

402+-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

403+-- @xs@ satisify the predicate @p@.

404+all :: (Char -> Bool) -> Stream Char -> Bool

405+all p (Stream next0 s0 _len) = loop_all s0

406+ where

407+ loop_all !s = case next0 s of

408+ Done -> True

409+ Skip s' -> loop_all s'

410+ Yield x s' | p x -> loop_all s'

411+ | otherwise -> False

412+{-# INLINE [0] all #-}

413+

414+-- | /O(n)/ maximum returns the maximum value from a stream, which must be

415+-- non-empty.

416+maximum :: Stream Char -> Char

417+maximum (Stream next0 s0 _len) = loop0_maximum s0

418+ where

419+ loop0_maximum !s = case next0 s of

420+ Done -> emptyError "maximum"

421+ Skip s' -> loop0_maximum s'

422+ Yield x s' -> loop_maximum x s'

423+ loop_maximum !z !s = case next0 s of

424+ Done -> z

425+ Skip s' -> loop_maximum z s'

426+ Yield x s'

427+ | x > z -> loop_maximum x s'

428+ | otherwise -> loop_maximum z s'

429+{-# INLINE [0] maximum #-}

430+

431+-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be

432+-- non-empty.

433+minimum :: Stream Char -> Char

434+minimum (Stream next0 s0 _len) = loop0_minimum s0

435+ where

436+ loop0_minimum !s = case next0 s of

437+ Done -> emptyError "minimum"

438+ Skip s' -> loop0_minimum s'

439+ Yield x s' -> loop_minimum x s'

440+ loop_minimum !z !s = case next0 s of

441+ Done -> z

442+ Skip s' -> loop_minimum z s'

443+ Yield x s'

444+ | x < z -> loop_minimum x s'

445+ | otherwise -> loop_minimum z s'

446+{-# INLINE [0] minimum #-}

447+

448+-- -----------------------------------------------------------------------------

449+-- * Building streams

450+

451+scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

452+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)

453+ where

454+ {-# INLINE next #-}

455+ next (S1 :!: z :!: s) = Yield z (S2 :!: z :!: s)

456+ next (S2 :!: z :!: s) = case next0 s of

457+ Yield x s' -> let !x' = f z x

458+ in Yield x' (S2 :!: x' :!: s')

459+ Skip s' -> Skip (S2 :!: z :!: s')

460+ Done -> Done

461+{-# INLINE [0] scanl #-}

462+

463+-- -----------------------------------------------------------------------------

464+-- ** Accumulating maps

465+

466+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

467+-- function to each element of a stream, passing an accumulating

468+-- parameter from left to right, and returns a final stream.

469+--

470+-- /Note/: Unlike the version over lists, this function does not

471+-- return a final value for the accumulator, because the nature of

472+-- streams precludes it.

473+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b

474+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :!: z0) len

475+ where

476+ {-# INLINE next #-}

477+ next (s :!: z) = case next0 s of

478+ Yield x s' -> let (z',y) = f z x

479+ in Yield y (s' :!: z')

480+ Skip s' -> Skip (s' :!: z)

481+ Done -> Done

482+{-# INLINE [0] mapAccumL #-}

483+

484+-- -----------------------------------------------------------------------------

485+-- ** Generating and unfolding streams

486+

487+replicate :: Int -> Char -> Stream Char

488+replicate n c

489+ | n < 0 = empty

490+ | otherwise = Stream next 0 n

491+ where

492+ {-# INLINE next #-}

493+ next i | i >= n = Done

494+ | otherwise = Yield c (i + 1)

495+{-# INLINE [0] replicate #-}

496+

497+-- | /O(n)/, where @n@ is the length of the result. The unfoldr function

498+-- is analogous to the List 'unfoldr'. unfoldr builds a stream

499+-- from a seed value. The function takes the element and returns

500+-- Nothing if it is done producing the stream or returns Just

501+-- (a,b), in which case, a is the next Char in the string, and b is

502+-- the seed value for further production.

503+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char

504+unfoldr f s0 = Stream next s0 1

505+ where

506+ {-# INLINE next #-}

507+ next !s = case f s of

508+ Nothing -> Done

509+ Just (w, s') -> Yield w s'

510+{-# INLINE [0] unfoldr #-}

511+

512+-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed

513+-- value. However, the length of the result is limited by the

514+-- first argument to 'unfoldrNI'. This function is more efficient than

515+-- 'unfoldr' when the length of the result is known.

516+unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char

517+unfoldrNI n f s0 | n < 0 = empty

518+ | otherwise = Stream next (0 :!: s0) (fromIntegral (n*2))

519+ where

520+ {-# INLINE next #-}

521+ next (z :!: s) = case f s of

522+ Nothing -> Done

523+ Just (w, s') | z >= n -> Done

524+ | otherwise -> Yield w ((z + 1) :!: s')

525+{-# INLINE unfoldrNI #-}

526+

527+-------------------------------------------------------------------------------

528+-- * Substreams

529+

530+-- | /O(n)/ take n, applied to a stream, returns the prefix of the

531+-- stream of length @n@, or the stream itself if @n@ is greater than the

532+-- length of the stream.

533+take :: Int -> Stream Char -> Stream Char

534+take n0 (Stream next0 s0 len) = Stream next (n0 :!: s0) len

535+ where

536+ {-# INLINE next #-}

537+ next (n :!: s) | n <= 0 = Done

538+ | otherwise = case next0 s of

539+ Done -> Done

540+ Skip s' -> Skip (n :!: s')

541+ Yield x s' -> Yield x ((n-1) :!: s')

542+{-# INLINE [0] take #-}

543+

544+-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

545+-- stream of length @n@, or the empty stream if @n@ is greater than the

546+-- length of the stream.

547+drop :: Int -> Stream Char -> Stream Char

548+drop n0 (Stream next0 s0 len) = Stream next (Just ((max 0 n0)) :!: s0) (len - n0)

549+ where

550+ {-# INLINE next #-}

551+ next (Just !n :!: s)

552+ | n == 0 = Skip (Nothing :!: s)

553+ | otherwise = case next0 s of

554+ Done -> Done

555+ Skip s' -> Skip (Just n :!: s')

556+ Yield _ s' -> Skip (Just (n-1) :!: s')

557+ next (Nothing :!: s) = case next0 s of

558+ Done -> Done

559+ Skip s' -> Skip (Nothing :!: s')

560+ Yield x s' -> Yield x (Nothing :!: s')

561+{-# INLINE [0] drop #-}

562+

563+-- | takeWhile, applied to a predicate @p@ and a stream, returns the

564+-- longest prefix (possibly empty) of elements that satisfy p.

565+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char

566+takeWhile p (Stream next0 s0 len) = Stream next s0 len

567+ where

568+ {-# INLINE next #-}

569+ next !s = case next0 s of

570+ Done -> Done

571+ Skip s' -> Skip s'

572+ Yield x s' | p x -> Yield x s'

573+ | otherwise -> Done

574+{-# INLINE [0] takeWhile #-}

575+

576+-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

577+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

578+dropWhile p (Stream next0 s0 len) = Stream next (S1 :!: s0) len

579+ where

580+ {-# INLINE next #-}

581+ next (S1 :!: s) = case next0 s of

582+ Done -> Done

583+ Skip s' -> Skip (S1 :!: s')

584+ Yield x s' | p x -> Skip (S1 :!: s')

585+ | otherwise -> Yield x (S2 :!: s')

586+ next (S2 :!: s) = case next0 s of

587+ Done -> Done

588+ Skip s' -> Skip (S2 :!: s')

589+ Yield x s' -> Yield x (S2 :!: s')

590+{-# INLINE [0] dropWhile #-}

591+

592+-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

593+-- 'True' iff the first is a prefix of the second.

594+isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool

595+isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

596+ where

597+ loop Done _ = True

598+ loop _ Done = False

599+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

600+ loop (Skip s1') x2 = loop (next1 s1') x2

601+ loop x1 (Skip s2') = loop x1 (next2 s2')

602+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

603+ loop (next1 s1') (next2 s2')

604+{-# INLINE [0] isPrefixOf #-}

605+{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}

606+

607+-- ----------------------------------------------------------------------------

608+-- * Searching

609+

610+-------------------------------------------------------------------------------

611+-- ** Searching by equality

612+

613+-- | /O(n)/ elem is the stream membership predicate.

614+elem :: Char -> Stream Char -> Bool

615+elem w (Stream next s0 _len) = loop_elem s0

616+ where

617+ loop_elem !s = case next s of

618+ Done -> False

619+ Skip s' -> loop_elem s'

620+ Yield x s' | x == w -> True

621+ | otherwise -> loop_elem s'

622+{-# INLINE [0] elem #-}

623+

624+-------------------------------------------------------------------------------

625+-- ** Searching with a predicate

626+

627+-- | /O(n)/ The 'find' function takes a predicate and a stream,

628+-- and returns the first element in matching the predicate, or 'Nothing'

629+-- if there is no such element.

630+

631+find :: (Char -> Bool) -> Stream Char -> Maybe Char

632+find p (Stream next s0 _len) = loop_find s0

633+ where

634+ loop_find !s = case next s of

635+ Done -> Nothing

636+ Skip s' -> loop_find s'

637+ Yield x s' | p x -> Just x

638+ | otherwise -> loop_find s'

639+{-# INLINE [0] find #-}

640+

641+-- | /O(n)/ 'filter', applied to a predicate and a stream,

642+-- returns a stream containing those characters that satisfy the

643+-- predicate.

644+filter :: (Char -> Bool) -> Stream Char -> Stream Char

645+filter p (Stream next0 s0 len) = Stream next s0 len

646+ where

647+ {-# INLINE next #-}

648+ next !s = case next0 s of

649+ Done -> Done

650+ Skip s' -> Skip s'

651+ Yield x s' | p x -> Yield x s'

652+ | otherwise -> Skip s'

653+{-# INLINE [0] filter #-}

654+

655+{-# RULES

656+ "Stream filter/filter fusion" forall p q s.

657+ filter p (filter q s) = filter (\x -> q x && p x) s

658+ #-}

659+

660+-------------------------------------------------------------------------------

661+-- * Zipping

662+

663+-- | zipWith generalises 'zip' by zipping with the function given as

664+-- the first argument, instead of a tupling function.

665+zipWith :: (Char -> Char -> Char) -> Stream Char -> Stream Char -> Stream Char

666+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) = Stream next (sa0 :!: sb0 :!: Nothing) (min len1 len2)

667+ where

668+ {-# INLINE next #-}

669+ next (sa :!: sb :!: Nothing) = case next0 sa of

670+ Done -> Done

671+ Skip sa' -> Skip (sa' :!: sb :!: Nothing)

672+ Yield a sa' -> Skip (sa' :!: sb :!: Just a)

673+

674+ next (sa' :!: sb :!: Just a) = case next1 sb of

675+ Done -> Done

676+ Skip sb' -> Skip (sa' :!: sb' :!: Just a)

677+ Yield b sb' -> Yield (f a b) (sa' :!: sb' :!: Nothing)

678+{-# INLINE [0] zipWith #-}

679+

680+streamError :: String -> String -> a

681+streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg

682+

683+emptyError :: String -> a

684+emptyError func = internalError func "Empty input"

685+

686+internalError :: String -> a

687+internalError func = streamError func "Internal error"

Data/Text/Fusion/Internal.hs+5−30

@@ -19,10 +19,7 @@ module Data.Text.Fusion.Internal

19 , Switch(..)

20 , Step(..)

21 , Stream(..)

22− , singleton

23 , empty

22 , empty

24− , streamList

25− , unstreamList

26 ) where

23 ) where

28infixl 2 :!:

25infixl 2 :!:

@@ -65,18 +62,6 @@ data Stream a =

65 !s -- current state

62 !s -- current state

66 {-# UNPACK #-}!Int -- length hint

63 {-# UNPACK #-}!Int -- length hint

68−singleton :: Char -> Stream Char

69−singleton c = Stream next False 1

70− where next False = Yield c True

71− next True = Done

72−{-# INLINE singleton #-}

73−

74−-- | The empty stream.

75−empty :: Stream a

76−empty = Stream next () 0

77− where next _ = Done

78−{-# INLINE [0] empty #-}

79−

80-- | /O(n)/ Determines if two streams are equal.

65-- | /O(n)/ Determines if two streams are equal.

81eq :: (Eq a) => Stream a -> Stream a -> Bool

66eq :: (Eq a) => Stream a -> Stream a -> Bool

82eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

67eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

@@ -108,18 +93,8 @@ cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

108{-# INLINE [0] cmp #-}

93{-# INLINE [0] cmp #-}

109{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}

94{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}

110

111−streamList :: [a] -> Stream a

96+-- | The empty stream.

112−{-# INLINE streamList #-}

97+empty :: Stream a

113−streamList [] = empty

98+empty = Stream next () 0

114−streamList s = Stream next s unknownLength

115− where next [] = Done

99+ where next _ = Done

116− next (x:xs) = Yield x xs

117− unknownLength = 8

118−

119−unstreamList :: Stream a -> [a]

120−{-# INLINE unstreamList #-}

100+{-# INLINE [0] empty #-}

121−unstreamList (Stream next s0 _len) = unfold s0

122− where unfold !s = case next s of

123− Done -> []

124− Skip s' -> unfold s'

125− Yield x s' -> x : unfold s'

Data/Text/Lazy.hs+6−6

@@ -156,10 +156,10 @@ import Data.Int (Int64)

156import qualified Data.List as L

157import Data.String (IsString(..))

158import qualified Data.Text as T

159−import qualified Data.Text.Fusion as S

159+import qualified Data.Text.Fusion.Common as S

160−import qualified Data.Text.Fusion.Internal as S

161import qualified Data.Text.Unsafe as T

160import qualified Data.Text.Unsafe as T

162−import Data.Text.Lazy.Fusion

161+import qualified Data.Text.Lazy.Fusion as S

162+import Data.Text.Lazy.Fusion (stream, unstream)

163import Data.Text.Lazy.Internal

164

165instance Eq Text where

@@ -320,9 +320,9 @@ length = foldlChunks go 0

320

321{-# RULES

322"LAZY TEXT length -> fused" [~1] forall t.

323− length t = S.length64 (stream t)

323+ length t = S.length (stream t)

324"LAZY TEXT length -> unfused" [1] forall t.

325− S.length64 (stream t) = length t

325+ S.length (stream t) = length t

326 #-}

327

328-- | /O(n)/ 'map' @f @xs is the 'Text' obtained by applying @f@ to

@@ -490,7 +490,7 @@ unfoldr f s = unstream (S.unfoldr f s)

490-- 'unfoldr' when the maximum length of the result is known and

491-- correct, otherwise its performance is similar to 'unfoldr'.

492unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text

493−unfoldrN n f s = unstream (S.unfoldrN64 n f s)

493+unfoldrN n f s = unstream (S.unfoldrN n f s)

494{-# INLINE unfoldrN #-}

495

496-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a

Data/Text/Lazy/Fusion.hs+19−1

@@ -15,16 +15,21 @@ module Data.Text.Lazy.Fusion

15 stream

16 , unstream

17 , unstreamChunks

18+ , length

19+ , unfoldrN

18 ) where

20 ) where

22+import Prelude hiding (length)

23+import qualified Data.Text.Fusion.Common as S

20import Data.Text.Fusion.Internal

24import Data.Text.Fusion.Internal

21import Data.Text.Lazy.Internal

25import Data.Text.Lazy.Internal

22import qualified Data.Text.Internal as I

26import qualified Data.Text.Internal as I

23import qualified Data.Text.Array as A

27import qualified Data.Text.Array as A

24import Data.Text.UnsafeChar (unsafeWrite)

28import Data.Text.UnsafeChar (unsafeWrite)

25import Data.Text.Unsafe (iter)

29import Data.Text.Unsafe (iter)

30+import Data.Int (Int64)

27−default(Int)

32+default(Int64)

29-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

34-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

30stream :: Text -> Stream Char

35stream :: Text -> Stream Char

@@ -73,5 +78,18 @@ unstream :: Stream Char -> Text

73unstream = unstreamChunks defaultChunkSize

78unstream = unstreamChunks defaultChunkSize

74{-# INLINE [0] unstream #-}

79{-# INLINE [0] unstream #-}

81+-- | /O(n)/ Returns the number of characters in a text.

82+length :: Stream Char -> Int64

83+length = S.lengthI

84+{-# INLINE[0] length #-}

85+

76{-# RULES "LAZY STREAM stream/unstream fusion" forall s.

86{-# RULES "LAZY STREAM stream/unstream fusion" forall s.

77 stream (unstream s) = s #-}

87 stream (unstream s) = s #-}

88+

89+-- | /O(n)/ Like 'unfoldr', 'unfoldrN64' builds a stream from a seed

90+-- value. However, the length of the result is limited by the

91+-- first argument to 'unfoldrN64'. This function is more efficient than

92+-- 'unfoldr' when the length of the result is known.

93+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char

94+unfoldrN n = S.unfoldrNI (fromIntegral n :: Int64)

95+{-# INLINE [0] unfoldrN #-}

tests/Properties.hs+1−2

@@ -18,6 +18,7 @@ import qualified Data.Text.Lazy as TL

18import qualified Data.Text.Encoding as E

19import Control.Exception

20import qualified Data.Text.Fusion as S

21+import qualified Data.Text.Fusion.Common as S

21import qualified Data.Text.Lazy.Fusion as SL

22import qualified Data.Text.Lazy.Fusion as SL

22import qualified Data.List as L

23import qualified Data.List as L

23import System.IO.Unsafe

24import System.IO.Unsafe

@@ -137,7 +138,6 @@ prop_S_null = null `eqP` S.null

137prop_T_null = null `eqP` T.null

138prop_T_null = null `eqP` T.null

138prop_TL_null = null `eqP` TL.null

139prop_TL_null = null `eqP` TL.null

139prop_S_length = length `eqP` S.length

140prop_S_length = length `eqP` S.length

140−prop_S_length64 = length `eqP` (fromIntegral . S.length64)

141prop_T_length = length `eqP` T.length

142prop_TL_length = length `eqP` (fromIntegral . TL.length)

143prop_T_map f = map f `eqP` (unpackT . T.map f)

@@ -350,7 +350,6 @@ tests = [

350 ("prop_T_null", mytest prop_T_null),

351 ("prop_TL_null", mytest prop_TL_null),

352 ("prop_S_length", mytest prop_S_length),

353− ("prop_S_length64", mytest prop_S_length64),

354 ("prop_T_length", mytest prop_T_length),

353 ("prop_T_length", mytest prop_T_length),

355 ("prop_TL_length", mytest prop_TL_length),

354 ("prop_TL_length", mytest prop_TL_length),

356

355

text.cabal+1

@@ -21,6 +21,7 @@ library

21 Data.Text.Encoding.Fusion

22 Data.Text.Foreign

23 Data.Text.Fusion

24+ Data.Text.Fusion.Common

24 Data.Text.Lazy

25 Data.Text.Lazy

25 Data.Text.Lazy.Fusion

26 Data.Text.Lazy.Fusion

26 other-modules:

27 other-modules: