5bb6396..master · text

git.iko.soy/text

on master help sign in

Data/JSString/Text.hsdeleted−64

since splitsnapshots

unifiedsplit

@@ -1,64 +0,0 @@

1−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, JavaScriptFFI,

2− UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,

3− MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}

4−

5−{- | Conversion between 'Data.Text.Text' and 'Data.JSString.JSString'

6−

7− -}

8−

9−-- | Moved from ghcjs-base with text-jsstring support.

10−

11−module Data.JSString.Text

12− ( textToJSString

13− , textFromJSString

14− , lazyTextToJSString

15− , lazyTextFromJSString

16− , textFromJSVal

17− , lazyTextFromJSVal

18− ) where

19−

20−import GHCJS.Prim

21−

22−import GHC.Exts (Any)

23−

24−import Control.DeepSeq

25−

26−import qualified Data.Text as T

27−import qualified Data.Text.Internal as T

28−import qualified Data.Text.Lazy as TL

29−import Data.JSString (JSString)

30−

31−import GHCJS.Marshal.Pure

32−import Unsafe.Coerce

33−

34−textToJSString :: T.Text -> JSString

35−textToJSString (T.Text txt) = txt

36−{-# INLINE textToJSString #-}

37−

38−textFromJSString :: JSString -> T.Text

39−textFromJSString = T.Text

40−{-# INLINE textFromJSString #-}

41−

42−lazyTextToJSString :: TL.Text -> JSString

43−lazyTextToJSString t = rnf t `seq` js_lazyTextToString (unsafeCoerce t)

44−{-# INLINE lazyTextToJSString #-}

45−

46−lazyTextFromJSString :: JSString -> TL.Text

47−lazyTextFromJSString = TL.fromStrict . textFromJSString

48−{-# INLINE lazyTextFromJSString #-}

49−

50−-- | returns the empty Text if not a string

51−textFromJSVal :: JSVal -> T.Text

52−textFromJSVal v = T.Text $ pFromJSVal v -- TODO check if val is a string?

53−{-# INLINE textFromJSVal #-}

54−

55−-- | returns the empty Text if not a string

56−lazyTextFromJSVal :: JSVal -> TL.Text

57−lazyTextFromJSVal = TL.fromStrict . textFromJSVal

58−{-# INLINE lazyTextFromJSVal #-}

59−

60−-- ----------------------------------------------------------------------------

61−

62−foreign import javascript unsafe

63− "h$lazyTextToString"

64− js_lazyTextToString :: Any -> JSString

Data/Text.hs+371−521

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

6#if __GLASGOW_HASKELL__ >= 708

7{-# LANGUAGE TypeFamilies #-}

8#endif

9−{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}

10-- |

11-- Module : Data.Text

@@ -223,16 +223,16 @@ import qualified Data.Text.Internal.Fusion as S

223import qualified Data.Text.Internal.Fusion.Common as S

224import Data.Text.Encoding (decodeUtf8', encodeUtf8)

225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)

226−-- import Data.Text.Internal.Private (span_)

226+import Data.Text.Internal.Private (span_)

227−import Data.Text.Internal (Text(..), empty, empty_, firstf, mul, safe, text)

227+import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)

228−-- import Data.Text.Show (singleton, unpack, unpackCString#)

228+import Data.Text.Show (singleton, unpack, unpackCString#)

229import qualified Prelude as P

230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,

231 reverseIter_, unsafeHead, unsafeTail)

232import Data.Text.Internal.Unsafe.Char (unsafeChr)

233import qualified Data.Text.Internal.Functions as F

234import qualified Data.Text.Internal.Encoding.Utf16 as U16

235−-- import Data.Text.Internal.Search (indices)

235+import Data.Text.Internal.Search (indices)

236#if defined(__HADDOCK__)

237import Data.ByteString (ByteString)

238import qualified Data.Text.Lazy as L

@@ -246,53 +246,6 @@ import qualified GHC.Exts as Exts

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

247#endif

248

249−-- GHCJS ------------------------------------------------------------

250−import Data.JSString (JSString)

251−import qualified Data.JSString as JSS

252−import qualified Data.JSString.Internal.Fusion as SJS

253−import qualified Data.JSString.Internal.Fusion.Common as SJS

254−import Data.Coerce

255−import GHC.Exts (Addr#)

256−import qualified GHC.CString as GHC

257−

258−unpack :: Text -> String

259−unpack = coerce JSS.unpack

260−{-# INLINE [1] unpack #-}

261−

262−singleton :: Char -> Text

263−singleton = coerce JSS.singleton

264−{-# INLINE [1] singleton #-}

265−

266−{-# RULES

267−"JSSTRING singleton -> fused" [~1] forall a.

268− singleton a = unstream (S.singleton (safe a))

269−"JSSTRING singleton -> unfused" [1] forall a.

270− unstream (S.singleton (safe a)) = singleton a

271− #-}

272−

273−-- | /O(n)/ Convert a literal string into a JSString. Subject to fusion.

274−unpackCString# :: Addr# -> Text

275−unpackCString# addr# = Text $ SJS.unstream (SJS.streamCString# addr#)

276−{-# NOINLINE unpackCString# #-}

277−

278−{-# RULES "TEXT literal" forall a.

279− unstream (S.map safe (S.streamList (GHC.unpackCString# a)))

280− = unpackCString# a #-}

281−

282−{-# RULES "TEXT literal UTF8" [1] forall a.

283− unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))

284− = unpackCString# a #-}

285−

286−{-# RULES "TEXT empty literal" [1]

287− unstream (S.map safe (S.streamList []))

288− = empty_ #-}

289−

290−{-# RULES "TEXT singleton literal" [1] forall a.

291− unstream (S.map safe (S.streamList [a]))

292− = singleton a #-}

293−

294−---------------------------------------------------------------------

295−

296-- $strict

249-- $strict

297--

250--

298-- This package provides both strict and lazy 'Text' types. The

251-- This package provides both strict and lazy 'Text' types. The

@@ -368,17 +321,17 @@ unpackCString# addr# = Text $ SJS.unstream (SJS.streamCString# addr#)

368-- Functions that can be fused by the compiler are documented with the

321-- Functions that can be fused by the compiler are documented with the

369-- phrase \"Subject to fusion\".

322-- phrase \"Subject to fusion\".

370

323

371−-- instance Eq Text where

324+instance Eq Text where

372−-- Text arrA offA lenA == Text arrB offB lenB

325+ Text arrA offA lenA == Text arrB offB lenB

373−-- | lenA == lenB = A.equal arrA offA arrB offB lenA

326+ | lenA == lenB = A.equal arrA offA arrB offB lenA

374−-- | otherwise = False

327+ | otherwise = False

375−-- {-# INLINE (==) #-}

328+ {-# INLINE (==) #-}

376

329

377−-- instance Ord Text where

330+instance Ord Text where

378−-- compare = compareText

331+ compare = compareText

379

332

380−-- instance Read Text where

333+instance Read Text where

381−-- readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]

334+ readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]

382

335

383#if MIN_VERSION_base(4,9,0)

336#if MIN_VERSION_base(4,9,0)

384-- Semigroup orphan instances for older GHCs are provided by

337-- Semigroup orphan instances for older GHCs are provided by

@@ -388,17 +341,17 @@ instance Semigroup Text where

388 (<>) = append

341 (<>) = append

389#endif

342#endif

390

343

391−-- instance Monoid Text where

344+instance Monoid Text where

392−-- mempty = empty

345+ mempty = empty

393−-- #if MIN_VERSION_base(4,9,0)

346+#if MIN_VERSION_base(4,9,0)

394−-- mappend = (<>) -- future-proof definition

347+ mappend = (<>) -- future-proof definition

395−-- #else

348+#else

396−-- mappend = append

349+ mappend = append

397−-- #endif

350+#endif

398−-- mconcat = concat

351+ mconcat = concat

399

352

400−-- instance IsString Text where

353+instance IsString Text where

401−-- fromString = pack

354+ fromString = pack

402

355

403#if __GLASGOW_HASKELL__ >= 708

356#if __GLASGOW_HASKELL__ >= 708

404instance Exts.IsList Text where

357instance Exts.IsList Text where

@@ -434,18 +387,18 @@ instance Binary Text where

434-- and 'Data.Map.Map' is archived here:

387-- and 'Data.Map.Map' is archived here:

435-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >

388-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >

436

389

437−-- instance Data Text where

390+instance Data Text where

438−-- gfoldl f z txt = z pack `f` (unpack txt)

391+ gfoldl f z txt = z pack `f` (unpack txt)

439−-- toConstr _ = packConstr

392+ toConstr _ = packConstr

440−-- gunfold k z c = case constrIndex c of

393+ gunfold k z c = case constrIndex c of

441−-- 1 -> k (z pack)

394+ 1 -> k (z pack)

442−-- _ -> P.error "gunfold"

395+ _ -> P.error "gunfold"

443−-- dataTypeOf _ = textDataType

396+ dataTypeOf _ = textDataType

444

397

445#if MIN_VERSION_base(4,7,0)

398#if MIN_VERSION_base(4,7,0)

446-- | Only defined for @base-4.7.0.0@ and later

399-- | Only defined for @base-4.7.0.0@ and later

447instance PrintfArg Text where

400instance PrintfArg Text where

448− formatArg t = formatString $ unpack t

401+ formatArg txt = formatString $ unpack txt

449#endif

402#endif

450

403

451packConstr :: Constr

404packConstr :: Constr

@@ -454,19 +407,19 @@ packConstr = mkConstr textDataType "pack" [] Prefix

454textDataType :: DataType

407textDataType :: DataType

455textDataType = mkDataType "Data.Text.Text" [packConstr]

408textDataType = mkDataType "Data.Text.Text" [packConstr]

456

409

457−-- -- | /O(n)/ Compare two 'Text' values lexicographically.

410+-- | /O(n)/ Compare two 'Text' values lexicographically.

458−-- compareText :: Text -> Text -> Ordering

411+compareText :: Text -> Text -> Ordering

459−-- compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)

412+compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)

460−-- | lenA == 0 && lenB == 0 = EQ

413+ | lenA == 0 && lenB == 0 = EQ

461−-- | otherwise = go 0 0

414+ | otherwise = go 0 0

462−-- where

415+ where

463−-- go !i !j

416+ go !i !j

464−-- | i >= lenA || j >= lenB = compare lenA lenB

417+ | i >= lenA || j >= lenB = compare lenA lenB

465−-- | a < b = LT

418+ | a < b = LT

466−-- | a > b = GT

419+ | a > b = GT

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

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

468−-- where Iter a di = iter ta i

421+ where Iter a di = iter ta i

469−-- Iter b dj = iter tb j

422+ Iter b dj = iter tb j

470

423

471-- -----------------------------------------------------------------------------

424-- -----------------------------------------------------------------------------

472-- * Conversion to/from 'Text'

425-- * Conversion to/from 'Text'

@@ -474,8 +427,7 @@ textDataType = mkDataType "Data.Text.Text" [packConstr]

474-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to

427-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to

475-- fusion. Performs replacement on invalid scalar values.

428-- fusion. Performs replacement on invalid scalar values.

476pack :: String -> Text

429pack :: String -> Text

477−pack = coerce JSS.pack

478−-- pack = unstream . S.map safe . S.streamList

430+pack = unstream . S.map safe . S.streamList

479{-# INLINE [1] pack #-}

431{-# INLINE [1] pack #-}

480

432

481-- -----------------------------------------------------------------------------

433-- -----------------------------------------------------------------------------

@@ -486,8 +438,7 @@ pack = coerce JSS.pack

486-- copying a new array. Subject to fusion. Performs replacement on

438-- copying a new array. Subject to fusion. Performs replacement on

487-- invalid scalar values.

439-- invalid scalar values.

488cons :: Char -> Text -> Text

440cons :: Char -> Text -> Text

489−cons = coerce JSS.cons

490−-- cons c t = unstream (S.cons (safe c) (stream t))

441+cons c t = unstream (S.cons (safe c) (stream t))

491{-# INLINE cons #-}

442{-# INLINE cons #-}

492

443

493infixr 5 `cons`

444infixr 5 `cons`

@@ -496,27 +447,25 @@ infixr 5 `cons`

496-- entire array in the process, unless fused. Subject to fusion.

447-- entire array in the process, unless fused. Subject to fusion.

497-- Performs replacement on invalid scalar values.

448-- Performs replacement on invalid scalar values.

498snoc :: Text -> Char -> Text

449snoc :: Text -> Char -> Text

499−snoc = coerce JSS.snoc

500−-- snoc t c = unstream (S.snoc (stream t) (safe c))

450+snoc t c = unstream (S.snoc (stream t) (safe c))

501{-# INLINE snoc #-}

451{-# INLINE snoc #-}

502

452

503-- | /O(n)/ Appends one 'Text' to the other by copying both of them

453-- | /O(n)/ Appends one 'Text' to the other by copying both of them

504-- into a new 'Text'. Subject to fusion.

454-- into a new 'Text'. Subject to fusion.

505append :: Text -> Text -> Text

455append :: Text -> Text -> Text

506−append = coerce JSS.append

507−-- append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)

456+append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)

508−-- | len1 == 0 = b

457+ | len1 == 0 = b

509−-- | len2 == 0 = a

458+ | len2 == 0 = a

510−-- | len > 0 = Text (A.run x) 0 len

459+ | len > 0 = Text (A.run x) 0 len

511−-- | otherwise = overflowError "append"

460+ | otherwise = overflowError "append"

512−-- where

461+ where

513−-- len = len1+len2

462+ len = len1+len2

514−-- x :: ST s (A.MArray s)

463+ x :: ST s (A.MArray s)

515−-- x = do

464+ x = do

516−-- arr <- A.new len

465+ arr <- A.new len

517−-- A.copyI arr 0 arr1 off1 len1

466+ A.copyI arr 0 arr1 off1 len1

518−-- A.copyI arr len1 arr2 off2 len

467+ A.copyI arr len1 arr2 off2 len

519−-- return arr

468+ return arr

520{-# NOINLINE append #-}

469{-# NOINLINE append #-}

521

470

522{-# RULES

471{-# RULES

@@ -529,18 +478,16 @@ append = coerce JSS.append

529-- | /O(1)/ Returns the first character of a 'Text', which must be

478-- | /O(1)/ Returns the first character of a 'Text', which must be

530-- non-empty. Subject to fusion.

479-- non-empty. Subject to fusion.

531head :: Text -> Char

480head :: Text -> Char

532−head = coerce JSS.head

533−-- head t = S.head (stream t)

481+head t = S.head (stream t)

534{-# INLINE head #-}

482{-# INLINE head #-}

535

483

536-- | /O(1)/ Returns the first character and rest of a 'Text', or

484-- | /O(1)/ Returns the first character and rest of a 'Text', or

537-- 'Nothing' if empty. Subject to fusion.

485-- 'Nothing' if empty. Subject to fusion.

538uncons :: Text -> Maybe (Char, Text)

486uncons :: Text -> Maybe (Char, Text)

539−uncons = coerce JSS.uncons

540−-- uncons t@(Text arr off len)

487+uncons t@(Text arr off len)

541−-- | len <= 0 = Nothing

488+ | len <= 0 = Nothing

542−-- | otherwise = Just $ let !(Iter c d) = iter t 0

489+ | otherwise = Just $ let !(Iter c d) = iter t 0

543−-- in (c, text arr (off+d) (len-d))

490+ in (c, text arr (off+d) (len-d))

544{-# INLINE [1] uncons #-}

491{-# INLINE [1] uncons #-}

545

492

546-- | Lifted from Control.Arrow and specialized.

493-- | Lifted from Control.Arrow and specialized.

@@ -550,13 +497,12 @@ second f (a, b) = (a, f b)

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

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

551-- non-empty. Subject to fusion.

498-- non-empty. Subject to fusion.

552last :: Text -> Char

499last :: Text -> Char

553−last = coerce JSS.last

554−-- last (Text arr off len)

500+last (Text arr off len)

555−-- | len <= 0 = emptyError "last"

501+ | len <= 0 = emptyError "last"

556−-- | n < 0xDC00 || n > 0xDFFF = unsafeChr n

502+ | n < 0xDC00 || n > 0xDFFF = unsafeChr n

557−-- | otherwise = U16.chr2 n0 n

503+ | otherwise = U16.chr2 n0 n

558−-- where n = A.unsafeIndex arr (off+len-1)

504+ where n = A.unsafeIndex arr (off+len-1)

559−-- n0 = A.unsafeIndex arr (off+len-2)

505+ n0 = A.unsafeIndex arr (off+len-2)

560{-# INLINE [1] last #-}

506{-# INLINE [1] last #-}

561

507

562{-# RULES

508{-# RULES

@@ -569,11 +515,10 @@ last = coerce JSS.last

569-- | /O(1)/ Returns all characters after the head of a 'Text', which

515-- | /O(1)/ Returns all characters after the head of a 'Text', which

570-- must be non-empty. Subject to fusion.

516-- must be non-empty. Subject to fusion.

571tail :: Text -> Text

517tail :: Text -> Text

572−tail = coerce JSS.tail

573−-- tail t@(Text arr off len)

518+tail t@(Text arr off len)

574−-- | len <= 0 = emptyError "tail"

519+ | len <= 0 = emptyError "tail"

575−-- | otherwise = text arr (off+d) (len-d)

520+ | otherwise = text arr (off+d) (len-d)

576−-- where d = iter_ t 0

521+ where d = iter_ t 0

577{-# INLINE [1] tail #-}

522{-# INLINE [1] tail #-}

578

523

579{-# RULES

524{-# RULES

@@ -586,12 +531,11 @@ tail = coerce JSS.tail

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

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

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

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

588init :: Text -> Text

533init :: Text -> Text

589−init = coerce JSS.init

590−-- init (Text arr off len) | len <= 0 = emptyError "init"

534+init (Text arr off len) | len <= 0 = emptyError "init"

591−-- | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)

535+ | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)

592−-- | otherwise = text arr off (len-1)

536+ | otherwise = text arr off (len-1)

593−-- where

537+ where

594−-- n = A.unsafeIndex arr (off+len-1)

538+ n = A.unsafeIndex arr (off+len-1)

595{-# INLINE [1] init #-}

539{-# INLINE [1] init #-}

596

540

597{-# RULES

541{-# RULES

@@ -604,12 +548,11 @@ init = coerce JSS.init

604-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to

548-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to

605-- fusion.

549-- fusion.

606null :: Text -> Bool

550null :: Text -> Bool

607−null = coerce JSS.null

608−-- null (Text _arr _off len) =

551+null (Text _arr _off len) =

609−-- #if defined(ASSERTS)

552+#if defined(ASSERTS)

610−-- assert (len >= 0) $

553+ assert (len >= 0) $

611−-- #endif

554+#endif

612−-- len <= 0

555+ len <= 0

613{-# INLINE [1] null #-}

556{-# INLINE [1] null #-}

614

557

615{-# RULES

558{-# RULES

@@ -621,15 +564,14 @@ null = coerce JSS.null

621

564

622-- | /O(1)/ Tests whether a 'Text' contains exactly one character.

565-- | /O(1)/ Tests whether a 'Text' contains exactly one character.

623-- Subject to fusion.

566-- Subject to fusion.

624−-- isSingleton :: Text -> Bool

567+isSingleton :: Text -> Bool

625−-- isSingleton = S.isSingleton . stream

568+isSingleton = S.isSingleton . stream

626−-- {-# INLINE isSingleton #-}

569+{-# INLINE isSingleton #-}

627

570

628-- | /O(n)/ Returns the number of characters in a 'Text'.

571-- | /O(n)/ Returns the number of characters in a 'Text'.

629-- Subject to fusion.

572-- Subject to fusion.

630length :: Text -> Int

573length :: Text -> Int

631−length = coerce JSS.length

632−-- length t = S.length (stream t)

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

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

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

634-- length needs to be phased after the compareN/length rules otherwise

576-- length needs to be phased after the compareN/length rules otherwise

635-- it may inline before the rules have an opportunity to fire.

577-- it may inline before the rules have an opportunity to fire.

@@ -685,30 +627,26 @@ compareLength t n = S.compareLengthI (stream t) n

685-- each element of @t@. Subject to fusion. Performs replacement on

627-- each element of @t@. Subject to fusion. Performs replacement on

686-- invalid scalar values.

628-- invalid scalar values.

687map :: (Char -> Char) -> Text -> Text

629map :: (Char -> Char) -> Text -> Text

688−map = coerce JSS.map

689−-- map f t = unstream (S.map (safe . f) (stream t))

630+map f t = unstream (S.map (safe . f) (stream t))

690{-# INLINE [1] map #-}

631{-# INLINE [1] map #-}

691

632

692-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of

633-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of

693-- 'Text's and concatenates the list after interspersing the first

634-- 'Text's and concatenates the list after interspersing the first

694-- argument between each element of the list.

635-- argument between each element of the list.

695intercalate :: Text -> [Text] -> Text

636intercalate :: Text -> [Text] -> Text

696−intercalate = coerce JSS.intercalate

697−-- intercalate t = concat . (F.intersperse t)

637+intercalate t = concat . (F.intersperse t)

698{-# INLINE intercalate #-}

638{-# INLINE intercalate #-}

699

639

700-- | /O(n)/ The 'intersperse' function takes a character and places it

640-- | /O(n)/ The 'intersperse' function takes a character and places it

701-- between the characters of a 'Text'. Subject to fusion. Performs

641-- between the characters of a 'Text'. Subject to fusion. Performs

702-- replacement on invalid scalar values.

642-- replacement on invalid scalar values.

703intersperse :: Char -> Text -> Text

643intersperse :: Char -> Text -> Text

704−intersperse = coerce JSS.intersperse

705−-- intersperse c t = unstream (S.intersperse (safe c) (stream t))

644+intersperse c t = unstream (S.intersperse (safe c) (stream t))

706{-# INLINE intersperse #-}

645{-# INLINE intersperse #-}

707

646

708-- | /O(n)/ Reverse the characters of a string. Subject to fusion.

647-- | /O(n)/ Reverse the characters of a string. Subject to fusion.

709reverse :: Text -> Text

648reverse :: Text -> Text

710−reverse = coerce JSS.reverse

711−-- reverse t = S.reverse (stream t)

649+reverse t = S.reverse (stream t)

712{-# INLINE reverse #-}

650{-# INLINE reverse #-}

713

651

714-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in

652-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in

@@ -742,29 +680,28 @@ replace :: Text

742 -> Text

680 -> Text

743 -- ^ @haystack@ in which to search.

681 -- ^ @haystack@ in which to search.

744 -> Text

682 -> Text

745−replace = coerce JSS.replace

746−-- replace needle@(Text _ _ neeLen)

683+replace needle@(Text _ _ neeLen)

747−-- (Text repArr repOff repLen)

684+ (Text repArr repOff repLen)

748−-- haystack@(Text hayArr hayOff hayLen)

685+ haystack@(Text hayArr hayOff hayLen)

749−-- | neeLen == 0 = emptyError "replace"

686+ | neeLen == 0 = emptyError "replace"

750−-- | L.null ixs = haystack

687+ | L.null ixs = haystack

751−-- | len > 0 = Text (A.run x) 0 len

688+ | len > 0 = Text (A.run x) 0 len

752−-- | otherwise = empty

689+ | otherwise = empty

753−-- where

690+ where

754−-- ixs = indices needle haystack

691+ ixs = indices needle haystack

755−-- len = hayLen - (neeLen - repLen) `mul` L.length ixs

692+ len = hayLen - (neeLen - repLen) `mul` L.length ixs

756−-- x :: ST s (A.MArray s)

693+ x :: ST s (A.MArray s)

757−-- x = do

694+ x = do

758−-- marr <- A.new len

695+ marr <- A.new len

759−-- let loop (i:is) o d = do

696+ let loop (i:is) o d = do

760−-- let d0 = d + i - o

697+ let d0 = d + i - o

761−-- d1 = d0 + repLen

698+ d1 = d0 + repLen

762−-- A.copyI marr d hayArr (hayOff+o) d0

699+ A.copyI marr d hayArr (hayOff+o) d0

763−-- A.copyI marr d0 repArr repOff d1

700+ A.copyI marr d0 repArr repOff d1

764−-- loop is (i + neeLen) d1

701+ loop is (i + neeLen) d1

765−-- loop [] o d = A.copyI marr d hayArr (hayOff+o) len

702+ loop [] o d = A.copyI marr d hayArr (hayOff+o) len

766−-- loop ixs 0 0

703+ loop ixs 0 0

767−-- return marr

704+ return marr

768

705

769-- ----------------------------------------------------------------------------

706-- ----------------------------------------------------------------------------

770-- ** Case conversions (folds)

707-- ** Case conversions (folds)

@@ -803,8 +740,7 @@ replace = coerce JSS.replace

803-- U+00B5) is case folded to \"μ\" (small letter mu, U+03BC)

740-- U+00B5) is case folded to \"μ\" (small letter mu, U+03BC)

804-- instead of itself.

741-- instead of itself.

805toCaseFold :: Text -> Text

742toCaseFold :: Text -> Text

806−-- toCaseFold t = unstream (S.toCaseFold (stream t))

743+toCaseFold t = unstream (S.toCaseFold (stream t))

807−toCaseFold = coerce JSS.toCaseFold

808{-# INLINE toCaseFold #-}

744{-# INLINE toCaseFold #-}

809

745

810-- | /O(n)/ Convert a string to lower case, using simple case

746-- | /O(n)/ Convert a string to lower case, using simple case

@@ -815,8 +751,7 @@ toCaseFold = coerce JSS.toCaseFold

815-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)

751-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)

816-- followed by \" ̇\" (combining dot above, U+0307).

752-- followed by \" ̇\" (combining dot above, U+0307).

817toLower :: Text -> Text

753toLower :: Text -> Text

818−-- toLower t = unstream (S.toLower (stream t))

754+toLower t = unstream (S.toLower (stream t))

819−toLower = coerce JSS.toLower

820{-# INLINE toLower #-}

755{-# INLINE toLower #-}

821

756

822-- | /O(n)/ Convert a string to upper case, using simple case

757-- | /O(n)/ Convert a string to upper case, using simple case

@@ -826,8 +761,7 @@ toLower = coerce JSS.toLower

826-- instance, the German \"ß\" (eszett, U+00DF) maps to the

761-- instance, the German \"ß\" (eszett, U+00DF) maps to the

827-- two-letter sequence \"SS\".

762-- two-letter sequence \"SS\".

828toUpper :: Text -> Text

763toUpper :: Text -> Text

829−-- toUpper t = unstream (S.toUpper (stream t))

764+toUpper t = unstream (S.toUpper (stream t))

830−toUpper = coerce JSS.toUpper

831{-# INLINE toUpper #-}

765{-# INLINE toUpper #-}

832

766

833-- | /O(n)/ Convert a string to title case, using simple case

767-- | /O(n)/ Convert a string to title case, using simple case

@@ -849,8 +783,7 @@ toUpper = coerce JSS.toUpper

849-- Fox\" is correctly title cased—but this function will

783-- Fox\" is correctly title cased—but this function will

850-- capitalize /every/ word.

784-- capitalize /every/ word.

851toTitle :: Text -> Text

785toTitle :: Text -> Text

852−toTitle = coerce JSS.toTitle

853−-- toTitle t = unstream (S.toTitle (stream t))

786+toTitle t = unstream (S.toTitle (stream t))

854{-# INLINE toTitle #-}

787{-# INLINE toTitle #-}

855

788

856-- | /O(n)/ Left-justify a string to the given length, using the

789-- | /O(n)/ Left-justify a string to the given length, using the

@@ -862,11 +795,10 @@ toTitle = coerce JSS.toTitle

862-- > justifyLeft 7 'x' "foo" == "fooxxxx"

795-- > justifyLeft 7 'x' "foo" == "fooxxxx"

863-- > justifyLeft 3 'x' "foobar" == "foobar"

796-- > justifyLeft 3 'x' "foobar" == "foobar"

864justifyLeft :: Int -> Char -> Text -> Text

797justifyLeft :: Int -> Char -> Text -> Text

865−justifyLeft = coerce JSS.justifyLeft

798+justifyLeft k c t

866−-- justifyLeft k c t

867−-- | len >= k = t

799+ | len >= k = t

868−-- | otherwise = t `append` replicateChar (k-len) c

800+ | otherwise = t `append` replicateChar (k-len) c

869−-- where len = length t

801+ where len = length t

870{-# INLINE [1] justifyLeft #-}

802{-# INLINE [1] justifyLeft #-}

871

803

872{-# RULES

804{-# RULES

@@ -885,11 +817,10 @@ justifyLeft = coerce JSS.justifyLeft

885-- > justifyRight 7 'x' "bar" == "xxxxbar"

817-- > justifyRight 7 'x' "bar" == "xxxxbar"

886-- > justifyRight 3 'x' "foobar" == "foobar"

818-- > justifyRight 3 'x' "foobar" == "foobar"

887justifyRight :: Int -> Char -> Text -> Text

819justifyRight :: Int -> Char -> Text -> Text

888−justifyRight = coerce JSS.justifyRight

820+justifyRight k c t

889−-- justifyRight k c t

890−-- | len >= k = t

821+ | len >= k = t

891−-- | otherwise = replicateChar (k-len) c `append` t

822+ | otherwise = replicateChar (k-len) c `append` t

892−-- where len = length t

823+ where len = length t

893{-# INLINE justifyRight #-}

824{-# INLINE justifyRight #-}

894

825

895-- | /O(n)/ Center a string to the given length, using the specified

826-- | /O(n)/ Center a string to the given length, using the specified

@@ -900,14 +831,13 @@ justifyRight = coerce JSS.justifyRight

900--

831--

901-- > center 8 'x' "HS" = "xxxHSxxx"

832-- > center 8 'x' "HS" = "xxxHSxxx"

902center :: Int -> Char -> Text -> Text

833center :: Int -> Char -> Text -> Text

903−center = coerce JSS.center

834+center k c t

904−-- center k c t

905−-- | len >= k = t

835+ | len >= k = t

906−-- | otherwise = replicateChar l c `append` t `append` replicateChar r c

836+ | otherwise = replicateChar l c `append` t `append` replicateChar r c

907−-- where len = length t

837+ where len = length t

908−-- d = k - len

838+ d = k - len

909−-- r = d `quot` 2

839+ r = d `quot` 2

910−-- l = d - r

840+ l = d - r

911{-# INLINE center #-}

841{-# INLINE center #-}

912

842

913-- | /O(n)/ The 'transpose' function transposes the rows and columns

843-- | /O(n)/ The 'transpose' function transposes the rows and columns

@@ -915,8 +845,7 @@ center = coerce JSS.center

915-- 'unpack', and the list version of transpose, and is thus not very

845-- 'unpack', and the list version of transpose, and is thus not very

916-- efficient.

846-- efficient.

917transpose :: [Text] -> [Text]

847transpose :: [Text] -> [Text]

918−transpose = coerce JSS.transpose

919−-- transpose ts = P.map pack (L.transpose (P.map unpack ts))

848+transpose ts = P.map pack (L.transpose (P.map unpack ts))

920

849

921-- -----------------------------------------------------------------------------

850-- -----------------------------------------------------------------------------

922-- * Reducing 'Text's (folds)

851-- * Reducing 'Text's (folds)

@@ -926,27 +855,23 @@ transpose = coerce JSS.transpose

926-- reduces the 'Text' using the binary operator, from left to right.

855-- reduces the 'Text' using the binary operator, from left to right.

927-- Subject to fusion.

856-- Subject to fusion.

928foldl :: (a -> Char -> a) -> a -> Text -> a

857foldl :: (a -> Char -> a) -> a -> Text -> a

929−foldl f a0 (Text t) = JSS.foldl f a0 t

930−-- foldl f z t = S.foldl f z (stream t)

858+foldl f z t = S.foldl f z (stream t)

931{-# INLINE foldl #-}

859{-# INLINE foldl #-}

932

860

933-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.

861-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.

934foldl' :: (a -> Char -> a) -> a -> Text -> a

862foldl' :: (a -> Char -> a) -> a -> Text -> a

935−foldl' f a0 (Text t) = JSS.foldl' f a0 t

936−-- foldl' f z t = S.foldl' f z (stream t)

863+foldl' f z t = S.foldl' f z (stream t)

937{-# INLINE foldl' #-}

864{-# INLINE foldl' #-}

938

865

939-- | /O(n)/ A variant of 'foldl' that has no starting value argument,

866-- | /O(n)/ A variant of 'foldl' that has no starting value argument,

940-- and thus must be applied to a non-empty 'Text'. Subject to fusion.

867-- and thus must be applied to a non-empty 'Text'. Subject to fusion.

941foldl1 :: (Char -> Char -> Char) -> Text -> Char

868foldl1 :: (Char -> Char -> Char) -> Text -> Char

942−foldl1 = coerce JSS.foldl1

943−-- foldl1 f t = S.foldl1 f (stream t)

869+foldl1 f t = S.foldl1 f (stream t)

944{-# INLINE foldl1 #-}

870{-# INLINE foldl1 #-}

945

871

946-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.

872-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.

947foldl1' :: (Char -> Char -> Char) -> Text -> Char

873foldl1' :: (Char -> Char -> Char) -> Text -> Char

948−foldl1' = coerce JSS.foldl1'

949−-- foldl1' f t = S.foldl1' f (stream t)

874+foldl1' f t = S.foldl1' f (stream t)

950{-# INLINE foldl1' #-}

875{-# INLINE foldl1' #-}

951

876

952-- | /O(n)/ 'foldr', applied to a binary operator, a starting value

877-- | /O(n)/ 'foldr', applied to a binary operator, a starting value

@@ -954,16 +879,14 @@ foldl1' = coerce JSS.foldl1'

954-- reduces the 'Text' using the binary operator, from right to left.

879-- reduces the 'Text' using the binary operator, from right to left.

955-- Subject to fusion.

880-- Subject to fusion.

956foldr :: (Char -> a -> a) -> a -> Text -> a

881foldr :: (Char -> a -> a) -> a -> Text -> a

957−foldr f a0 (Text t) = JSS.foldr f a0 t

958−-- foldr f z t = S.foldr f z (stream t)

882+foldr f z t = S.foldr f z (stream t)

959{-# INLINE foldr #-}

883{-# INLINE foldr #-}

960

884

961-- | /O(n)/ A variant of 'foldr' that has no starting value argument,

885-- | /O(n)/ A variant of 'foldr' that has no starting value argument,

962-- and thus must be applied to a non-empty 'Text'. Subject to

886-- and thus must be applied to a non-empty 'Text'. Subject to

963-- fusion.

887-- fusion.

964foldr1 :: (Char -> Char -> Char) -> Text -> Char

888foldr1 :: (Char -> Char -> Char) -> Text -> Char

965−foldr1 = coerce JSS.foldr1

966−-- foldr1 f t = S.foldr1 f (stream t)

889+foldr1 f t = S.foldr1 f (stream t)

967{-# INLINE foldr1 #-}

890{-# INLINE foldr1 #-}

968

891

969-- -----------------------------------------------------------------------------

892-- -----------------------------------------------------------------------------

@@ -971,54 +894,48 @@ foldr1 = coerce JSS.foldr1

971

894

972-- | /O(n)/ Concatenate a list of 'Text's.

895-- | /O(n)/ Concatenate a list of 'Text's.

973concat :: [Text] -> Text

896concat :: [Text] -> Text

974−concat = coerce JSS.concat

975−-- concat ts = case ts' of

897+concat ts = case ts' of

976−-- [] -> empty

898+ [] -> empty

977−-- [t] -> t

899+ [t] -> t

978−-- _ -> Text (A.run go) 0 len

900+ _ -> Text (A.run go) 0 len

979−-- where

901+ where

980−-- ts' = L.filter (not . null) ts

902+ ts' = L.filter (not . null) ts

981−-- len = sumP "concat" $ L.map lengthWord16 ts'

903+ len = sumP "concat" $ L.map lengthWord16 ts'

982−-- go :: ST s (A.MArray s)

904+ go :: ST s (A.MArray s)

983−-- go = do

905+ go = do

984−-- arr <- A.new len

906+ arr <- A.new len

985−-- let step i (Text a o l) =

907+ let step i (Text a o l) =

986−-- let !j = i + l in A.copyI arr i a o j >> return j

908+ let !j = i + l in A.copyI arr i a o j >> return j

987−-- foldM step 0 ts' >> return arr

909+ foldM step 0 ts' >> return arr

988

910

989-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and

911-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and

990-- concatenate the results.

912-- concatenate the results.

991concatMap :: (Char -> Text) -> Text -> Text

913concatMap :: (Char -> Text) -> Text -> Text

992−concatMap = coerce JSS.concatMap

993−-- concatMap f = concat . foldr ((:) . f) []

914+concatMap f = concat . foldr ((:) . f) []

994{-# INLINE concatMap #-}

915{-# INLINE concatMap #-}

995

916

996-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the

917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the

997-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.

918-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.

998any :: (Char -> Bool) -> Text -> Bool

919any :: (Char -> Bool) -> Text -> Bool

999−any = coerce JSS.any

1000−-- any p t = S.any p (stream t)

920+any p t = S.any p (stream t)

1001{-# INLINE any #-}

921{-# INLINE any #-}

1002

922

1003-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the

923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the

1004-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.

924-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.

1005all :: (Char -> Bool) -> Text -> Bool

925all :: (Char -> Bool) -> Text -> Bool

1006−all = coerce JSS.all

1007−-- all p t = S.all p (stream t)

926+all p t = S.all p (stream t)

1008{-# INLINE all #-}

927{-# INLINE all #-}

1009

928

1010-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which

929-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which

1011-- must be non-empty. Subject to fusion.

930-- must be non-empty. Subject to fusion.

1012maximum :: Text -> Char

931maximum :: Text -> Char

1013−maximum = coerce JSS.maximum

1014−-- maximum t = S.maximum (stream t)

932+maximum t = S.maximum (stream t)

1015{-# INLINE maximum #-}

933{-# INLINE maximum #-}

1016

934

1017-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which

935-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which

1018-- must be non-empty. Subject to fusion.

936-- must be non-empty. Subject to fusion.

1019minimum :: Text -> Char

937minimum :: Text -> Char

1020−minimum = coerce JSS.minimum

1021−-- minimum t = S.minimum (stream t)

938+minimum t = S.minimum (stream t)

1022{-# INLINE minimum #-}

939{-# INLINE minimum #-}

1023

940

1024-- -----------------------------------------------------------------------------

941-- -----------------------------------------------------------------------------

@@ -1034,9 +951,8 @@ minimum = coerce JSS.minimum

1034--

951--

1035-- > last (scanl f z xs) == foldl f z xs.

952-- > last (scanl f z xs) == foldl f z xs.

1036scanl :: (Char -> Char -> Char) -> Char -> Text -> Text

953scanl :: (Char -> Char -> Char) -> Char -> Text -> Text

1037−scanl = coerce JSS.scanl

1038−-- scanl f z t = unstream (S.scanl g z (stream t))

954+scanl f z t = unstream (S.scanl g z (stream t))

1039−-- where g a b = safe (f a b)

955+ where g a b = safe (f a b)

1040{-# INLINE scanl #-}

956{-# INLINE scanl #-}

1041

957

1042-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting

958-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting

@@ -1045,9 +961,8 @@ scanl = coerce JSS.scanl

1045--

961--

1046-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]

962-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]

1047scanl1 :: (Char -> Char -> Char) -> Text -> Text

963scanl1 :: (Char -> Char -> Char) -> Text -> Text

1048−scanl1 = coerce JSS.scanl1

1049−-- scanl1 f t | null t = empty

964+scanl1 f t | null t = empty

1050−-- | otherwise = scanl f (unsafeHead t) (unsafeTail t)

965+ | otherwise = scanl f (unsafeHead t) (unsafeTail t)

1051{-# INLINE scanl1 #-}

966{-# INLINE scanl1 #-}

1052

967

1053-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs

968-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs

@@ -1055,18 +970,16 @@ scanl1 = coerce JSS.scanl1

1055--

970--

1056-- > scanr f v == reverse . scanl (flip f) v . reverse

971-- > scanr f v == reverse . scanl (flip f) v . reverse

1057scanr :: (Char -> Char -> Char) -> Char -> Text -> Text

972scanr :: (Char -> Char -> Char) -> Char -> Text -> Text

1058−scanr = coerce JSS.scanr

1059−-- scanr f z = S.reverse . S.reverseScanr g z . reverseStream

973+scanr f z = S.reverse . S.reverseScanr g z . reverseStream

1060−-- where g a b = safe (f a b)

974+ where g a b = safe (f a b)

1061{-# INLINE scanr #-}

975{-# INLINE scanr #-}

1062

976

1063-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting

977-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting

1064-- value argument. Subject to fusion. Performs replacement on

978-- value argument. Subject to fusion. Performs replacement on

1065-- invalid scalar values.

979-- invalid scalar values.

1066scanr1 :: (Char -> Char -> Char) -> Text -> Text

980scanr1 :: (Char -> Char -> Char) -> Text -> Text

1067−scanr1 = coerce JSS.scanr1

1068−-- scanr1 f t | null t = empty

981+scanr1 f t | null t = empty

1069−-- | otherwise = scanr f (last t) (init t)

982+ | otherwise = scanr f (last t) (init t)

1070{-# INLINE scanr1 #-}

983{-# INLINE scanr1 #-}

1071

984

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

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

@@ -1074,11 +987,8 @@ scanr1 = coerce JSS.scanr1

1074-- parameter from left to right, and returns a final 'Text'. Performs

987-- parameter from left to right, and returns a final 'Text'. Performs

1075-- replacement on invalid scalar values.

988-- replacement on invalid scalar values.

1076mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)

989mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)

1077−mapAccumL f z0 (Text a) =

1078− let (a', t) = JSS.mapAccumL f z0 a

1079− in (a', Text t)

1080−-- mapAccumL f z0 = S.mapAccumL g z0 . stream

990+mapAccumL f z0 = S.mapAccumL g z0 . stream

1081−-- where g a b = second safe (f a b)

991+ where g a b = second safe (f a b)

1082{-# INLINE mapAccumL #-}

992{-# INLINE mapAccumL #-}

1083

993

1084-- | The 'mapAccumR' function behaves like a combination of 'map' and

994-- | The 'mapAccumR' function behaves like a combination of 'map' and

@@ -1088,11 +998,8 @@ mapAccumL f z0 (Text a) =

1088-- 'Text'.

998-- 'Text'.

1089-- Performs replacement on invalid scalar values.

999-- Performs replacement on invalid scalar values.

1090mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)

1000mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)

1091−mapAccumR f z0 (Text a) =

1092− let (a', t) = JSS.mapAccumR f z0 a

1093− in (a', Text t)

1094−-- mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream

1001+mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream

1095−-- where g a b = second safe (f a b)

1002+ where g a b = second safe (f a b)

1096{-# INLINE mapAccumR #-}

1003{-# INLINE mapAccumR #-}

1097

1004

1098-- -----------------------------------------------------------------------------

1005-- -----------------------------------------------------------------------------

@@ -1101,21 +1008,20 @@ mapAccumR f z0 (Text a) =

1101-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

1008-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

1102-- @t@ repeated @n@ times.

1009-- @t@ repeated @n@ times.

1103replicate :: Int -> Text -> Text

1010replicate :: Int -> Text -> Text

1104−replicate = coerce JSS.replicate

1105−-- replicate n t@(Text a o l)

1011+replicate n t@(Text a o l)

1106−-- | n <= 0 || l <= 0 = empty

1012+ | n <= 0 || l <= 0 = empty

1107−-- | n == 1 = t

1013+ | n == 1 = t

1108−-- | isSingleton t = replicateChar n (unsafeHead t)

1014+ | isSingleton t = replicateChar n (unsafeHead t)

1109−-- | otherwise = Text (A.run x) 0 len

1015+ | otherwise = Text (A.run x) 0 len

1110−-- where

1016+ where

1111−-- len = l `mul` n

1017+ len = l `mul` n

1112−-- x :: ST s (A.MArray s)

1018+ x :: ST s (A.MArray s)

1113−-- x = do

1019+ x = do

1114−-- arr <- A.new len

1020+ arr <- A.new len

1115−-- let loop !d !i | i >= n = return arr

1021+ let loop !d !i | i >= n = return arr

1116−-- | otherwise = let m = d + l

1022+ | otherwise = let m = d + l

1117−-- in A.copyI arr d a o m >> loop m (i+1)

1023+ in A.copyI arr d a o m >> loop m (i+1)

1118−-- loop 0 0

1024+ loop 0 0

1119{-# INLINE [1] replicate #-}

1025{-# INLINE [1] replicate #-}

1120

1026

1121{-# RULES

1027{-# RULES

@@ -1126,19 +1032,8 @@ replicate = coerce JSS.replicate

1126-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

1032-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

1127-- value of every element. Subject to fusion.

1033-- value of every element. Subject to fusion.

1128replicateChar :: Int -> Char -> Text

1034replicateChar :: Int -> Char -> Text

1129−#ifndef __GHCJS__

1130replicateChar n c = unstream (S.replicateCharI n (safe c))

1035replicateChar n c = unstream (S.replicateCharI n (safe c))

1131{-# INLINE replicateChar #-}

1036{-# INLINE replicateChar #-}

1132−#else

1133−replicateChar n c = Text $ js_replicateChar n c

1134−{-# INLINE [1] replicateChar #-}

1135−{-# RULES

1136−"JSSTRING replicateChar -> fused" [~1] forall n c.

1137− replicateChar n c = unstream (S.replicateCharI n (safe c))

1138−"JSSTRING replicateChar -> unfused" [1] forall n c.

1139− unstream (S.replicateCharI n (safe c)) = replicateChar n c

1140− #-}

1141−#endif

1142

1037

1143-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'

1038-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'

1144-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a

1039-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a

@@ -1148,8 +1043,7 @@ replicateChar n c = Text $ js_replicateChar n c

1148-- string, and @b@ is the seed value for further production. Subject

1043-- string, and @b@ is the seed value for further production. Subject

1149-- to fusion. Performs replacement on invalid scalar values.

1044-- to fusion. Performs replacement on invalid scalar values.

1150unfoldr :: (a -> Maybe (Char,a)) -> a -> Text

1045unfoldr :: (a -> Maybe (Char,a)) -> a -> Text

1151−unfoldr f a = Text $ JSS.unfoldr f a

1152−-- unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)

1046+unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)

1153{-# INLINE unfoldr #-}

1047{-# INLINE unfoldr #-}

1154

1048

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

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

@@ -1159,8 +1053,7 @@ unfoldr f a = Text $ JSS.unfoldr f a

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

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

1160-- to fusion. Performs replacement on invalid scalar values.

1054-- to fusion. Performs replacement on invalid scalar values.

1161unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text

1055unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text

1162−unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0

1163−-- unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)

1056+unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)

1164{-# INLINE unfoldrN #-}

1057{-# INLINE unfoldrN #-}

1165

1058

1166-- -----------------------------------------------------------------------------

1059-- -----------------------------------------------------------------------------

@@ -1170,19 +1063,18 @@ unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0

1170-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than

1063-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than

1171-- the length of the Text. Subject to fusion.

1064-- the length of the Text. Subject to fusion.

1172take :: Int -> Text -> Text

1065take :: Int -> Text -> Text

1173−take = coerce JSS.take

1174−-- take n t@(Text arr off len)

1066+take n t@(Text arr off len)

1175−-- | n <= 0 = empty

1067+ | n <= 0 = empty

1176−-- | n >= len = t

1068+ | n >= len = t

1177−-- | otherwise = text arr off (iterN n t)

1069+ | otherwise = text arr off (iterN n t)

1178{-# INLINE [1] take #-}

1070{-# INLINE [1] take #-}

1179

1071

1180−-- iterN :: Int -> Text -> Int

1072+iterN :: Int -> Text -> Int

1181−-- iterN n t@(Text _arr _off len) = loop 0 0

1073+iterN n t@(Text _arr _off len) = loop 0 0

1182−-- where loop !i !cnt

1074+ where loop !i !cnt

1183−-- | i >= len || cnt >= n = i

1075+ | i >= len || cnt >= n = i

1184−-- | otherwise = loop (i+d) (cnt+1)

1076+ | otherwise = loop (i+d) (cnt+1)

1185−-- where d = iter_ t i

1077+ where d = iter_ t i

1186

1078

1187{-# RULES

1079{-# RULES

1188"TEXT take -> fused" [~1] forall n t.

1080"TEXT take -> fused" [~1] forall n t.

@@ -1198,31 +1090,29 @@ take = coerce JSS.take

1198--

1090--

1199-- > takeEnd 3 "foobar" == "bar"

1091-- > takeEnd 3 "foobar" == "bar"

1200takeEnd :: Int -> Text -> Text

1092takeEnd :: Int -> Text -> Text

1201−takeEnd = coerce JSS.takeEnd

1202−-- takeEnd n t@(Text arr off len)

1093+takeEnd n t@(Text arr off len)

1203−-- | n <= 0 = empty

1094+ | n <= 0 = empty

1204−-- | n >= len = t

1095+ | n >= len = t

1205−-- | otherwise = text arr (off+i) (len-i)

1096+ | otherwise = text arr (off+i) (len-i)

1206−-- where i = iterNEnd n t

1097+ where i = iterNEnd n t

1207−

1098+

1208−-- iterNEnd :: Int -> Text -> Int

1099+iterNEnd :: Int -> Text -> Int

1209−-- iterNEnd n t@(Text _arr _off len) = loop (len-1) n

1100+iterNEnd n t@(Text _arr _off len) = loop (len-1) n

1210−-- where loop i !m

1101+ where loop i !m

1211−-- | i <= 0 = 0

1102+ | i <= 0 = 0

1212−-- | m <= 1 = i

1103+ | m <= 1 = i

1213−-- | otherwise = loop (i+d) (m-1)

1104+ | otherwise = loop (i+d) (m-1)

1214−-- where d = reverseIter_ t i

1105+ where d = reverseIter_ t i

1215

1106

1216-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the

1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the

1217-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@

1108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@

1218-- is greater than the length of the 'Text'. Subject to fusion.

1109-- is greater than the length of the 'Text'. Subject to fusion.

1219drop :: Int -> Text -> Text

1110drop :: Int -> Text -> Text

1220−drop = coerce JSS.drop

1221−-- drop n t@(Text arr off len)

1111+drop n t@(Text arr off len)

1222−-- | n <= 0 = t

1112+ | n <= 0 = t

1223−-- | n >= len = empty

1113+ | n >= len = empty

1224−-- | otherwise = text arr (off+i) (len-i)

1114+ | otherwise = text arr (off+i) (len-i)

1225−-- where i = iterN n t

1115+ where i = iterN n t

1226{-# INLINE [1] drop #-}

1116{-# INLINE [1] drop #-}

1227

1117

1228{-# RULES

1118{-# RULES

@@ -1239,22 +1129,20 @@ drop = coerce JSS.drop

1239--

1129--

1240-- > dropEnd 3 "foobar" == "foo"

1130-- > dropEnd 3 "foobar" == "foo"

1241dropEnd :: Int -> Text -> Text

1131dropEnd :: Int -> Text -> Text

1242−dropEnd = coerce JSS.dropEnd

1243−-- dropEnd n t@(Text arr off len)

1132+dropEnd n t@(Text arr off len)

1244−-- | n <= 0 = t

1133+ | n <= 0 = t

1245−-- | n >= len = empty

1134+ | n >= len = empty

1246−-- | otherwise = text arr off (iterNEnd n t)

1135+ | otherwise = text arr off (iterNEnd n t)

1247

1136

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

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

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

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

1250-- satisfy @p@. Subject to fusion.

1139-- satisfy @p@. Subject to fusion.

1251takeWhile :: (Char -> Bool) -> Text -> Text

1140takeWhile :: (Char -> Bool) -> Text -> Text

1252−takeWhile = coerce JSS.takeWhile

1253−-- takeWhile p t@(Text arr off len) = loop 0

1141+takeWhile p t@(Text arr off len) = loop 0

1254−-- where loop !i | i >= len = t

1142+ where loop !i | i >= len = t

1255−-- | p c = loop (i+d)

1143+ | p c = loop (i+d)

1256−-- | otherwise = text arr off i

1144+ | otherwise = text arr off i

1257−-- where Iter c d = iter t i

1145+ where Iter c d = iter t i

1258{-# INLINE [1] takeWhile #-}

1146{-# INLINE [1] takeWhile #-}

1259

1147

1260{-# RULES

1148{-# RULES

@@ -1271,13 +1159,11 @@ takeWhile = coerce JSS.takeWhile

1271--

1159--

1272-- > takeWhileEnd (=='o') "foo" == "oo"

1160-- > takeWhileEnd (=='o') "foo" == "oo"

1273takeWhileEnd :: (Char -> Bool) -> Text -> Text

1161takeWhileEnd :: (Char -> Bool) -> Text -> Text

1274−takeWhileEnd = P.error "takeWhileEnd: not implemented."

1275−-- takeWhileEnd :: (Char -> Bool) -> Text -> Text

1276−-- takeWhileEnd p t@(Text arr off len) = loop (len-1) len

1162+takeWhileEnd p t@(Text arr off len) = loop (len-1) len

1277−-- where loop !i !l | l <= 0 = t

1163+ where loop !i !l | l <= 0 = t

1278−-- | p c = loop (i+d) (l+d)

1164+ | p c = loop (i+d) (l+d)

1279−-- | otherwise = text arr (off+l) (len-l)

1165+ | otherwise = text arr (off+l) (len-l)

1280−-- where (c,d) = reverseIter t i

1166+ where (c,d) = reverseIter t i

1281{-# INLINE [1] takeWhileEnd #-}

1167{-# INLINE [1] takeWhileEnd #-}

1282

1168

1283{-# RULES

1169{-# RULES

@@ -1290,12 +1176,11 @@ takeWhileEnd = P.error "takeWhileEnd: not implemented."

1290-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after

1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after

1291-- 'takeWhile' @p@ @t@. Subject to fusion.

1177-- 'takeWhile' @p@ @t@. Subject to fusion.

1292dropWhile :: (Char -> Bool) -> Text -> Text

1178dropWhile :: (Char -> Bool) -> Text -> Text

1293−dropWhile = coerce JSS.dropWhile

1294−-- dropWhile p t@(Text arr off len) = loop 0 0

1179+dropWhile p t@(Text arr off len) = loop 0 0

1295−-- where loop !i !l | l >= len = empty

1180+ where loop !i !l | l >= len = empty

1296−-- | p c = loop (i+d) (l+d)

1181+ | p c = loop (i+d) (l+d)

1297−-- | otherwise = Text arr (off+i) (len-l)

1182+ | otherwise = Text arr (off+i) (len-l)

1298−

1183+ where Iter c d = iter t i

1299{-# INLINE [1] dropWhile #-}

1184{-# INLINE [1] dropWhile #-}

1300

1185

1301{-# RULES

1186{-# RULES

@@ -1313,12 +1198,11 @@ dropWhile = coerce JSS.dropWhile

1313--

1198--

1314-- > dropWhileEnd (=='.') "foo..." == "foo"

1199-- > dropWhileEnd (=='.') "foo..." == "foo"

1315dropWhileEnd :: (Char -> Bool) -> Text -> Text

1200dropWhileEnd :: (Char -> Bool) -> Text -> Text

1316−dropWhileEnd = coerce JSS.dropWhileEnd

1317−-- dropWhileEnd p t@(Text arr off len) = loop (len-1) len

1201+dropWhileEnd p t@(Text arr off len) = loop (len-1) len

1318−-- where loop !i !l | l <= 0 = empty

1202+ where loop !i !l | l <= 0 = empty

1319−-- | p c = loop (i+d) (l+d)

1203+ | p c = loop (i+d) (l+d)

1320−-- | otherwise = Text arr off l

1204+ | otherwise = Text arr off l

1321−-- where (c,d) = reverseIter t i

1205+ where (c,d) = reverseIter t i

1322{-# INLINE [1] dropWhileEnd #-}

1206{-# INLINE [1] dropWhileEnd #-}

1323

1207

1324{-# RULES

1208{-# RULES

@@ -1361,49 +1245,45 @@ strip = dropAround isSpace

1361-- prefix of @t@ of length @n@, and whose second is the remainder of

1245-- prefix of @t@ of length @n@, and whose second is the remainder of

1362-- the string. It is equivalent to @('take' n t, 'drop' n t)@.

1246-- the string. It is equivalent to @('take' n t, 'drop' n t)@.

1363splitAt :: Int -> Text -> (Text, Text)

1247splitAt :: Int -> Text -> (Text, Text)

1364−splitAt = coerce JSS.splitAt

1365−-- splitAt n t@(Text arr off len)

1248+splitAt n t@(Text arr off len)

1366−-- | n <= 0 = (empty, t)

1249+ | n <= 0 = (empty, t)

1367−-- | n >= len = (t, empty)

1250+ | n >= len = (t, empty)

1368−-- | otherwise = let k = iterN n t

1251+ | otherwise = let k = iterN n t

1369−-- in (text arr off k, text arr (off+k) (len-k))

1252+ in (text arr off k, text arr (off+k) (len-k))

1370

1253

1371-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns

1254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns

1372-- a pair whose first element is the longest prefix (possibly empty)

1255-- a pair whose first element is the longest prefix (possibly empty)

1373-- of @t@ of elements that satisfy @p@, and whose second is the

1256-- of @t@ of elements that satisfy @p@, and whose second is the

1374-- remainder of the list.

1257-- remainder of the list.

1375span :: (Char -> Bool) -> Text -> (Text, Text)

1258span :: (Char -> Bool) -> Text -> (Text, Text)

1376−span = coerce JSS.span

1377−-- span p t = case span_ p t of

1259+span p t = case span_ p t of

1378−-- (# hd,tl #) -> (hd,tl)

1260+ (# hd,tl #) -> (hd,tl)

1379{-# INLINE span #-}

1261{-# INLINE span #-}

1380

1262

1381-- | /O(n)/ 'break' is like 'span', but the prefix returned is

1263-- | /O(n)/ 'break' is like 'span', but the prefix returned is

1382-- over elements that fail the predicate @p@.

1264-- over elements that fail the predicate @p@.

1383break :: (Char -> Bool) -> Text -> (Text, Text)

1265break :: (Char -> Bool) -> Text -> (Text, Text)

1384−break = coerce JSS.break

1385−-- break p = span (not . p)

1266+break p = span (not . p)

1386{-# INLINE break #-}

1267{-# INLINE break #-}

1387

1268

1388-- | /O(n)/ Group characters in a string according to a predicate.

1269-- | /O(n)/ Group characters in a string according to a predicate.

1389groupBy :: (Char -> Char -> Bool) -> Text -> [Text]

1270groupBy :: (Char -> Char -> Bool) -> Text -> [Text]

1390−groupBy = coerce JSS.groupBy

1391−-- groupBy p = loop

1271+groupBy p = loop

1392−-- where

1272+ where

1393−-- loop t@(Text arr off len)

1273+ loop t@(Text arr off len)

1394−-- | null t = []

1274+ | null t = []

1395−-- | otherwise = text arr off n : loop (text arr (off+n) (len-n))

1275+ | otherwise = text arr off n : loop (text arr (off+n) (len-n))

1396−-- where Iter c d = iter t 0

1276+ where Iter c d = iter t 0

1397−-- n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))

1277+ n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))

1398

1278

1399-- | Returns the /array/ index (in units of 'Word16') at which a

1279-- | Returns the /array/ index (in units of 'Word16') at which a

1400-- character may be found. This is /not/ the same as the logical

1280-- character may be found. This is /not/ the same as the logical

1401-- index returned by e.g. 'findIndex'.

1281-- index returned by e.g. 'findIndex'.

1402−-- findAIndexOrEnd :: (Char -> Bool) -> Text -> Int

1282+findAIndexOrEnd :: (Char -> Bool) -> Text -> Int

1403−-- findAIndexOrEnd q t@(Text _arr _off len) = go 0

1283+findAIndexOrEnd q t@(Text _arr _off len) = go 0

1404−-- where go !i | i >= len || q c = i

1284+ where go !i | i >= len || q c = i

1405−-- | otherwise = go (i+d)

1285+ | otherwise = go (i+d)

1406−-- where Iter c d = iter t i

1286+ where Iter c d = iter t i

1407

1287

1408-- | /O(n)/ Group characters in a string by equality.

1288-- | /O(n)/ Group characters in a string by equality.

1409group :: Text -> [Text]

1289group :: Text -> [Text]

@@ -1412,17 +1292,15 @@ group = groupBy (==)

1412-- | /O(n)/ Return all initial segments of the given 'Text', shortest

1292-- | /O(n)/ Return all initial segments of the given 'Text', shortest

1413-- first.

1293-- first.

1414inits :: Text -> [Text]

1294inits :: Text -> [Text]

1415−inits = coerce JSS.inits

1416−-- inits t@(Text arr off len) = loop 0

1295+inits t@(Text arr off len) = loop 0

1417−-- where loop i | i >= len = [t]

1296+ where loop i | i >= len = [t]

1418−-- | otherwise = Text arr off i : loop (i + iter_ t i)

1297+ | otherwise = Text arr off i : loop (i + iter_ t i)

1419

1298

1420-- | /O(n)/ Return all final segments of the given 'Text', longest

1299-- | /O(n)/ Return all final segments of the given 'Text', longest

1421-- first.

1300-- first.

1422tails :: Text -> [Text]

1301tails :: Text -> [Text]

1423−tails = coerce JSS.tails

1424−-- tails t | null t = [empty]

1302+tails t | null t = [empty]

1425−-- | otherwise = t : tails (unsafeTail t)

1303+ | otherwise = t : tails (unsafeTail t)

1426

1304

1427-- $split

1305-- $split

1428--

1306--

@@ -1455,14 +1333,13 @@ splitOn :: Text

1455 -> Text

1333 -> Text

1456 -- ^ Input text.

1334 -- ^ Input text.

1457 -> [Text]

1335 -> [Text]

1458−splitOn = coerce JSS.splitOn

1459−-- splitOn pat@(Text _ _ l) src@(Text arr off len)

1336+splitOn pat@(Text _ _ l) src@(Text arr off len)

1460−-- | l <= 0 = emptyError "splitOn"

1337+ | l <= 0 = emptyError "splitOn"

1461−-- | isSingleton pat = split (== unsafeHead pat) src

1338+ | isSingleton pat = split (== unsafeHead pat) src

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

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

1463−-- where

1340+ where

1464−-- go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs

1341+ go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs

1465−-- go s _ = [text arr (s+off) (len-s)]

1342+ go s _ = [text arr (s+off) (len-s)]

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

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

1467

1344

1468{-# RULES

1345{-# RULES

@@ -1478,12 +1355,11 @@ splitOn = coerce JSS.splitOn

1478-- > split (=='a') "aabbaca" == ["","","bb","c",""]

1355-- > split (=='a') "aabbaca" == ["","","bb","c",""]

1479-- > split (=='a') "" == [""]

1356-- > split (=='a') "" == [""]

1480split :: (Char -> Bool) -> Text -> [Text]

1357split :: (Char -> Bool) -> Text -> [Text]

1481−split = coerce JSS.split

1482−-- split _ t@(Text _off _arr 0) = [t]

1358+split _ t@(Text _off _arr 0) = [t]

1483−-- split p t = loop t

1359+split p t = loop t

1484−-- where loop s | null s' = [l]

1360+ where loop s | null s' = [l]

1485−-- | otherwise = l : loop (unsafeTail s')

1361+ | otherwise = l : loop (unsafeTail s')

1486−-- where (# l, s' #) = span_ (not . p) s

1362+ where (# l, s' #) = span_ (not . p) s

1487{-# INLINE split #-}

1363{-# INLINE split #-}

1488

1364

1489-- | /O(n)/ Splits a 'Text' into components of length @k@. The last

1365-- | /O(n)/ Splits a 'Text' into components of length @k@. The last

@@ -1493,12 +1369,11 @@ split = coerce JSS.split

1493-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]

1369-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]

1494-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]

1370-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]

1495chunksOf :: Int -> Text -> [Text]

1371chunksOf :: Int -> Text -> [Text]

1496−chunksOf = coerce JSS.chunksOf

1372+chunksOf k = go

1497−-- chunksOf k = go

1498−-- where

1373+ where

1499−-- go t = case splitAt k t of

1374+ go t = case splitAt k t of

1500−-- (a,b) | null a -> []

1375+ (a,b) | null a -> []

1501−-- | otherwise -> a : go b

1376+ | otherwise -> a : go b

1502{-# INLINE chunksOf #-}

1377{-# INLINE chunksOf #-}

1503

1378

1504-- ----------------------------------------------------------------------------

1379-- ----------------------------------------------------------------------------

@@ -1511,8 +1386,7 @@ chunksOf = coerce JSS.chunksOf

1511-- returns the first element matching the predicate, or 'Nothing' if

1386-- returns the first element matching the predicate, or 'Nothing' if

1512-- there is no such element.

1387-- there is no such element.

1513find :: (Char -> Bool) -> Text -> Maybe Char

1388find :: (Char -> Bool) -> Text -> Maybe Char

1514−find = coerce JSS.find

1515−-- find p t = S.findBy p (stream t)

1389+find p t = S.findBy p (stream t)

1516{-# INLINE find #-}

1390{-# INLINE find #-}

1517

1391

1518-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',

1392-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',

@@ -1521,16 +1395,14 @@ find = coerce JSS.find

1521--

1395--

1522-- > partition p t == (filter p t, filter (not . p) t)

1396-- > partition p t == (filter p t, filter (not . p) t)

1523partition :: (Char -> Bool) -> Text -> (Text, Text)

1397partition :: (Char -> Bool) -> Text -> (Text, Text)

1524−partition = coerce JSS.partition

1525−-- partition p t = (filter p t, filter (not . p) t)

1398+partition p t = (filter p t, filter (not . p) t)

1526{-# INLINE partition #-}

1399{-# INLINE partition #-}

1527

1400

1528-- | /O(n)/ 'filter', applied to a predicate and a 'Text',

1401-- | /O(n)/ 'filter', applied to a predicate and a 'Text',

1529-- returns a 'Text' containing those characters that satisfy the

1402-- returns a 'Text' containing those characters that satisfy the

1530-- predicate.

1403-- predicate.

1531filter :: (Char -> Bool) -> Text -> Text

1404filter :: (Char -> Bool) -> Text -> Text

1532−filter = coerce JSS.filter

1533−-- filter p t = unstream (S.filter p (stream t))

1405+filter p t = unstream (S.filter p (stream t))

1534{-# INLINE filter #-}

1406{-# INLINE filter #-}

1535

1407

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

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

@@ -1555,12 +1427,11 @@ filter = coerce JSS.filter

1555-- In (unlikely) bad cases, this function's time complexity degrades

1427-- In (unlikely) bad cases, this function's time complexity degrades

1556-- towards /O(n*m)/.

1428-- towards /O(n*m)/.

1557breakOn :: Text -> Text -> (Text, Text)

1429breakOn :: Text -> Text -> (Text, Text)

1558−breakOn = coerce JSS.breakOn

1559−-- breakOn pat src@(Text arr off len)

1430+breakOn pat src@(Text arr off len)

1560−-- | null pat = emptyError "breakOn"

1431+ | null pat = emptyError "breakOn"

1561−-- | otherwise = case indices pat src of

1432+ | otherwise = case indices pat src of

1562−-- [] -> (src, empty)

1433+ [] -> (src, empty)

1563−-- (x:_) -> (text arr off x, text arr (off+x) (len-x))

1434+ (x:_) -> (text arr off x, text arr (off+x) (len-x))

1564{-# INLINE breakOn #-}

1435{-# INLINE breakOn #-}

1565

1436

1566-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the

1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the

@@ -1572,9 +1443,8 @@ breakOn = coerce JSS.breakOn

1572--

1443--

1573-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")

1444-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")

1574breakOnEnd :: Text -> Text -> (Text, Text)

1445breakOnEnd :: Text -> Text -> (Text, Text)

1575−breakOnEnd = coerce JSS.breakOnEnd

1576−-- breakOnEnd pat src = (reverse b, reverse a)

1446+breakOnEnd pat src = (reverse b, reverse a)

1577−-- where (a,b) = breakOn (reverse pat) (reverse src)

1447+ where (a,b) = breakOn (reverse pat) (reverse src)

1578{-# INLINE breakOnEnd #-}

1448{-# INLINE breakOnEnd #-}

1579

1449

1580-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in

1450-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in

@@ -1598,13 +1468,12 @@ breakOnEnd = coerce JSS.breakOnEnd

1598breakOnAll :: Text -- ^ @needle@ to search for

1468breakOnAll :: Text -- ^ @needle@ to search for

1599 -> Text -- ^ @haystack@ in which to search

1469 -> Text -- ^ @haystack@ in which to search

1600 -> [(Text, Text)]

1470 -> [(Text, Text)]

1601−breakOnAll = coerce JSS.breakOnAll

1602−-- breakOnAll pat src@(Text arr off slen)

1471+breakOnAll pat src@(Text arr off slen)

1603−-- | null pat = emptyError "breakOnAll"

1472+ | null pat = emptyError "breakOnAll"

1604−-- | otherwise = L.map step (indices pat src)

1473+ | otherwise = L.map step (indices pat src)

1605−-- where

1474+ where

1606−-- step x = (chunk 0 x, chunk x (slen-x))

1475+ step x = (chunk 0 x, chunk x (slen-x))

1607−-- chunk !n !l = text arr (n+off) l

1476+ chunk !n !l = text arr (n+off) l

1608{-# INLINE breakOnAll #-}

1477{-# INLINE breakOnAll #-}

1609

1478

1610-------------------------------------------------------------------------------

1479-------------------------------------------------------------------------------

@@ -1628,16 +1497,14 @@ breakOnAll = coerce JSS.breakOnAll

1628

1497

1629-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.

1498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.

1630index :: Text -> Int -> Char

1499index :: Text -> Int -> Char

1631−index = coerce JSS.index

1632−-- index t n = S.index (stream t) n

1500+index t n = S.index (stream t) n

1633{-# INLINE index #-}

1501{-# INLINE index #-}

1634

1502

1635-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'

1503-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'

1636-- and returns the index of the first element in the 'Text' satisfying

1504-- and returns the index of the first element in the 'Text' satisfying

1637-- the predicate. Subject to fusion.

1505-- the predicate. Subject to fusion.

1638findIndex :: (Char -> Bool) -> Text -> Maybe Int

1506findIndex :: (Char -> Bool) -> Text -> Maybe Int

1639−findIndex = coerce JSS.findIndex

1640−-- findIndex p t = S.findIndex p (stream t)

1507+findIndex p t = S.findIndex p (stream t)

1641{-# INLINE findIndex #-}

1508{-# INLINE findIndex #-}

1642

1509

1643-- | /O(n+m)/ The 'count' function returns the number of times the

1510-- | /O(n+m)/ The 'count' function returns the number of times the

@@ -1647,11 +1514,10 @@ findIndex = coerce JSS.findIndex

1647-- In (unlikely) bad cases, this function's time complexity degrades

1514-- In (unlikely) bad cases, this function's time complexity degrades

1648-- towards /O(n*m)/.

1515-- towards /O(n*m)/.

1649count :: Text -> Text -> Int

1516count :: Text -> Text -> Int

1650−count = coerce JSS.count

1651−-- count pat src

1517+count pat src

1652−-- | null pat = emptyError "count"

1518+ | null pat = emptyError "count"

1653−-- | isSingleton pat = countChar (unsafeHead pat) src

1519+ | isSingleton pat = countChar (unsafeHead pat) src

1654−-- | otherwise = L.length (indices pat src)

1520+ | otherwise = L.length (indices pat src)

1655{-# INLINE [1] count #-}

1521{-# INLINE [1] count #-}

1656

1522

1657{-# RULES

1523{-# RULES

@@ -1673,46 +1539,42 @@ countChar c t = S.countChar c (stream t)

1673-- excess elements of the longer 'Text' are discarded. This is

1539-- excess elements of the longer 'Text' are discarded. This is

1674-- equivalent to a pair of 'unpack' operations.

1540-- equivalent to a pair of 'unpack' operations.

1675zip :: Text -> Text -> [(Char,Char)]

1541zip :: Text -> Text -> [(Char,Char)]

1676−zip = coerce JSS.zip

1677−-- zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)

1542+zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)

1678{-# INLINE zip #-}

1543{-# INLINE zip #-}

1679

1544

1680-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function

1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function

1681-- given as the first argument, instead of a tupling function.

1546-- given as the first argument, instead of a tupling function.

1682-- Performs replacement on invalid scalar values.

1547-- Performs replacement on invalid scalar values.

1683zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text

1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text

1684−zipWith = coerce JSS.zipWith

1685−-- zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))

1549+zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))

1686−-- where g a b = safe (f a b)

1550+ where g a b = safe (f a b)

1687{-# INLINE zipWith #-}

1551{-# INLINE zipWith #-}

1688

1552

1689-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's

1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's

1690-- representing white space.

1554-- representing white space.

1691words :: Text -> [Text]

1555words :: Text -> [Text]

1692−words = coerce JSS.words

1693−-- words t@(Text arr off len) = loop 0 0

1556+words t@(Text arr off len) = loop 0 0

1694−-- where

1557+ where

1695−-- loop !start !n

1558+ loop !start !n

1696−-- | n >= len = if start == n

1559+ | n >= len = if start == n

1697−-- then []

1560+ then []

1698−-- else [Text arr (start+off) (n-start)]

1561+ else [Text arr (start+off) (n-start)]

1699−-- | isSpace c =

1562+ | isSpace c =

1700−-- if start == n

1563+ if start == n

1701−-- then loop (start+1) (start+1)

1564+ then loop (start+1) (start+1)

1702−-- else Text arr (start+off) (n-start) : loop (n+d) (n+d)

1565+ else Text arr (start+off) (n-start) : loop (n+d) (n+d)

1703−-- | otherwise = loop start (n+d)

1566+ | otherwise = loop start (n+d)

1704−-- where Iter c d = iter t n

1567+ where Iter c d = iter t n

1705{-# INLINE words #-}

1568{-# INLINE words #-}

1706

1569

1707-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at

1570-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at

1708-- newline 'Char's. The resulting strings do not contain newlines.

1571-- newline 'Char's. The resulting strings do not contain newlines.

1709lines :: Text -> [Text]

1572lines :: Text -> [Text]

1710−lines = coerce JSS.lines

1711−-- lines ps | null ps = []

1573+lines ps | null ps = []

1712−-- | otherwise = h : if null t

1574+ | otherwise = h : if null t

1713−-- then []

1575+ then []

1714−-- else lines (unsafeTail t)

1576+ else lines (unsafeTail t)

1715−-- where (# h,t #) = span_ (/= '\n') ps

1577+ where (# h,t #) = span_ (/= '\n') ps

1716{-# INLINE lines #-}

1578{-# INLINE lines #-}

1717

1579

1718{-

1580{-

@@ -1740,40 +1602,34 @@ lines' ps | null ps = []

1740-- | /O(n)/ Joins lines, after appending a terminating newline to

1602-- | /O(n)/ Joins lines, after appending a terminating newline to

1741-- each.

1603-- each.

1742unlines :: [Text] -> Text

1604unlines :: [Text] -> Text

1743−unlines = coerce JSS.unlines

1744−-- unlines = concat . L.map (`snoc` '\n')

1605+unlines = concat . L.map (`snoc` '\n')

1745{-# INLINE unlines #-}

1606{-# INLINE unlines #-}

1746

1607

1747-- | /O(n)/ Joins words using single space characters.

1608-- | /O(n)/ Joins words using single space characters.

1748unwords :: [Text] -> Text

1609unwords :: [Text] -> Text

1749−unwords = coerce JSS.unwords

1750−-- unwords = intercalate (singleton ' ')

1610+unwords = intercalate (singleton ' ')

1751{-# INLINE unwords #-}

1611{-# INLINE unwords #-}

1752

1612

1753-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns

1613-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns

1754-- 'True' iff the first is a prefix of the second. Subject to fusion.

1614-- 'True' iff the first is a prefix of the second. Subject to fusion.

1755isPrefixOf :: Text -> Text -> Bool

1615isPrefixOf :: Text -> Text -> Bool

1756−isPrefixOf = coerce JSS.isPrefixOf

1757−-- isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =

1616+isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =

1758−-- alen <= blen && S.isPrefixOf (stream a) (stream b)

1617+ alen <= blen && S.isPrefixOf (stream a) (stream b)

1759{-# INLINE [1] isPrefixOf #-}

1618{-# INLINE [1] isPrefixOf #-}

1760

1619

1761{-# RULES

1620{-# RULES

1762"TEXT isPrefixOf -> fused" [~1] forall s t.

1621"TEXT isPrefixOf -> fused" [~1] forall s t.

1763 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)

1622 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)

1764−"JSSTRING isPrefixOf -> unfused" [1] forall x y.

1765− S.isPrefixOf (stream x) (stream y) = isPrefixOf x y

1766 #-}

1623 #-}

1767

1624

1768-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns

1625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns

1769-- 'True' iff the first is a suffix of the second.

1626-- 'True' iff the first is a suffix of the second.

1770isSuffixOf :: Text -> Text -> Bool

1627isSuffixOf :: Text -> Text -> Bool

1771−isSuffixOf = coerce JSS.isSuffixOf

1772−-- isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =

1628+isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =

1773−-- d >= 0 && a == b'

1629+ d >= 0 && a == b'

1774−-- where d = blen - alen

1630+ where d = blen - alen

1775−-- b' | d == 0 = b

1631+ b' | d == 0 = b

1776−-- | otherwise = Text barr (boff+d) alen

1632+ | otherwise = Text barr (boff+d) alen

1777{-# INLINE isSuffixOf #-}

1633{-# INLINE isSuffixOf #-}

1778

1634

1779-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns

1635-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns

@@ -1783,11 +1639,10 @@ isSuffixOf = coerce JSS.isSuffixOf

1783-- In (unlikely) bad cases, this function's time complexity degrades

1639-- In (unlikely) bad cases, this function's time complexity degrades

1784-- towards /O(n*m)/.

1640-- towards /O(n*m)/.

1785isInfixOf :: Text -> Text -> Bool

1641isInfixOf :: Text -> Text -> Bool

1786−isInfixOf = coerce JSS.isInfixOf

1787−-- isInfixOf needle haystack

1642+isInfixOf needle haystack

1788−-- | null needle = True

1643+ | null needle = True

1789−-- | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack

1644+ | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack

1790−-- | otherwise = not . L.null . indices needle $ haystack

1645+ | otherwise = not . L.null . indices needle $ haystack

1791{-# INLINE [1] isInfixOf #-}

1646{-# INLINE [1] isInfixOf #-}

1792

1647

1793{-# RULES

1648{-# RULES

@@ -1817,10 +1672,9 @@ isInfixOf = coerce JSS.isInfixOf

1817-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf

1672-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf

1818-- > fnordLength _ = -1

1673-- > fnordLength _ = -1

1819stripPrefix :: Text -> Text -> Maybe Text

1674stripPrefix :: Text -> Text -> Maybe Text

1820−stripPrefix = coerce JSS.stripPrefix

1821−-- stripPrefix p@(Text _arr _off plen) t@(Text arr off len)

1675+stripPrefix p@(Text _arr _off plen) t@(Text arr off len)

1822−-- | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)

1676+ | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)

1823−-- | otherwise = Nothing

1677+ | otherwise = Nothing

1824

1678

1825-- | /O(n)/ Find the longest non-empty common prefix of two strings

1679-- | /O(n)/ Find the longest non-empty common prefix of two strings

1826-- and return it, along with the suffixes of each string at which they

1680-- and return it, along with the suffixes of each string at which they

@@ -1835,16 +1689,15 @@ stripPrefix = coerce JSS.stripPrefix

1835-- > commonPrefixes "veeble" "fetzer" == Nothing

1689-- > commonPrefixes "veeble" "fetzer" == Nothing

1836-- > commonPrefixes "" "baz" == Nothing

1690-- > commonPrefixes "" "baz" == Nothing

1837commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)

1691commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)

1838−commonPrefixes = coerce JSS.commonPrefixes

1839−-- commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

1692+commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

1840−-- where

1693+ where

1841−-- go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)

1694+ go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)

1842−-- | i > 0 = Just (Text arr0 off0 i,

1695+ | i > 0 = Just (Text arr0 off0 i,

1843−-- text arr0 (off0+i) (len0-i),

1696+ text arr0 (off0+i) (len0-i),

1844−-- text arr1 (off1+j) (len1-j))

1697+ text arr1 (off1+j) (len1-j))

1845−-- | otherwise = Nothing

1698+ | otherwise = Nothing

1846−-- where Iter a d0 = iter t0 i

1699+ where Iter a d0 = iter t0 i

1847−-- Iter b d1 = iter t1 j

1700+ Iter b d1 = iter t1 j

1848

1701

1849-- | /O(n)/ Return the prefix of the second string if its suffix

1702-- | /O(n)/ Return the prefix of the second string if its suffix

1850-- matches the entire first string.

1703-- matches the entire first string.

@@ -1865,22 +1718,21 @@ commonPrefixes = coerce JSS.commonPrefixes

1865-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre

1718-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre

1866-- > quuxLength _ = -1

1719-- > quuxLength _ = -1

1867stripSuffix :: Text -> Text -> Maybe Text

1720stripSuffix :: Text -> Text -> Maybe Text

1868−stripSuffix = coerce JSS.stripSuffix

1869−-- stripSuffix p@(Text _arr _off plen) t@(Text arr off len)

1721+stripSuffix p@(Text _arr _off plen) t@(Text arr off len)

1870−-- | p `isSuffixOf` t = Just $! text arr off (len-plen)

1722+ | p `isSuffixOf` t = Just $! text arr off (len-plen)

1871−-- | otherwise = Nothing

1723+ | otherwise = Nothing

1872−

1724+

1873−-- -- | Add a list of non-negative numbers. Errors out on overflow.

1725+-- | Add a list of non-negative numbers. Errors out on overflow.

1874−-- sumP :: String -> [Int] -> Int

1726+sumP :: String -> [Int] -> Int

1875−-- sumP fun = go 0

1727+sumP fun = go 0

1876−-- where go !a (x:xs)

1728+ where go !a (x:xs)

1877−-- | ax >= 0 = go ax xs

1729+ | ax >= 0 = go ax xs

1878−-- | otherwise = overflowError fun

1730+ | otherwise = overflowError fun

1879−-- where ax = a + x

1731+ where ax = a + x

1880−-- go a _ = a

1732+ go a _ = a

1881−

1733+

1882−-- emptyError :: String -> a

1734+emptyError :: String -> a

1883−-- emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"

1735+emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"

1884

1736

1885overflowError :: String -> a

1737overflowError :: String -> a

1886overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"

1738overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"

@@ -1894,12 +1746,10 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"

1894-- copy \"breaks the link\" to the original array, allowing it to be

1746-- copy \"breaks the link\" to the original array, allowing it to be

1895-- garbage collected if there are no other live references to it.

1747-- garbage collected if there are no other live references to it.

1896copy :: Text -> Text

1748copy :: Text -> Text

1897−copy = P.id -- TODO

1898−-- copy (Text arr off len) = Text (A.run go) 0 len

1749+copy (Text arr off len) = Text (A.run go) 0 len

1899−-- where

1750+ where

1900−-- go :: ST s (A.MArray s)

1751+ go :: ST s (A.MArray s)

1901−-- go = do

1752+ go = do

1902−-- marr <- A.new len

1753+ marr <- A.new len

1903−

1754+ A.copyI marr 0 arr off len

1904−foreign import javascript unsafe

1755+ return marr

1905− "h$jsstringReplicateChar" js_replicateChar :: Int -> Char -> JSString

Data/Text/Encoding.hs+20−49

@@ -3,7 +3,6 @@

3#if __GLASGOW_HASKELL__ >= 702

4{-# LANGUAGE Trustworthy #-}

5#endif

6−{-# LANGUAGE UnboxedTuples #-}

7-- |

6-- |

8-- Module : Data.Text.Encoding

7-- Module : Data.Text.Encoding

@@ -77,7 +76,7 @@ import Data.Text.Internal (Text(..), safe, text)

77import Data.Text.Internal.Private (runText)

76import Data.Text.Internal.Private (runText)

78import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)

77import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)

79import Data.Text.Internal.Unsafe.Shift (shiftR)

78import Data.Text.Internal.Unsafe.Shift (shiftR)

80−-- import Data.Text.Show ()

79+import Data.Text.Show ()

81import Data.Text.Unsafe (unsafeDupablePerformIO)

80import Data.Text.Unsafe (unsafeDupablePerformIO)

82import Data.Word (Word8, Word32)

81import Data.Word (Word8, Word32)

83import Foreign.C.Types (CSize(..))

82import Foreign.C.Types (CSize(..))

@@ -95,24 +94,7 @@ import qualified Data.Text.Internal.Encoding.Fusion as E

95import qualified Data.Text.Internal.Encoding.Utf16 as U16

94import qualified Data.Text.Internal.Encoding.Utf16 as U16

96import qualified Data.Text.Internal.Fusion as F

95import qualified Data.Text.Internal.Fusion as F

98−import GHC.Exts (ByteArray#, Int(..), Int#, Any, Addr#, Ptr(..))

99−{-

100#include "text_cbits.h"

97#include "text_cbits.h"

101−-}

102−

103−import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)

104−import Data.ByteString (ByteString)

105−import Data.Text.Internal (Text)

106−

107−-------------------------------------

108−import GHC.ForeignPtr

109−import GHCJS.Types

110−import GHCJS.Buffer

111−import Data.JSString (JSString)

112−import Unsafe.Coerce

113−import System.IO.Unsafe

114−-------------------------------------

115−

116

117-- $strict

99-- $strict

118--

100--

@@ -145,10 +127,6 @@ decodeLatin1 (PS fp off len) = text a 0 len

145 c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))

127 c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))

146 return dest

128 return dest

147

129

148−foreign import javascript unsafe "h$textFromString" js_fromString :: JSString -> (# ByteArray#, Int# #)

149−foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8 :: JSString -> Buffer

150−foreign import javascript unsafe "$1['length']" js_length :: JSString -> Int

151−

152-- | Decode a 'ByteString' containing UTF-8 encoded text.

130-- | Decode a 'ByteString' containing UTF-8 encoded text.

153decodeUtf8With :: OnDecodeError -> ByteString -> Text

131decodeUtf8With :: OnDecodeError -> ByteString -> Text

154decodeUtf8With onErr (PS fp off len) = runText $ \done -> do

132decodeUtf8With onErr (PS fp off len) = runText $ \done -> do

@@ -318,8 +296,8 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

318decodeUtf8 :: ByteString -> Text

296decodeUtf8 :: ByteString -> Text

319decodeUtf8 = decodeUtf8With strictDecode

297decodeUtf8 = decodeUtf8With strictDecode

320{-# INLINE[0] decodeUtf8 #-}

298{-# INLINE[0] decodeUtf8 #-}

321−-- {-# RULES "STREAM stream/decodeUtf8 fusion" [1]

299+{-# RULES "STREAM stream/decodeUtf8 fusion" [1]

322−-- forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}

300+ forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}

323

301

324-- | Decode a 'ByteString' containing UTF-8 encoded text.

302-- | Decode a 'ByteString' containing UTF-8 encoded text.

325--

303--

@@ -348,13 +326,9 @@ encodeUtf8BuilderEscaped be =

348 where

326 where

349 bound = max 4 $ BP.sizeBound be

327 bound = max 4 $ BP.sizeBound be

350

328

351− mkBuildstep (Text t) !k =

329+ mkBuildstep (Text arr off len) !k =

352− -- mkBuildstep (Text arr off len) !k =

353 outerLoop off

330 outerLoop off

354 where

331 where

355− off = 0

356− (arr, len) = let (# ba, len' #) = js_fromString t

357− in (A.Array ba, I# len')

358 iend = off + len

332 iend = off + len

359

333

360 outerLoop !i0 !br@(B.BufferRange op0 ope)

334 outerLoop !i0 !br@(B.BufferRange op0 ope)

@@ -394,27 +368,24 @@ encodeUtf8BuilderEscaped be =

394 where

368 where

395 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)

369 poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)

396

370

397−

398−

399-- | Encode text using UTF-8 encoding.

371-- | Encode text using UTF-8 encoding.

400encodeUtf8 :: Text -> ByteString

372encodeUtf8 :: Text -> ByteString

401−encodeUtf8 (Text txt) = toByteString 0 (Just (js_length txt)) $ js_encodeUtf8 txt

373+encodeUtf8 (Text arr off len)

402−-- encodeUtf8 (Text arr off len)

403−-- | len == 0 = B.empty

374+ | len == 0 = B.empty

404−-- | otherwise = unsafeDupablePerformIO $ do

375+ | otherwise = unsafeDupablePerformIO $ do

405−-- fp <- mallocByteString (len*4)

376+ fp <- mallocByteString (len*4)

406−-- withForeignPtr fp $ \ptr ->

377+ withForeignPtr fp $ \ptr ->

407−-- with ptr $ \destPtr -> do

378+ with ptr $ \destPtr -> do

408−-- c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)

379+ c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)

409−-- newDest <- peek destPtr

380+ newDest <- peek destPtr

410−-- let utf8len = newDest `minusPtr` ptr

381+ let utf8len = newDest `minusPtr` ptr

411−-- if utf8len >= len `shiftR` 1

382+ if utf8len >= len `shiftR` 1

412−-- then return (PS fp 0 utf8len)

383+ then return (PS fp 0 utf8len)

413−-- else do

384+ else do

414−-- fp' <- mallocByteString utf8len

385+ fp' <- mallocByteString utf8len

415−-- withForeignPtr fp' $ \ptr' -> do

386+ withForeignPtr fp' $ \ptr' -> do

416−-- memcpy ptr' ptr (fromIntegral utf8len)

387+ memcpy ptr' ptr (fromIntegral utf8len)

417−-- return (PS fp' 0 utf8len)

388+ return (PS fp' 0 utf8len)

418

389

419-- | Decode text from little endian UTF-16 encoding.

390-- | Decode text from little endian UTF-16 encoding.

420decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

Data/Text/IO.hs−16

@@ -185,11 +185,7 @@ hPutStr h t = do

185 | otherwise -> writeBlocksRaw h buf str

186

187hPutChars :: Handle -> Stream Char -> IO ()

188−#ifndef __GHCJS__

189hPutChars h (Stream next0 s0 _len) = loop s0

188hPutChars h (Stream next0 s0 _len) = loop s0

190−#else

191−hPutChars h (Stream next0 s0) = loop s0

192−#endif

193 where

189 where

194 loop !s = case next0 s of

190 loop !s = case next0 s of

195 Done -> return ()

191 Done -> return ()

@@ -207,11 +203,7 @@ hPutChars h (Stream next0 s0) = loop s0

207-- handling gave a few more percent on top.

203-- handling gave a few more percent on top.

208

204

209writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()

205writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()

210−#ifndef __GHCJS__

211writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0

206writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0

212−#else

213−writeLines h nl buf0 (Stream next0 s0) = outer s0 buf0

214−#endif

215 where

207 where

216 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

208 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

217 where

209 where

@@ -231,11 +223,7 @@ writeLines h nl buf0 (Stream next0 s0) = outer s0 buf0

231 commit = commitBuffer h raw len

223 commit = commitBuffer h raw len

232

224

233writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()

225writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()

234−#ifndef __GHCJS__

235writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0

226writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0

236−#else

237−writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0

238−#endif

239 where

227 where

240 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

228 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

241 where

229 where

@@ -251,11 +239,7 @@ writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0

251 commit = commitBuffer h raw len

239 commit = commitBuffer h raw len

252

240

253writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()

241writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()

254−#ifndef __GHCJS__

255writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0

242writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0

256−#else

257−writeBlocksRaw h buf0 (Stream next0 s0) = outer s0 buf0

258−#endif

259 where

243 where

260 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

244 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

261 where

245 where

Data/Text/Internal.hs+125−47

@@ -1,66 +1,127 @@

1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples, MagicHash,

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

2− BangPatterns, ForeignFunctionInterface, JavaScriptFFI, GeneralizedNewtypeDeriving #-}

2+{-# OPTIONS_HADDOCK not-home #-}

3−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes,

4− GHCForeignImportPrim, MagicHash, FlexibleInstances #-}

4+-- |

5+-- Module : Data.Text.Internal

9+--

10+-- License : BSD-style

11+-- Maintainer : bos@serpentine.com

12+-- Stability : experimental

13+-- Portability : GHC

14+--

15+-- A module containing private 'Text' internals. This exposes the

16+-- 'Text' representation and low level construction functions.

17+-- Modules which extend the 'Text' system may need to use this module.

18+--

19+-- You should not use this module unless you are determined to monkey

20+-- with the internals, as the functions here do just about nothing to

21+-- preserve data invariants. You have been warned!

22+

23+#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)

24+#include "MachDeps.h"

25+#endif

26+

5module Data.Text.Internal

27module Data.Text.Internal

6− ( module Data.Text.Internal

28+ (

29+ -- * Types

30+ -- $internals

31+ Text(..)

32+ -- * Construction

33+ , text

34+ , textP

35+ -- * Safety

7− , JSS.safe

36+ , safe

37+ -- * Code that must be here for accessibility

38+ , empty

39+ , empty_

40+ -- * Utilities

8− , JSS.firstf

41+ , firstf

42+ -- * Checked multiplication

43+ , mul

44+ , mul32

45+ , mul64

46+ -- * Debugging

47+ , showText

9− ) where

48+ ) where

10−

11−import Data.String (IsString(..))

12−import Data.Coerce

13−import Data.Data

14−import Data.Maybe

15−import Data.Binary

16−import Control.DeepSeq

17−import Data.Semigroup

18−import Data.Char

19−import qualified Data.JSString as JSS

20−import qualified Data.JSString.Internal as JSSS

21−import qualified Data.JSString.Internal.Type as JSS

22−import Data.JSString hiding (empty)

23−import qualified Data.Text.Array as A

50+#if defined(ASSERTS)

51+import Control.Exception (assert)

52+#endif

25import Data.Bits

53import Data.Bits

26import Data.Int (Int32, Int64)

54import Data.Int (Int32, Int64)

27−-- import Data.Text.Internal.Unsafe.Char (ord)

55+import Data.Text.Internal.Unsafe.Char (ord)

28import Data.Typeable (Typeable)

56import Data.Typeable (Typeable)

29−import GHC.Exts (ByteArray#, Char(..), ord#, andI#, (/=#), isTrue#, (==#), Int(..), Int#, isTrue#)

30−-- import qualified Data.Text.Array as A

57+import qualified Data.Text.Array as A

31−import GHCJS.Marshal.Pure

32−import GHCJS.Marshal

33−import qualified GHC.CString as GHC

59+-- | A space efficient, packed, unboxed Unicode text type.

60+data Text = Text

61+ {-# UNPACK #-} !A.Array -- payload (Word16 elements)

62+ {-# UNPACK #-} !Int -- offset (units of Word16, not Char)

63+ {-# UNPACK #-} !Int -- length (units of Word16, not Char)

64+ deriving (Typeable)

36−newtype Text = Text JSString

66+-- | Smart constructor.

37− deriving ( Show, Eq, Ord, IsString, Monoid, Read, Data

67+text_ :: A.Array -> Int -> Int -> Text

38− , PToJSVal, PFromJSVal, FromJSVal, ToJSVal

68+text_ arr off len =

39− )

69+#if defined(ASSERTS)

70+ let c = A.unsafeIndex arr off

71+ alen = A.length arr

72+ in assert (len >= 0) .

73+ assert (off >= 0) .

74+ assert (alen == 0 || len == 0 || off < alen) .

75+ assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $

76+#endif

77+ Text arr off len

78+{-# INLINE text_ #-}

80+-- | /O(1)/ The empty 'Text'.

41empty :: Text

81empty :: Text

42−empty = Text JSS.empty

82+empty = Text A.empty 0 0

43{-# INLINE [1] empty #-}

83{-# INLINE [1] empty #-}

85+-- | A non-inlined version of 'empty'.

45empty_ :: Text

86empty_ :: Text

46−empty_ = Text JSS.empty

87+empty_ = Text A.empty 0 0

47{-# NOINLINE empty_ #-}

88{-# NOINLINE empty_ #-}

49−foreign import javascript unsafe

50− "String.fromCharCode.apply(null, $1['u8'])"

51− js_decodeBytes :: ByteArray# -> JSString

52−

53−foreign import javascript unsafe

54− "h$textToString"

55− js_textToString :: ByteArray# -> Int# -> Int# -> JSString

56−

57-- | Construct a 'Text' without invisibly pinning its byte array in

90-- | Construct a 'Text' without invisibly pinning its byte array in

58-- memory if its length has dwindled to zero.

91-- memory if its length has dwindled to zero.

59text :: A.Array -> Int -> Int -> Text

92text :: A.Array -> Int -> Int -> Text

60−-- text arr off len | len == 0 = empty

93+text arr off len | len == 0 = empty

61−-- | otherwise = text_ arr off len

94+ | otherwise = text_ arr off len

62−text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty

95+{-# INLINE text #-}

63− | otherwise = Text $ js_textToString ba off# len#

96+

97+textP :: A.Array -> Int -> Int -> Text

98+{-# DEPRECATED textP "Use text instead" #-}

99+textP = text

100+

101+-- | A useful 'show'-like function for debugging purposes.

102+showText :: Text -> String

103+showText (Text arr off len) =

104+ "Text " ++ show (A.toList arr off len) ++ ' ' :

105+ show off ++ ' ' : show len

106+

107+-- | Map a 'Char' to a 'Text'-safe value.

108+--

109+-- UTF-16 surrogate code points are not included in the set of Unicode

110+-- scalar values, but are unfortunately admitted as valid 'Char'

111+-- values by Haskell. They cannot be represented in a 'Text'. This

112+-- function remaps those code points to the Unicode replacement

113+-- character (U+FFFD, \'�\'), and leaves other code points

114+-- unchanged.

115+safe :: Char -> Char

116+safe c

117+ | ord c .&. 0x1ff800 /= 0xd800 = c

118+ | otherwise = '\xfffd'

119+{-# INLINE [0] safe #-}

120+

121+-- | Apply a function to the first element of an optional pair.

122+firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)

123+firstf f (Just (a, b)) = Just (f a, b)

124+firstf _ Nothing = Nothing

125

65-- | Checked multiplication. Calls 'error' if the result would

126-- | Checked multiplication. Calls 'error' if the result would

66-- overflow.

127-- overflow.

@@ -107,4 +168,21 @@ mul32 a b = case fromIntegral a * fromIntegral b of

107{-# INLINE mul32 #-}

168{-# INLINE mul32 #-}

108infixl 7 `mul32`

169infixl 7 `mul32`

109

170

110−--------------------------------------

171+-- $internals

172+--

173+-- Internally, the 'Text' type is represented as an array of 'Word16'

174+-- UTF-16 code units. The offset and length fields in the constructor

175+-- are in these units, /not/ units of 'Char'.

176+--

177+-- Invariants that all functions must maintain:

178+--

179+-- * Since the 'Text' type uses UTF-16 internally, it cannot represent

180+-- characters in the reserved surrogate code point range U+D800 to

181+-- U+DFFF. To maintain this invariant, the 'safe' function maps

182+-- 'Char' values in this range to the replacement character (U+FFFD,

183+-- \'�\').

184+--

185+-- * A leading (or \"high\") surrogate code unit (0xD800–0xDBFF) must

186+-- always be followed by a trailing (or \"low\") surrogate code unit

187+-- (0xDC00-0xDFFF). A trailing surrogate code unit must always be

188+-- preceded by a leading surrogate code unit.

Data/Text/Internal/Builder.hs+5−47

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

1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}

2−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, UnboxedTuples,

3− MagicHash #-}

4{-# OPTIONS_HADDOCK not-home #-}

2{-# OPTIONS_HADDOCK not-home #-}

6-----------------------------------------------------------------------------

4-----------------------------------------------------------------------------

@@ -75,8 +73,6 @@ import qualified Data.Text as S

75import qualified Data.Text.Array as A

73import qualified Data.Text.Array as A

76import qualified Data.Text.Lazy as L

74import qualified Data.Text.Lazy as L

78−import Data.JSString (JSString)

79−import GHC.Exts (ByteArray#, Int#, Int(I#))

80------------------------------------------------------------------------

76------------------------------------------------------------------------

82-- | A @Builder@ is an efficient way to build lazy @Text@ values.

78-- | A @Builder@ is an efficient way to build lazy @Text@ values.

@@ -168,17 +164,10 @@ copyLimit = 128

168-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@

164-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@

169--

165--

170fromText :: S.Text -> Builder

166fromText :: S.Text -> Builder

171−fromText t@(Text t')

167+fromText t@(Text arr off l)

172 | S.null t = empty

168 | S.null t = empty

173 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

169 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

174 | otherwise = flush `append` mapBuilder (t :)

170 | otherwise = flush `append` mapBuilder (t :)

175− where

176− (# ba, len #) = js_fromString t'

177− (arr, off, l) = (A.Array ba, 0, I# len)

178−-- fromText t@(Text arr off l)

179−-- | S.null t = empty

180−-- | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

181−-- | otherwise = flush `append` mapBuilder (t :)

182{-# INLINE [1] fromText #-}

171{-# INLINE [1] fromText #-}

183

172

184{-# RULES

173{-# RULES

@@ -193,10 +182,10 @@ fromText t@(Text t')

193fromString :: String -> Builder

182fromString :: String -> Builder

194fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

183fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

195 let loop !marr !o !u !l [] = k (Buffer marr o u l)

184 let loop !marr !o !u !l [] = k (Buffer marr o u l)

196− loop marr o@(I# o#) u@(I# u#) l s@(c:cs)

185+ loop marr o u l s@(c:cs)

197 | l <= 1 = do

186 | l <= 1 = do

198 arr <- A.unsafeFreeze marr

187 arr <- A.unsafeFreeze marr

199− let !t = Text $ js_toString (A.aBA arr) o# u#

188+ let !t = Text arr o u

200 marr' <- A.new chunkSize

189 marr' <- A.new chunkSize

201 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

190 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

202 return $ t : ts

191 return $ t : ts

@@ -206,21 +195,6 @@ fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

206 in loop p0 o0 u0 l0 str

195 in loop p0 o0 u0 l0 str

207 where

196 where

208 chunkSize = smallChunkSize

197 chunkSize = smallChunkSize

209−-- fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

210−-- let loop !marr !o !u !l [] = k (Buffer marr o u l)

211−-- loop marr o u l s@(c:cs)

212−-- | l <= 1 = do

213−-- arr <- A.unsafeFreeze marr

214−-- let !t = Text arr o u

215−-- marr' <- A.new chunkSize

216−-- ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

217−-- return $ t : ts

218−-- | otherwise = do

219−-- n <- unsafeWrite marr (o+u) c

220−-- loop marr o (u+n) (l-n) cs

221−-- in loop p0 o0 u0 l0 str

222−-- where

223−-- chunkSize = smallChunkSize

224{-# INLINE fromString #-}

198{-# INLINE fromString #-}

225

199

226-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying

200-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying

@@ -260,24 +234,16 @@ toLazyTextWith chunkSize m = L.fromChunks (runST $

260-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,

234-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,

261-- yielding a new chunk in the result lazy @Text@.

235-- yielding a new chunk in the result lazy @Text@.

262flush :: Builder

236flush :: Builder

263−flush = Builder $ \ k buf@(Buffer p o@(I# o#) u@(I# u#) l) ->

237+flush = Builder $ \ k buf@(Buffer p o u l) ->

264 if u == 0

238 if u == 0

265 then k buf

239 then k buf

266 else do arr <- A.unsafeFreeze p

240 else do arr <- A.unsafeFreeze p

267 let !b = Buffer p (o+u) 0 l

241 let !b = Buffer p (o+u) 0 l

268− !t = Text $ js_toString (A.aBA arr) o# u#

242+ !t = Text arr o u

269 ts <- inlineInterleaveST (k b)

243 ts <- inlineInterleaveST (k b)

270 return $! t : ts

244 return $! t : ts

271{-# INLINE [1] flush #-}

245{-# INLINE [1] flush #-}

272-- defer inlining so that flush/flush rule may fire.

246-- defer inlining so that flush/flush rule may fire.

273−-- flush = Builder $ \ k buf@(Buffer p o u l) ->

274−-- if u == 0

275−-- then k buf

276−-- else do arr <- A.unsafeFreeze p

277−-- let !b = Buffer p (o+u) 0 l

278−-- !t = Text arr o u

279−-- ts <- inlineInterleaveST (k b)

280−-- return $! t : ts

281

247

282------------------------------------------------------------------------

248------------------------------------------------------------------------

283

249

@@ -361,11 +327,3 @@ append' (Builder f) (Builder g) = Builder (f . g)

361 append flush flush = flush

327 append flush flush = flush

362

328

363 #-}

329 #-}

364−

365−foreign import javascript unsafe

366− "h$textFromString"

367− js_fromString :: JSString -> (# ByteArray#, Int# #)

368−

369−foreign import javascript unsafe

370− "h$textToString"

371− js_toString :: ByteArray# -> Int# -> Int# -> JSString

Data/Text/Internal/Encoding/Fusion.hs+8−10

@@ -55,7 +55,7 @@ import qualified Data.Text.Internal.Encoding.Utf32 as U32

55import Data.Text.Unsafe (unsafeDupablePerformIO)

57streamASCII :: ByteString -> Stream Char

58−streamASCII bs = Stream next 0 -- (maxSize l)

58+streamASCII bs = Stream next 0 (maxSize l)

59 where

60 l = B.length bs

61 {-# INLINE next #-}

@@ -70,7 +70,7 @@ streamASCII bs = Stream next 0 -- (maxSize l)

70-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8

71-- encoding.

72streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

73−streamUtf8 onErr bs = Stream next 0 -- (maxSize l)

73+streamUtf8 onErr bs = Stream next 0 (maxSize l)

74 where

75 l = B.length bs

76 next i

@@ -91,7 +91,7 @@ streamUtf8 onErr bs = Stream next 0 -- (maxSize l)

91-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

92-- endian UTF-16 encoding.

93streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char

94−streamUtf16LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))

94+streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))

95 where

96 l = B.length bs

97 {-# INLINE next #-}

@@ -109,7 +109,7 @@ streamUtf16LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))

109-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

110-- endian UTF-16 encoding.

111streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char

112−streamUtf16BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))

112+streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))

113 where

114 l = B.length bs

115 {-# INLINE next #-}

@@ -127,7 +127,7 @@ streamUtf16BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))

127-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

128-- endian UTF-32 encoding.

129streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char

130−streamUtf32BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))

130+streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))

131 where

132 l = B.length bs

133 {-# INLINE next #-}

@@ -147,7 +147,7 @@ streamUtf32BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))

147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

148-- endian UTF-32 encoding.

149streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char

150−streamUtf32LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))

150+streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))

151 where

152 l = B.length bs

153 {-# INLINE next #-}

@@ -166,10 +166,8 @@ streamUtf32LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))

166

167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.

168unstream :: Stream Word8 -> ByteString

169−-- unstream (Stream next s0 len) = unsafeDupablePerformIO $ do

169+unstream (Stream next s0 len) = unsafeDupablePerformIO $ do

170−unstream (Stream next s0) = unsafeDupablePerformIO $ do

171− -- let mlen = upperBound 4 len

170+ let mlen = upperBound 4 len

172− let mlen = 4

173 mallocByteString mlen >>= loop mlen 0 s0

171 mallocByteString mlen >>= loop mlen 0 s0

174 where

172 where

175 loop !n !off !s fp = case next s of

173 loop !n !off !s fp = case next s of

Data/Text/Internal/Encoding/Fusion/Common.hs+4−8

@@ -37,8 +37,7 @@ import Data.Text.Internal.Unsafe.Shift (shiftR)

37import Data.Word (Word8)

39restreamUtf16BE :: Stream Char -> Stream Word8

40−-- restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

40+restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

41−restreamUtf16BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)

42 where

41 where

43 next (RS0 s) = case next0 s of

42 next (RS0 s) = case next0 s of

44 Done -> Done

43 Done -> Done

@@ -62,8 +61,7 @@ restreamUtf16BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)

62{-# INLINE restreamUtf16BE #-}

61{-# INLINE restreamUtf16BE #-}

64restreamUtf16LE :: Stream Char -> Stream Word8

63restreamUtf16LE :: Stream Char -> Stream Word8

65−-- restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

64+restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

66−restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)

67 where

65 where

68 next (RS0 s) = case next0 s of

66 next (RS0 s) = case next0 s of

69 Done -> Done

67 Done -> Done

@@ -87,8 +85,7 @@ restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)

87{-# INLINE restreamUtf16LE #-}

85{-# INLINE restreamUtf16LE #-}

89restreamUtf32BE :: Stream Char -> Stream Word8

87restreamUtf32BE :: Stream Char -> Stream Word8

90−restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)

88+restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

91−-- restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

92 where

89 where

93 next (RS0 s) = case next0 s of

90 next (RS0 s) = case next0 s of

94 Done -> Done

91 Done -> Done

@@ -107,8 +104,7 @@ restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)

107{-# INLINE restreamUtf32BE #-}

104{-# INLINE restreamUtf32BE #-}

108

105

109restreamUtf32LE :: Stream Char -> Stream Word8

106restreamUtf32LE :: Stream Char -> Stream Word8

110−restreamUtf32LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)

107+restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

111−-- restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

112 where

108 where

113 next (RS0 s) = case next0 s of

109 next (RS0 s) = case next0 s of

114 Done -> Done

110 Done -> Done

Data/Text/Internal/Fusion.hs+166−40

@@ -28,91 +28,217 @@ module Data.Text.Internal.Fusion

28 , unstream

29 , reverseStream

31− , Data.Text.Internal.Fusion.length

31+ , length

33 -- * Transformations

34− , Data.Text.Internal.Fusion.reverse

34+ , reverse

36 -- * Construction

37 -- ** Scans

38 , reverseScanr

40 -- ** Accumulating maps

41− , Data.Text.Internal.Fusion.mapAccumL

41+ , mapAccumL

43 -- ** Generation and unfolding

44 , unfoldrN

46 -- * Indexing

47− , Data.Text.Internal.Fusion.index

47+ , index

48− , Data.Text.Internal.Fusion.findIndex

48+ , findIndex

49 , countChar

50 ) where

52−import GHC.Exts (Char(..), Int(..), chr#, Int#, isTrue#, (-#), (+#), (>=#))

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

53−

53+ Num(..), Ord(..), ($), (&&),

54−import Prelude hiding (length, reverse)

54+ fromIntegral, otherwise)

55−import Data.Char

55+import Data.Bits ((.&.))

56−

57−import Data.JSString.Internal.Type (JSString(..))

56+import Data.Text.Internal (Text(..))

58−import qualified Data.JSString.Internal.Type as I

57+import Data.Text.Internal.Private (runText)

58+import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)

59−import Data.JSString.Internal.Fusion.Types

59+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)

60+import qualified Data.Text.Array as A

60−import qualified Data.JSString.Internal.Fusion.Common as S

61+import qualified Data.Text.Internal.Fusion.Common as S

61−

62+import Data.Text.Internal.Fusion.Types

62−import System.IO.Unsafe

63−

64−import GHCJS.Prim

65−

66−import Data.Coerce

67−import Data.Text.Internal

63+import Data.Text.Internal.Fusion.Size

68−import qualified Data.JSString.Internal.Fusion as JSS

64+import qualified Data.Text.Internal as I

69−import Data.JSString.Internal.Fusion.Types (Stream(..))

65+import qualified Data.Text.Internal.Encoding.Utf16 as U16

71default(Int)

67default(Int)

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

73stream :: Text -> Stream Char

70stream :: Text -> Stream Char

74−stream = coerce JSS.stream

71+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)

72+ where

73+ !end = off+len

74+ next !i

75+ | i >= end = Done

76+ | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)

77+ | otherwise = Yield (unsafeChr n) (i + 1)

78+ where

79+ n = A.unsafeIndex arr i

80+ n2 = A.unsafeIndex arr (i + 1)

75{-# INLINE [0] stream #-}

81{-# INLINE [0] stream #-}

83+-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate

84+-- backwards.

77reverseStream :: Text -> Stream Char

85reverseStream :: Text -> Stream Char

78−reverseStream = coerce JSS.reverseStream

86+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)

87+ where

88+ {-# INLINE next #-}

89+ next !i

90+ | i < off = Done

91+ | n >= 0xDC00 && n <= 0xDFFF = Yield (U16.chr2 n2 n) (i - 2)

92+ | otherwise = Yield (unsafeChr n) (i - 1)

93+ where

94+ n = A.unsafeIndex arr i

95+ n2 = A.unsafeIndex arr (i - 1)

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

96{-# INLINE [0] reverseStream #-}

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

81unstream :: Stream Char -> Text

99unstream :: Stream Char -> Text

82−unstream = coerce JSS.unstream

100+unstream (Stream next0 s0 len) = runText $ \done -> do

101+ -- Before encoding each char we perform a buffer realloc check assuming

102+ -- worst case encoding size of two 16-bit units for the char. Just add an

103+ -- extra space to the buffer so that we do not end up reallocating even when

104+ -- all the chars are encoded as single unit.

105+ let mlen = upperBound 4 len + 1

106+ arr0 <- A.new mlen

107+ let outer !arr !maxi = encode

108+ where

109+ -- keep the common case loop as small as possible

110+ encode !si !di =

111+ case next0 si of

112+ Done -> done arr di

113+ Skip si' -> encode si' di

114+ Yield c si'

115+ -- simply check for the worst case

116+ | maxi < di + 1 -> realloc si di

117+ | otherwise -> do

118+ n <- unsafeWrite arr di c

119+ encode si' (di + n)

120+

121+ -- keep uncommon case separate from the common case code

122+ {-# NOINLINE realloc #-}

123+ realloc !si !di = do

124+ let newlen = (maxi + 1) * 2

125+ arr' <- A.new newlen

126+ A.copyM arr' 0 arr 0 di

127+ outer arr' (newlen - 1) si di

128+

129+ outer arr0 (mlen - 1) s0 0

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

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

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

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

132

133+

134+-- ----------------------------------------------------------------------------

135+-- * Basic stream functions

136+

86length :: Stream Char -> Int

137length :: Stream Char -> Int

87−length = JSS.length

138+length = S.lengthI

88−{-# INLINE [0] length #-}

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

140

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

90reverse :: Stream Char -> Text

142reverse :: Stream Char -> Text

91−reverse = coerce JSS.reverse

143+reverse (Stream next s len0)

144+ | isEmpty len0 = I.empty

145+ | otherwise = I.text arr off' len'

146+ where

147+ len0' = upperBound 4 (larger len0 4)

148+ (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')

149+ loop !s0 !i !len marr =

150+ case next s0 of

151+ Done -> return (marr, (j, len-j))

152+ where j = i + 1

153+ Skip s1 -> loop s1 i len marr

154+ Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do

155+ let newLen = len `shiftL` 1

156+ marr' <- A.new newLen

157+ A.copyM marr' (newLen-len) marr 0 len

158+ write s1 (len+i) newLen marr'

159+ | otherwise -> write s1 i len marr

160+ where n = ord x

161+ least | n < 0x10000 = 0

162+ | otherwise = 1

163+ m = n - 0x10000

164+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800

165+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00

166+ write t j l mar

167+ | n < 0x10000 = do

168+ A.unsafeWrite mar j (fromIntegral n)

169+ loop t (j-1) l mar

170+ | otherwise = do

171+ A.unsafeWrite mar (j-1) lo

172+ A.unsafeWrite mar j hi

173+ loop t (j-2) l mar

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

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

175

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

177+-- the input and result reversed.

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

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

95−reverseScanr = JSS.reverseScanr

179+reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

180+ where

181+ {-# INLINE next #-}

182+ next (Scan1 z s) = Yield z (Scan2 z s)

183+ next (Scan2 z s) = case next0 s of

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

185+ in Yield x' (Scan2 x' s')

186+ Skip s' -> Skip (Scan2 z s')

187+ Done -> Done

96{-# INLINE reverseScanr #-}

188{-# INLINE reverseScanr #-}

189

98−mapAccumL :: (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)

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

99−mapAccumL f z0 st =

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

100− let (a, t) = JSS.mapAccumL f z0 st

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

101− in (a, Text t)

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

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

103−

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

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

105−unfoldrN = JSS.unfoldrN

195+unfoldrN n = S.unfoldrNI n

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

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

107

197

198+-------------------------------------------------------------------------------

199+-- ** Indexing streams

200+

201+-- | /O(n)/ stream index (subscript) operator, starting from 0.

108index :: Stream Char -> Int -> Char

202index :: Stream Char -> Int -> Char

109−index = JSS.index

203+index = S.indexI

110{-# INLINE [0] index #-}

204{-# INLINE [0] index #-}

111

205

206+-- | The 'findIndex' function takes a predicate and a stream and

207+-- returns the index of the first element in the stream

208+-- satisfying the predicate.

112findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int

209findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int

113−findIndex = JSS.findIndex

210+findIndex = S.findIndexI

114{-# INLINE [0] findIndex #-}

211{-# INLINE [0] findIndex #-}

115

212

213+-- | /O(n)/ The 'count' function returns the number of times the query

214+-- element appears in the given stream.

116countChar :: Char -> Stream Char -> Int

215countChar :: Char -> Stream Char -> Int

117−countChar = JSS.countChar

216+countChar = S.countCharI

118{-# INLINE [0] countChar #-}

217{-# INLINE [0] countChar #-}

218+

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

220+-- function to each element of a 'Text', passing an accumulating

221+-- parameter from left to right, and returns a final 'Text'.

222+mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)

223+mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)

224+ where

225+ (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)

226+ where mlen = upperBound 4 len

227+ outer arr top = loop

228+ where

229+ loop !z !s !i =

230+ case next0 s of

231+ Done -> return (arr, (z,i))

232+ Skip s' -> loop z s' i

233+ Yield x s'

234+ | j >= top -> {-# SCC "mapAccumL/resize" #-} do

235+ let top' = (top + 1) `shiftL` 1

236+ arr' <- A.new top'

237+ A.copyM arr' 0 arr 0 top

238+ outer arr' top' z s i

239+ | otherwise -> do d <- unsafeWrite arr i c

240+ loop z' s' (i+d)

241+ where (z',c) = f z x

242+ j | ord c < 0x10000 = i

243+ | otherwise = i + 1

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

Data/Text/Internal/Fusion/Common.hs+922−968

@@ -14,971 +14,925 @@

14--

15-- Common stream fusion functionality for text.

17−module Data.Text.Internal.Fusion.Common (module Data.JSString.Internal.Fusion.Common) where

17+module Data.Text.Internal.Fusion.Common

18−import Data.JSString.Internal.Fusion.Common

18+ (

19−-- module Data.Text.Internal.Fusion.Common

19+ -- * Creation and elimination

20−-- (

20+ singleton

21−-- -- * Creation and elimination

21+ , streamList

22−-- singleton

22+ , unstreamList

23−-- , streamList

23+ , streamCString#

24−-- , unstreamList

24+

25−-- , streamCString#

25+ -- * Basic interface

26−

26+ , cons

27−-- -- * Basic interface

27+ , snoc

28−-- , cons

28+ , append

29−-- , snoc

29+ , head

30−-- , append

30+ , uncons

31−-- , head

31+ , last

32−-- , uncons

32+ , tail

33−-- , last

33+ , init

34−-- , tail

34+ , null

35−-- , init

35+ , lengthI

36−-- , null

36+ , compareLengthI

37−-- , lengthI

37+ , isSingleton

38−-- , compareLengthI

38+

39−-- , isSingleton

39+ -- * Transformations

40−

40+ , map

41−-- -- * Transformations

41+ , intercalate

42−-- , map

42+ , intersperse

43−-- , intercalate

43+

44−-- , intersperse

44+ -- ** Case conversion

45−

45+ -- $case

46−-- -- ** Case conversion

46+ , toCaseFold

47−-- -- $case

47+ , toLower

48−-- , toCaseFold

48+ , toTitle

49−-- , toLower

49+ , toUpper

50−-- , toTitle

50+

51−-- , toUpper

51+ -- ** Justification

52−

52+ , justifyLeftI

53−-- -- ** Justification

53+

54−-- , justifyLeftI

54+ -- * Folds

55−

55+ , foldl

56−-- -- * Folds

56+ , foldl'

57−-- , foldl

57+ , foldl1

58−-- , foldl'

58+ , foldl1'

59−-- , foldl1

59+ , foldr

60−-- , foldl1'

60+ , foldr1

61−-- , foldr

61+

62−-- , foldr1

62+ -- ** Special folds

63−

63+ , concat

64−-- -- ** Special folds

64+ , concatMap

65−-- , concat

65+ , any

66−-- , concatMap

66+ , all

67−-- , any

67+ , maximum

68−-- , all

68+ , minimum

69−-- , maximum

69+

70−-- , minimum

70+ -- * Construction

71−

71+ -- ** Scans

72−-- -- * Construction

72+ , scanl

73−-- -- ** Scans

73+

74−-- , scanl

74+ -- ** Generation and unfolding

75−

75+ , replicateCharI

76−-- -- ** Generation and unfolding

76+ , replicateI

77−-- , replicateCharI

77+ , unfoldr

78−-- , replicateI

78+ , unfoldrNI

79−-- , unfoldr

79+

80−-- , unfoldrNI

80+ -- * Substrings

81−

81+ -- ** Breaking strings

82−-- -- * Substrings

82+ , take

83−-- -- ** Breaking strings

83+ , drop

84−-- , take

84+ , takeWhile

85−-- , drop

85+ , dropWhile

86−-- , takeWhile

86+

87−-- , dropWhile

87+ -- * Predicates

88−

88+ , isPrefixOf

89−-- -- * Predicates

89+

90−-- , isPrefixOf

90+ -- * Searching

91−

91+ , elem

92−-- -- * Searching

92+ , filter

93−-- , elem

93+

94−-- , filter

94+ -- * Indexing

95−

95+ , findBy

96−-- -- * Indexing

96+ , indexI

97−-- , findBy

97+ , findIndexI

98−-- , indexI

98+ , countCharI

99−-- , findIndexI

99+

100−-- , countCharI

100+ -- * Zipping and unzipping

101−

101+ , zipWith

102−-- -- * Zipping and unzipping

102+ ) where

103−-- , zipWith

103+

104−-- ) where

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

105−

105+ Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),

106−-- import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

106+ (&&), fromIntegral, otherwise)

107−-- Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),

107+import qualified Data.List as L

108−-- (&&), fromIntegral, otherwise)

108+import qualified Prelude as P

109−-- import qualified Data.List as L

109+import Data.Bits (shiftL)

110−-- import qualified Prelude as P

110+import Data.Char (isLetter)

111−-- import Data.Bits (shiftL)

111+import Data.Int (Int64)

112−-- import Data.Char (isLetter)

112+import Data.Text.Internal.Fusion.Types

113−-- import Data.Int (Int64)

113+import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,

114−-- import Data.Text.Internal.Fusion.Types

114+ upperMapping)

115−-- import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,

115+import Data.Text.Internal.Fusion.Size

116−-- upperMapping)

116+import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)

117−-- import Data.Text.Internal.Fusion.Size

117+import GHC.Types (Char(..), Int(..))

118−-- import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)

118+

119−-- import GHC.Types (Char(..), Int(..))

119+singleton :: Char -> Stream Char

120−

120+singleton c = Stream next False 1

121−-- singleton :: Char -> Stream Char

121+ where next False = Yield c True

122−-- singleton c = Stream next False -- 1

122+ next True = Done

123−-- where next False = Yield c True

123+{-# INLINE [0] singleton #-}

124−-- next True = Done

124+

125−-- {-# INLINE [0] singleton #-}

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

126−

126+{-# INLINE [0] streamList #-}

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

127+streamList s = Stream next s unknownSize

128−-- {-# INLINE [0] streamList #-}

128+ where next [] = Done

129−-- streamList s = Stream next s -- unknownSize

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

130−-- where next [] = Done

130+

131−-- next (x:xs) = Yield x xs

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

132−

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

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

133+ where unfold !s = case next s of

134−-- -- unstreamList (Stream next s0 _len) = unfold s0

134+ Done -> []

135−-- unstreamList (Stream next s0) = unfold s0

135+ Skip s' -> unfold s'

136−-- where unfold !s = case next s of

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

137−-- Done -> []

137+{-# INLINE [0] unstreamList #-}

138−-- Skip s' -> unfold s'

138+

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

139+{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

140−-- {-# INLINE [0] unstreamList #-}

140+

141−

141+-- | Stream the UTF-8-like packed encoding used by GHC to represent

142−-- {-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

142+-- constant strings in generated code.

143−

143+--

144−-- -- | Stream the UTF-8-like packed encoding used by GHC to represent

144+-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,

145−-- -- constant strings in generated code.

145+-- and the string is NUL-terminated.

146−-- --

146+streamCString# :: Addr# -> Stream Char

147−-- -- This encoding uses the byte sequence "\xc0\x80" to represent NUL,

147+streamCString# addr = Stream step 0 unknownSize

148−-- -- and the string is NUL-terminated.

148+ where

149−-- streamCString# :: Addr# -> Stream Char

149+ step !i

150−-- streamCString# addr = Stream step 0 -- unknownSize

150+ | b == 0 = Done

151−-- where

151+ | b <= 0x7f = Yield (C# b#) (i+1)

152−-- step !i

152+ | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1

153−-- | b == 0 = Done

153+ in Yield c (i+2)

154−-- | b <= 0x7f = Yield (C# b#) (i+1)

154+ | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +

155−-- | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1

155+ (next 1 `shiftL` 6) +

156−-- in Yield c (i+2)

156+ next 2

157−-- | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +

157+ in Yield c (i+3)

158−-- (next 1 `shiftL` 6) +

158+ | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +

159−-- next 2

159+ (next 1 `shiftL` 12) +

160−-- in Yield c (i+3)

160+ (next 2 `shiftL` 6) +

161−-- | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +

161+ next 3

162−-- (next 1 `shiftL` 12) +

162+ in Yield c (i+4)

163−-- (next 2 `shiftL` 6) +

163+ where b = I# (ord# b#)

164−-- next 3

164+ next n = I# (ord# (at# (i+n))) - 0x80

165−-- in Yield c (i+4)

165+ !b# = at# i

166−-- where b = I# (ord# b#)

166+ at# (I# i#) = indexCharOffAddr# addr i#

167−-- next n = I# (ord# (at# (i+n))) - 0x80

167+ chr (I# i#) = C# (chr# i#)

168−-- !b# = at# i

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

169−-- at# (I# i#) = indexCharOffAddr# addr i#

169+

170−-- chr (I# i#) = C# (chr# i#)

170+-- ----------------------------------------------------------------------------

171−-- {-# INLINE [0] streamCString# #-}

171+-- * Basic stream functions

172−

172+

173−-- -- ----------------------------------------------------------------------------

173+data C s = C0 !s

174−-- -- * Basic stream functions

174+ | C1 !s

175−

175+

176−-- data C s = C0 !s

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

177−-- | C1 !s

177+cons :: Char -> Stream Char -> Stream Char

178−

178+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

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

179+ where

180−-- cons :: Char -> Stream Char -> Stream Char

180+ next (C1 s) = Yield w (C0 s)

181−-- -- cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

181+ next (C0 s) = case next0 s of

182−-- cons !w (Stream next0 s0) = Stream next (C1 s0) -- (len+1)

182+ Done -> Done

183−-- where

183+ Skip s' -> Skip (C0 s')

184−-- next (C1 s) = Yield w (C0 s)

184+ Yield x s' -> Yield x (C0 s')

185−-- next (C0 s) = case next0 s of

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

186−-- Done -> Done

186+

187−-- Skip s' -> Skip (C0 s')

187+data Snoc a = N

188−-- Yield x s' -> Yield x (C0 s')

188+ | J !a

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

189+

190−

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

191−-- data Snoc a = N

191+snoc :: Stream Char -> Char -> Stream Char

192−-- | J !a

192+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

193−

193+ where

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

194+ next (J xs) = case next0 xs of

195−-- snoc :: Stream Char -> Char -> Stream Char

195+ Done -> Yield w N

196−-- -- snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

196+ Skip xs' -> Skip (J xs')

197−-- snoc (Stream next0 xs0) w = Stream next (J xs0) -- (len+1)

197+ Yield x xs' -> Yield x (J xs')

198−-- where

198+ next N = Done

199−-- next (J xs) = case next0 xs of

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

200−-- Done -> Yield w N

200+

201−-- Skip xs' -> Skip (J xs')

201+data E l r = L !l

202−-- Yield x xs' -> Yield x (J xs')

202+ | R !r

203−-- next N = Done

203+

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

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

205−

205+append :: Stream Char -> Stream Char -> Stream Char

206−-- data E l r = L !l

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

207−-- | R !r

207+ Stream next (L s01) (len1 + len2)

208−

208+ where

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

209+ next (L s1) = case next0 s1 of

210−-- append :: Stream Char -> Stream Char -> Stream Char

210+ Done -> Skip (R s02)

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

211+ Skip s1' -> Skip (L s1')

212−-- -- Stream next (L s01) (len1 + len2)

212+ Yield x s1' -> Yield x (L s1')

213−-- append (Stream next0 s01) (Stream next1 s02) =

213+ next (R s2) = case next1 s2 of

214−-- Stream next (L s01)

214+ Done -> Done

215−-- where

215+ Skip s2' -> Skip (R s2')

216−-- next (L s1) = case next0 s1 of

216+ Yield x s2' -> Yield x (R s2')

217−-- Done -> Skip (R s02)

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

218−-- Skip s1' -> Skip (L s1')

218+

219−-- Yield x s1' -> Yield x (L s1')

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

220−-- next (R s2) = case next1 s2 of

220+-- Subject to array fusion.

221−-- Done -> Done

221+head :: Stream Char -> Char

222−-- Skip s2' -> Skip (R s2')

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

223−-- Yield x s2' -> Yield x (R s2')

223+ where

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

224+ loop_head !s = case next s of

225−

225+ Yield x _ -> x

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

226+ Skip s' -> loop_head s'

227−-- -- Subject to array fusion.

227+ Done -> head_empty

228−-- head :: Stream Char -> Char

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

229−-- -- head (Stream next s0 _len) = loop_head s0

229+

230−-- head (Stream next s0) = loop_head s0

230+head_empty :: a

231−-- where

231+head_empty = streamError "head" "Empty stream"

232−-- loop_head !s = case next s of

232+{-# NOINLINE head_empty #-}

233−-- Yield x _ -> x

233+

234−-- Skip s' -> loop_head s'

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

235−-- Done -> head_empty

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

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

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

237−

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

238−-- head_empty :: a

238+ where

239−-- head_empty = streamError "head" "Empty stream"

239+ loop_uncons !s = case next s of

240−-- {-# NOINLINE head_empty #-}

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

241−

241+ Skip s' -> loop_uncons s'

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

242+ Done -> Nothing

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

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

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

244+

245−-- -- uncons (Stream next s0 len) = loop_uncons s0

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

246−-- uncons (Stream next s0) = loop_uncons s0

246+-- be non-empty.

247−-- where

247+last :: Stream Char -> Char

248−-- loop_uncons !s = case next s of

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

249−-- Yield x s1 -> Just (x, Stream next s1)

249+ where

250−-- Skip s' -> loop_uncons s'

250+ loop0_last !s = case next s of

251−-- Done -> Nothing

251+ Done -> emptyError "last"

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

252+ Skip s' -> loop0_last s'

253−

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

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

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

255−-- -- be non-empty.

255+ Done -> x

256−-- last :: Stream Char -> Char

256+ Skip s' -> loop_last x s'

257−-- -- last (Stream next s0 _len) = loop0_last s0

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

258−-- last (Stream next s0) = loop0_last s0

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

259−-- where

259+

260−-- loop0_last !s = case next s of

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

261−-- Done -> emptyError "last"

261+-- be non-empty.

262−-- Skip s' -> loop0_last s'

262+tail :: Stream Char -> Stream Char

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

263+tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)

264−-- loop_last !x !s = case next s of

264+ where

265−-- Done -> x

265+ next (C0 s) = case next0 s of

266−-- Skip s' -> loop_last x s'

266+ Done -> emptyError "tail"

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

267+ Skip s' -> Skip (C0 s')

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

268+ Yield _ s' -> Skip (C1 s')

269−

269+ next (C1 s) = case next0 s of

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

270+ Done -> Done

271−-- -- be non-empty.

271+ Skip s' -> Skip (C1 s')

272−-- tail :: Stream Char -> Stream Char

272+ Yield x s' -> Yield x (C1 s')

273−-- -- tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)

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

274−-- tail (Stream next0 s0) = Stream next (C0 s0) -- (len-1)

274+

275−-- where

275+data Init s = Init0 !s

276−-- next (C0 s) = case next0 s of

276+ | Init1 {-# UNPACK #-} !Char !s

277−-- Done -> emptyError "tail"

277+

278−-- Skip s' -> Skip (C0 s')

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

279−-- Yield _ s' -> Skip (C1 s')

279+-- must be non-empty.

280−-- next (C1 s) = case next0 s of

280+init :: Stream Char -> Stream Char

281−-- Done -> Done

281+init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)

282−-- Skip s' -> Skip (C1 s')

282+ where

283−-- Yield x s' -> Yield x (C1 s')

283+ next (Init0 s) = case next0 s of

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

284+ Done -> emptyError "init"

285−

285+ Skip s' -> Skip (Init0 s')

286−-- data Init s = Init0 !s

286+ Yield x s' -> Skip (Init1 x s')

287−-- | Init1 {-# UNPACK #-} !Char !s

287+ next (Init1 x s) = case next0 s of

288−

288+ Done -> Done

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

289+ Skip s' -> Skip (Init1 x s')

290−-- -- must be non-empty.

290+ Yield x' s' -> Yield x (Init1 x' s')

291−-- init :: Stream Char -> Stream Char

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

292−-- -- init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)

292+

293−-- init (Stream next0 s0) = Stream next (Init0 s0) -- (len-1)

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

294−-- where

294+null :: Stream Char -> Bool

295−-- next (Init0 s) = case next0 s of

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

296−-- Done -> emptyError "init"

296+ where

297−-- Skip s' -> Skip (Init0 s')

297+ loop_null !s = case next s of

298−-- Yield x s' -> Skip (Init1 x s')

298+ Done -> True

299−-- next (Init1 x s) = case next0 s of

299+ Yield _ _ -> False

300−-- Done -> Done

300+ Skip s' -> loop_null s'

301−-- Skip s' -> Skip (Init1 x s')

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

302−-- Yield x' s' -> Yield x (Init1 x' s')

302+

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

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

304−

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

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

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

306−-- null :: Stream Char -> Bool

306+ where

307−-- -- null (Stream next s0 _len) = loop_null s0

307+ loop_length !z s = case next s of

308−-- null (Stream next s0) = loop_null s0

308+ Done -> z

309−-- where

309+ Skip s' -> loop_length z s'

310−-- loop_null !s = case next s of

310+ Yield _ s' -> loop_length (z + 1) s'

311−-- Done -> True

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

312−-- Yield _ _ -> False

312+

313−-- Skip s' -> loop_null s'

313+-- | /O(n)/ Compares the count of characters in a string to a number.

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

314+-- Subject to fusion.

315−

315+--

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

316+-- This function gives the same answer as comparing against the result

317−-- lengthI :: Integral a => Stream Char -> a

317+-- of 'lengthI', but can short circuit if the count of characters is

318−-- -- lengthI (Stream next s0 _len) = loop_length 0 s0

318+-- greater than the number or if the stream can't possibly be as long

319−-- lengthI (Stream next s0) = loop_length 0 s0

319+-- as the number supplied, and hence be more efficient.

320−-- where

320+compareLengthI :: Integral a => Stream Char -> a -> Ordering

321−-- loop_length !z s = case next s of

321+compareLengthI (Stream next s0 len) n =

322−-- Done -> z

322+ case compareSize len (fromIntegral n) of

323−-- Skip s' -> loop_length z s'

323+ Just o -> o

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

324+ Nothing -> loop_cmp 0 s0

325−-- {-# INLINE[0] lengthI #-}

325+ where

326−

326+ loop_cmp !z s = case next s of

327−-- -- | /O(n)/ Compares the count of characters in a string to a number.

327+ Done -> compare z n

328−-- -- Subject to fusion.

328+ Skip s' -> loop_cmp z s'

329−-- --

329+ Yield _ s' | z > n -> GT

330−-- -- This function gives the same answer as comparing against the result

330+ | otherwise -> loop_cmp (z + 1) s'

331−-- -- of 'lengthI', but can short circuit if the count of characters is

331+{-# INLINE[0] compareLengthI #-}

332−-- -- greater than the number or if the stream can't possibly be as long

332+

333−-- -- as the number supplied, and hence be more efficient.

333+-- | /O(n)/ Indicate whether a string contains exactly one element.

334−-- compareLengthI :: Integral a => Stream Char -> a -> Ordering

334+isSingleton :: Stream Char -> Bool

335−-- -- compareLengthI (Stream next s0 len) n =

335+isSingleton (Stream next s0 _len) = loop 0 s0

336−-- compareLengthI (Stream next s0) n =

336+ where

337−-- -- case compareSize len (fromIntegral n) of

337+ loop !z s = case next s of

338−-- -- Just o -> o

338+ Done -> z == (1::Int)

339−-- -- Nothing -> loop_cmp 0 s0

339+ Skip s' -> loop z s'

340−-- loop_cmp 0 s0

340+ Yield _ s'

341−-- where

341+ | z >= 1 -> False

342−-- loop_cmp !z s = case next s of

342+ | otherwise -> loop (z+1) s'

343−-- Done -> compare z n

343+{-# INLINE[0] isSingleton #-}

344−-- Skip s' -> loop_cmp z s'

344+

345−-- Yield _ s' | z > n -> GT

345+-- ----------------------------------------------------------------------------

346−-- | otherwise -> loop_cmp (z + 1) s'

346+-- * Stream transformations

347−-- {-# INLINE[0] compareLengthI #-}

347+

348−

348+-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@

349−-- -- | /O(n)/ Indicate whether a string contains exactly one element.

349+-- to each element of @xs@.

350−-- isSingleton :: Stream Char -> Bool

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

351−-- -- isSingleton (Stream next s0 _len) = loop 0 s0

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

352−-- isSingleton (Stream next s0) = loop 0 s0

352+ where

353−-- where

353+ next !s = case next0 s of

354−-- loop !z s = case next s of

354+ Done -> Done

355−-- Done -> z == (1::Int)

355+ Skip s' -> Skip s'

356−-- Skip s' -> loop z s'

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

357−-- Yield _ s'

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

358−-- | z >= 1 -> False

358+

359−-- | otherwise -> loop (z+1) s'

359+{-#

360−-- {-# INLINE[0] isSingleton #-}

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

361−

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

362−-- -- ----------------------------------------------------------------------------

362+ #-}

363−-- -- * Stream transformations

363+

364−

364+data I s = I1 !s

365−-- -- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@

365+ | I2 !s {-# UNPACK #-} !Char

366−-- -- to each element of @xs@.

366+ | I3 !s

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

367+

368−-- -- map f (Stream next0 s0 len) = Stream next s0 len

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

369−-- map f (Stream next0 s0) = Stream next s0 -- len

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

370−-- where

370+intersperse :: Char -> Stream Char -> Stream Char

371−-- next !s = case next0 s of

371+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len

372−-- Done -> Done

372+ where

373−-- Skip s' -> Skip s'

373+ next (I1 s) = case next0 s of

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

374+ Done -> Done

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

375+ Skip s' -> Skip (I1 s')

376−

376+ Yield x s' -> Skip (I2 s' x)

377−-- {-#

377+ next (I2 s x) = Yield x (I3 s)

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

378+ next (I3 s) = case next0 s of

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

379+ Done -> Done

380−-- #-}

380+ Skip s' -> Skip (I3 s')

381−

381+ Yield x s' -> Yield c (I2 s' x)

382−-- data I s = I1 !s

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

383−-- | I2 !s {-# UNPACK #-} !Char

383+

384−-- | I3 !s

384+-- ----------------------------------------------------------------------------

385−

385+-- ** Case conversions (folds)

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

386+

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

387+-- $case

388−-- intersperse :: Char -> Stream Char -> Stream Char

388+--

389−-- intersperse c (Stream next0 s0) = Stream next (I1 s0) -- len

389+-- With Unicode text, it is incorrect to use combinators like @map

390−-- -- intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len

390+-- toUpper@ to case convert each character of a string individually.

391−-- where

391+-- Instead, use the whole-string case conversion functions from this

392−-- next (I1 s) = case next0 s of

392+-- module. For correctness in different writing systems, these

393−-- Done -> Done

393+-- functions may map one input character to two or three output

394−-- Skip s' -> Skip (I1 s')

394+-- characters.

395−-- Yield x s' -> Skip (I2 s' x)

395+

396−-- next (I2 s x) = Yield x (I3 s)

396+caseConvert :: (forall s. Char -> s -> Step (CC s) Char)

397−-- next (I3 s) = case next0 s of

397+ -> Stream Char -> Stream Char

398−-- Done -> Done

398+caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len

399−-- Skip s' -> Skip (I3 s')

399+ where

400−-- Yield x s' -> Yield c (I2 s' x)

400+ next (CC s '\0' _) =

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

401+ case next0 s of

402−

402+ Done -> Done

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

403+ Skip s' -> Skip (CC s' '\0' '\0')

404−-- -- ** Case conversions (folds)

404+ Yield c s' -> remap c s'

405−

405+ next (CC s a b) = Yield a (CC s b '\0')

406−-- -- $case

406+

407−-- --

407+-- | /O(n)/ Convert a string to folded case. This function is mainly

408−-- -- With Unicode text, it is incorrect to use combinators like @map

408+-- useful for performing caseless (or case insensitive) string

409−-- -- toUpper@ to case convert each character of a string individually.

409+-- comparisons.

410−-- -- Instead, use the whole-string case conversion functions from this

410+--

411−-- -- module. For correctness in different writing systems, these

411+-- A string @x@ is a caseless match for a string @y@ if and only if:

412−-- -- functions may map one input character to two or three output

412+--

413−-- -- characters.

413+-- @toCaseFold x == toCaseFold y@

414−

414+--

415−-- caseConvert :: (forall s. Char -> s -> Step (CC s) Char)

415+-- The result string may be longer than the input string, and may

416−-- -> Stream Char -> Stream Char

416+-- differ from applying 'toLower' to the input string. For instance,

417−-- -- caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len

417+-- the Armenian small ligature men now (U+FB13) is case folded to the

418−-- caseConvert remap (Stream next0 s0) = Stream next (CC s0 '\0' '\0') -- len

418+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is

419−-- where

419+-- case folded to the Greek small letter letter mu (U+03BC) instead of

420−-- next (CC s '\0' _) =

420+-- itself.

421−-- case next0 s of

421+toCaseFold :: Stream Char -> Stream Char

422−-- Done -> Done

422+toCaseFold = caseConvert foldMapping

423−-- Skip s' -> Skip (CC s' '\0' '\0')

423+{-# INLINE [0] toCaseFold #-}

424−-- Yield c s' -> remap c s'

424+

425−-- next (CC s a b) = Yield a (CC s b '\0')

425+-- | /O(n)/ Convert a string to upper case, using simple case

426−

426+-- conversion. The result string may be longer than the input string.

427−-- -- | /O(n)/ Convert a string to folded case. This function is mainly

427+-- For instance, the German eszett (U+00DF) maps to the two-letter

428−-- -- useful for performing caseless (or case insensitive) string

428+-- sequence SS.

429−-- -- comparisons.

429+toUpper :: Stream Char -> Stream Char

430−-- --

430+toUpper = caseConvert upperMapping

431−-- -- A string @x@ is a caseless match for a string @y@ if and only if:

431+{-# INLINE [0] toUpper #-}

432−-- --

432+

433−-- -- @toCaseFold x == toCaseFold y@

433+-- | /O(n)/ Convert a string to lower case, using simple case

434−-- --

434+-- conversion. The result string may be longer than the input string.

435−-- -- The result string may be longer than the input string, and may

435+-- For instance, the Latin capital letter I with dot above (U+0130)

436−-- -- differ from applying 'toLower' to the input string. For instance,

436+-- maps to the sequence Latin small letter i (U+0069) followed by

437−-- -- the Armenian small ligature men now (U+FB13) is case folded to the

437+-- combining dot above (U+0307).

438−-- -- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is

438+toLower :: Stream Char -> Stream Char

439−-- -- case folded to the Greek small letter letter mu (U+03BC) instead of

439+toLower = caseConvert lowerMapping

440−-- -- itself.

440+{-# INLINE [0] toLower #-}

441−-- toCaseFold :: Stream Char -> Stream Char

441+

442−-- toCaseFold = caseConvert foldMapping

442+-- | /O(n)/ Convert a string to title case, using simple case

443−-- {-# INLINE [0] toCaseFold #-}

443+-- conversion.

444−

444+--

445−-- -- | /O(n)/ Convert a string to upper case, using simple case

445+-- The first letter of the input is converted to title case, as is

446−-- -- conversion. The result string may be longer than the input string.

446+-- every subsequent letter that immediately follows a non-letter.

447−-- -- For instance, the German eszett (U+00DF) maps to the two-letter

447+-- Every letter that immediately follows another letter is converted

448−-- -- sequence SS.

448+-- to lower case.

449−-- toUpper :: Stream Char -> Stream Char

449+--

450−-- toUpper = caseConvert upperMapping

450+-- The result string may be longer than the input string. For example,

451−-- {-# INLINE [0] toUpper #-}

451+-- the Latin small ligature ﬂ (U+FB02) is converted to the

452−

452+-- sequence Latin capital letter F (U+0046) followed by Latin small

453−-- -- | /O(n)/ Convert a string to lower case, using simple case

453+-- letter l (U+006C).

454−-- -- conversion. The result string may be longer than the input string.

454+--

455−-- -- For instance, the Latin capital letter I with dot above (U+0130)

455+-- /Note/: this function does not take language or culture specific

456−-- -- maps to the sequence Latin small letter i (U+0069) followed by

456+-- rules into account. For instance, in English, different style

457−-- -- combining dot above (U+0307).

457+-- guides disagree on whether the book name \"The Hill of the Red

458−-- toLower :: Stream Char -> Stream Char

458+-- Fox\" is correctly title cased—but this function will

459−-- toLower = caseConvert lowerMapping

459+-- capitalize /every/ word.

460−-- {-# INLINE [0] toLower #-}

460+toTitle :: Stream Char -> Stream Char

461−

461+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

462−-- -- | /O(n)/ Convert a string to title case, using simple case

462+ where

463−-- -- conversion.

463+ next (CC (letter :*: s) '\0' _) =

464−-- --

464+ case next0 s of

465−-- -- The first letter of the input is converted to title case, as is

465+ Done -> Done

466−-- -- every subsequent letter that immediately follows a non-letter.

466+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')

467−-- -- Every letter that immediately follows another letter is converted

467+ Yield c s'

468−-- -- to lower case.

468+ | letter' -> if letter

469−-- --

469+ then lowerMapping c (letter' :*: s')

470−-- -- The result string may be longer than the input string. For example,

470+ else titleMapping c (letter' :*: s')

471−-- -- the Latin small ligature ﬂ (U+FB02) is converted to the

471+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')

472−-- -- sequence Latin capital letter F (U+0046) followed by Latin small

472+ where letter' = isLetter c

473−-- -- letter l (U+006C).

473+ next (CC s a b) = Yield a (CC s b '\0')

474−-- --

474+{-# INLINE [0] toTitle #-}

475−-- -- /Note/: this function does not take language or culture specific

475+

476−-- -- rules into account. For instance, in English, different style

476+data Justify i s = Just1 !i !s

477−-- -- guides disagree on whether the book name \"The Hill of the Red

477+ | Just2 !i !s

478−-- -- Fox\" is correctly title cased—but this function will

478+

479−-- -- capitalize /every/ word.

479+justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

480−-- toTitle :: Stream Char -> Stream Char

480+justifyLeftI k c (Stream next0 s0 len) =

481−-- -- toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)

482−-- toTitle (Stream next0 s0) = Stream next (CC (False :*: s0) '\0' '\0') -- len

482+ where

483−-- where

483+ next (Just1 n s) =

484−-- next (CC (letter :*: s) '\0' _) =

484+ case next0 s of

485−-- case next0 s of

485+ Done -> next (Just2 n s)

486−-- Done -> Done

486+ Skip s' -> Skip (Just1 n s')

487−-- Skip s' -> Skip (CC (letter :*: s') '\0' '\0')

487+ Yield x s' -> Yield x (Just1 (n+1) s')

488−-- Yield c s'

488+ next (Just2 n s)

489−-- | letter' -> if letter

489+ | n < k = Yield c (Just2 (n+1) s)

490−-- then lowerMapping c (letter' :*: s')

490+ | otherwise = Done

491−-- else titleMapping c (letter' :*: s')

491+ {-# INLINE next #-}

492−-- | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')

492+{-# INLINE [0] justifyLeftI #-}

493−-- where letter' = isLetter c

493+

494−-- next (CC s a b) = Yield a (CC s b '\0')

494+-- ----------------------------------------------------------------------------

495−-- {-# INLINE [0] toTitle #-}

495+-- * Reducing Streams (folds)

496−

496+

497−-- data Justify i s = Just1 !i !s

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

498−-- | Just2 !i !s

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

499−

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

500−-- justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

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

501−-- -- justifyLeftI k c (Stream next0 s0 len) =

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

502−-- justifyLeftI k c (Stream next0 s0) =

502+ where

503−-- Stream next (Just1 0 s0) -- (larger (fromIntegral k) len)

503+ loop_foldl z !s = case next s of

504−-- where

504+ Done -> z

505−-- next (Just1 n s) =

505+ Skip s' -> loop_foldl z s'

506−-- case next0 s of

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

507−-- Done -> next (Just2 n s)

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

508−-- Skip s' -> Skip (Just1 n s')

508+

509−-- Yield x s' -> Yield x (Just1 (n+1) s')

509+-- | A strict version of foldl.

510−-- next (Just2 n s)

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

511−-- | n < k = Yield c (Just2 (n+1) s)

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

512−-- | otherwise = Done

512+ where

513−-- {-# INLINE next #-}

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

514−-- {-# INLINE [0] justifyLeftI #-}

514+ Done -> z

515−

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

516−-- -- ----------------------------------------------------------------------------

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

517−-- -- * Reducing Streams (folds)

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

518−

518+

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

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

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

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

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

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

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

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

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

523+ where

524−-- foldl f z0 (Stream next s0) = loop_foldl z0 s0

524+ loop0_foldl1 !s = case next s of

525−-- where

525+ Skip s' -> loop0_foldl1 s'

526−-- loop_foldl z !s = case next s of

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

527−-- Done -> z

527+ Done -> emptyError "foldl1"

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

528+ loop_foldl1 z !s = case next s of

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

529+ Done -> z

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

530+ Skip s' -> loop_foldl1 z s'

531−

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

532−-- -- | A strict version of foldl.

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

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

533+

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

534+-- | A strict version of foldl1.

535−-- foldl' f z0 (Stream next s0) = loop_foldl' z0 s0

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

536−-- where

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

537−-- loop_foldl' !z !s = case next s of

537+ where

538−-- Done -> z

538+ loop0_foldl1' !s = case next s of

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

539+ Skip s' -> loop0_foldl1' s'

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

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

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

541+ Done -> emptyError "foldl1"

542−

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

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

543+ Done -> z

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

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

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

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

546−-- -- foldl1 f (Stream next s0 _len) = loop0_foldl1 s0

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

547−-- foldl1 f (Stream next s0) = loop0_foldl1 s0

547+

548−-- where

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

549−-- loop0_foldl1 !s = case next s of

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

550−-- Skip s' -> loop0_foldl1 s'

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

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

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

552−-- Done -> emptyError "foldl1"

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

553−-- loop_foldl1 z !s = case next s of

553+ where

554−-- Done -> z

554+ loop_foldr !s = case next s of

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

555+ Done -> z

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

556+ Skip s' -> loop_foldr s'

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

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

558−

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

559−-- -- | A strict version of foldl1.

559+

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

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

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

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

562−-- foldl1' f (Stream next s0) = loop0_foldl1' s0

562+-- Subject to array fusion.

563−-- where

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

564−-- loop0_foldl1' !s = case next s of

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

565−-- Skip s' -> loop0_foldl1' s'

565+ where

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

566+ loop0_foldr1 !s = case next s of

567−-- Done -> emptyError "foldl1"

567+ Done -> emptyError "foldr1"

568−-- loop_foldl1' !z !s = case next s of

568+ Skip s' -> loop0_foldr1 s'

569−-- Done -> z

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

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

570+

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

571+ loop_foldr1 x !s = case next s of

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

572+ Done -> x

573−

573+ Skip s' -> loop_foldr1 x s'

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

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

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

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

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

576+

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

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

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

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

579−-- foldr f z (Stream next s0) = loop_foldr s0

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

580−-- where

580+

581−-- loop_foldr !s = case next s of

581+-- ----------------------------------------------------------------------------

582−-- Done -> z

582+-- ** Special folds

583−-- Skip s' -> loop_foldr s'

583+

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

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

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

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

586−

586+concat = L.foldr append empty

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

587+{-# INLINE [0] concat #-}

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

588+

589−-- -- Subject to array fusion.

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

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

590+-- results.

591−-- -- foldr1 f (Stream next s0 _len) = loop0_foldr1 s0

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

592−-- foldr1 f (Stream next s0) = loop0_foldr1 s0

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

593−-- where

593+{-# INLINE [0] concatMap #-}

594−-- loop0_foldr1 !s = case next s of

594+

595−-- Done -> emptyError "foldr1"

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

596−-- Skip s' -> loop0_foldr1 s'

596+-- @xs@ satisfies the predicate @p@.

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

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

598−

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

599−-- loop_foldr1 x !s = case next s of

599+ where

600−-- Done -> x

600+ loop_any !s = case next0 s of

601−-- Skip s' -> loop_foldr1 x s'

601+ Done -> False

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

602+ Skip s' -> loop_any s'

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

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

604−

604+ | otherwise -> loop_any s'

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

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

606−-- intercalate s = concat . (L.intersperse s)

606+

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

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

608−

608+-- @xs@ satisfy the predicate @p@.

609−-- -- ----------------------------------------------------------------------------

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

610−-- -- ** Special folds

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

611−

611+ where

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

612+ loop_all !s = case next0 s of

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

613+ Done -> True

614−-- concat = L.foldr append empty

614+ Skip s' -> loop_all s'

615−-- {-# INLINE [0] concat #-}

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

616−

616+ | otherwise -> False

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

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

618−-- -- results.

618+

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

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

620−-- concatMap f = foldr (append . f) empty

620+-- non-empty.

621−-- {-# INLINE [0] concatMap #-}

621+maximum :: Stream Char -> Char

622−

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

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

623+ where

624−-- -- @xs@ satisfies the predicate @p@.

624+ loop0_maximum !s = case next0 s of

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

625+ Done -> emptyError "maximum"

626−-- -- any p (Stream next0 s0 _len) = loop_any s0

626+ Skip s' -> loop0_maximum s'

627−-- any p (Stream next0 s0) = loop_any s0

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

628−-- where

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

629−-- loop_any !s = case next0 s of

629+ Done -> z

630−-- Done -> False

630+ Skip s' -> loop_maximum z s'

631−-- Skip s' -> loop_any s'

631+ Yield x s'

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

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

633−-- | otherwise -> loop_any s'

633+ | otherwise -> loop_maximum z s'

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

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

635−

635+

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

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

637−-- -- @xs@ satisfy the predicate @p@.

637+-- non-empty.

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

638+minimum :: Stream Char -> Char

639−-- -- all p (Stream next0 s0 _len) = loop_all s0

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

640−-- all p (Stream next0 s0) = loop_all s0

640+ where

641−-- where

641+ loop0_minimum !s = case next0 s of

642−-- loop_all !s = case next0 s of

642+ Done -> emptyError "minimum"

643−-- Done -> True

643+ Skip s' -> loop0_minimum s'

644−-- Skip s' -> loop_all s'

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

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

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

646−-- | otherwise -> False

646+ Done -> z

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

647+ Skip s' -> loop_minimum z s'

648−

648+ Yield x s'

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

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

650−-- -- non-empty.

650+ | otherwise -> loop_minimum z s'

651−-- maximum :: Stream Char -> Char

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

652−-- -- maximum (Stream next0 s0 _len) = loop0_maximum s0

652+

653−-- maximum (Stream next0 s0) = loop0_maximum s0

653+-- -----------------------------------------------------------------------------

654−-- where

654+-- * Building streams

655−-- loop0_maximum !s = case next0 s of

655+

656−-- Done -> emptyError "maximum"

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

657−-- Skip s' -> loop0_maximum s'

657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

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

658+ where

659−-- loop_maximum !z !s = case next0 s of

659+ {-# INLINE next #-}

660−-- Done -> z

660+ next (Scan1 z s) = Yield z (Scan2 z s)

661−-- Skip s' -> loop_maximum z s'

661+ next (Scan2 z s) = case next0 s of

662−-- Yield x s'

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

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

663+ in Yield x' (Scan2 x' s')

664−-- | otherwise -> loop_maximum z s'

664+ Skip s' -> Skip (Scan2 z s')

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

665+ Done -> Done

666−

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

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

667+

668−-- -- non-empty.

668+-- -----------------------------------------------------------------------------

669−-- minimum :: Stream Char -> Char

669+-- ** Generating and unfolding streams

670−-- -- minimum (Stream next0 s0 _len) = loop0_minimum s0

670+

671−-- minimum (Stream next0 s0) = loop0_minimum s0

671+replicateCharI :: Integral a => a -> Char -> Stream Char

672−-- where

672+replicateCharI !n !c

673−-- loop0_minimum !s = case next0 s of

673+ | n < 0 = empty

674−-- Done -> emptyError "minimum"

674+ | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

675−-- Skip s' -> loop0_minimum s'

675+ where

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

676+ next !i | i >= n = Done

677−-- loop_minimum !z !s = case next0 s of

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

678−-- Done -> z

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

679−-- Skip s' -> loop_minimum z s'

679+

680−-- Yield x s'

680+data RI s = RI !s {-# UNPACK #-} !Int64

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

681+

682−-- | otherwise -> loop_minimum z s'

682+replicateI :: Int64 -> Stream Char -> Stream Char

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

683+replicateI n (Stream next0 s0 len) =

684−

684+ Stream next (RI s0 0) (fromIntegral (max 0 n) * len)

685−-- -- -----------------------------------------------------------------------------

685+ where

686−-- -- * Building streams

686+ next (RI s k)

687−

687+ | k >= n = Done

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

688+ | otherwise = case next0 s of

689−-- -- scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

689+ Done -> Skip (RI s0 (k+1))

690−-- scanl f z0 (Stream next0 s0) = Stream next (Scan1 z0 s0) -- (len+1) -- HINT maybe too low

690+ Skip s' -> Skip (RI s' k)

691−-- where

691+ Yield x s' -> Yield x (RI s' k)

692−-- {-# INLINE next #-}

692+{-# INLINE [0] replicateI #-}

693−-- next (Scan1 z s) = Yield z (Scan2 z s)

693+

694−-- next (Scan2 z s) = case next0 s of

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

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

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

696−-- in Yield x' (Scan2 x' s')

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

697−-- Skip s' -> Skip (Scan2 z s')

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

698−-- Done -> Done

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

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

699+-- the seed value for further production.

700−

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

701−-- -- -----------------------------------------------------------------------------

701+unfoldr f s0 = Stream next s0 1 -- HINT maybe too low

702−-- -- ** Generating and unfolding streams

702+ where

703−

703+ {-# INLINE next #-}

704−-- replicateCharI :: Integral a => a -> Char -> Stream Char

704+ next !s = case f s of

705−-- replicateCharI n c

705+ Nothing -> Done

706−-- | n < 0 = empty

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

707−-- | otherwise = Stream next 0 -- (fromIntegral n) -- HINT maybe too low

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

708−-- where

708+

709−-- next i | i >= n = Done

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

710−-- | otherwise = Yield c (i + 1)

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

711−-- {-# INLINE [0] replicateCharI #-}

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

712−

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

713−-- data RI s = RI !s {-# UNPACK #-} !Int64

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

714−

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

715−-- replicateI :: Int64 -> Stream Char -> Stream Char

715+ | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high

716−-- -- replicateI n (Stream next0 s0 len) =

716+ where

717−-- replicateI n (Stream next0 s0) =

717+ {-# INLINE next #-}

718−-- Stream next (RI s0 0) -- (fromIntegral (max 0 n) * len)

718+ next (z :*: s) = case f s of

719−-- where

719+ Nothing -> Done

720−-- next (RI s k)

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

721−-- | k >= n = Done

721+ | otherwise -> Yield w ((z + 1) :*: s')

722−-- | otherwise = case next0 s of

722+{-# INLINE unfoldrNI #-}

723−-- Done -> Skip (RI s0 (k+1))

723+

724−-- Skip s' -> Skip (RI s' k)

724+-------------------------------------------------------------------------------

725−-- Yield x s' -> Yield x (RI s' k)

725+-- * Substreams

726−-- {-# INLINE [0] replicateI #-}

726+

727−

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

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

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

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

729+-- length of the stream.

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

730+take :: Integral a => a -> Stream Char -> Stream Char

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

731+take n0 (Stream next0 s0 len) =

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

732+ Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))

733−-- -- the seed value for further production.

733+ where

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

734+ {-# INLINE next #-}

735−-- unfoldr f s0 = Stream next s0 -- 1 -- HINT maybe too low

735+ next (n :*: s) | n <= 0 = Done

736−-- where

736+ | otherwise = case next0 s of

737−-- {-# INLINE next #-}

737+ Done -> Done

738−-- next !s = case f s of

738+ Skip s' -> Skip (n :*: s')

739−-- Nothing -> Done

739+ Yield x s' -> Yield x ((n-1) :*: s')

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

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

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

741+

742−

742+data Drop a s = NS !s

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

743+ | JS !a !s

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

744+

745−-- -- first argument to 'unfoldrNI'. This function is more efficient than

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

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

746+-- stream after the first @n@ characters, or the empty stream if @n@

747−-- unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char

747+-- is greater than the length of the stream.

748−-- unfoldrNI n f s0 | n < 0 = empty

748+drop :: Integral a => a -> Stream Char -> Stream Char

749−-- | otherwise = Stream next (0 :*: s0) -- (fromIntegral (n*2)) -- HINT maybe too high

749+drop n0 (Stream next0 s0 len) =

750−-- where

750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

751−-- {-# INLINE next #-}

751+ where

752−-- next (z :*: s) = case f s of

752+ {-# INLINE next #-}

753−-- Nothing -> Done

753+ next (JS n s)

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

754+ | n <= 0 = Skip (NS s)

755−-- | otherwise -> Yield w ((z + 1) :*: s')

755+ | otherwise = case next0 s of

756−-- {-# INLINE unfoldrNI #-}

756+ Done -> Done

757−

757+ Skip s' -> Skip (JS n s')

758−-- -------------------------------------------------------------------------------

758+ Yield _ s' -> Skip (JS (n-1) s')

759−-- -- * Substreams

759+ next (NS s) = case next0 s of

760−

760+ Done -> Done

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

761+ Skip s' -> Skip (NS s')

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

762+ Yield x s' -> Yield x (NS s')

763−-- -- length of the stream.

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

764−-- take :: Integral a => a -> Stream Char -> Stream Char

764+

765−-- take n0 (Stream next0 s0) =

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

766−-- -- take n0 (Stream next0 s0 len) =

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

767−-- Stream next (n0 :*: s0) -- (smaller len (fromIntegral (max 0 n0)))

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

768−-- where

768+takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

769−-- {-# INLINE next #-}

769+ where

770−-- next (n :*: s) | n <= 0 = Done

770+ {-# INLINE next #-}

771−-- | otherwise = case next0 s of

771+ next !s = case next0 s of

772−-- Done -> Done

772+ Done -> Done

773−-- Skip s' -> Skip (n :*: s')

773+ Skip s' -> Skip s'

774−-- Yield x s' -> Yield x ((n-1) :*: s')

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

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

775+ | otherwise -> Done

776−

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

777−-- data Drop a s = NS !s

777+

778−-- | JS !a !s

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

779−

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

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

780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high

781−-- -- stream after the first @n@ characters, or the empty stream if @n@

781+ where

782−-- -- is greater than the length of the stream.

782+ {-# INLINE next #-}

783−-- drop :: Integral a => a -> Stream Char -> Stream Char

783+ next (L s) = case next0 s of

784−-- -- drop n0 (Stream next0 s0 len) =

784+ Done -> Done

785−-- drop n0 (Stream next0 s0) =

785+ Skip s' -> Skip (L s')

786−-- Stream next (JS n0 s0) -- (len - fromIntegral (max 0 n0))

786+ Yield x s' | p x -> Skip (L s')

787−-- where

787+ | otherwise -> Yield x (R s')

788−-- {-# INLINE next #-}

788+ next (R s) = case next0 s of

789−-- next (JS n s)

789+ Done -> Done

790−-- | n <= 0 = Skip (NS s)

790+ Skip s' -> Skip (R s')

791−-- | otherwise = case next0 s of

791+ Yield x s' -> Yield x (R s')

792−-- Done -> Done

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

793−-- Skip s' -> Skip (JS n s')

793+

794−-- Yield _ s' -> Skip (JS (n-1) s')

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

795−-- next (NS s) = case next0 s of

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

796−-- Done -> Done

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

797−-- Skip s' -> Skip (NS s')

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

798−-- Yield x s' -> Yield x (NS s')

798+ where

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

799+ loop Done _ = True

800−

800+ loop _ Done = False

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

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

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

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

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

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

804−-- -- takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

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

805−-- takeWhile p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high

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

806−-- where

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

807−-- {-# INLINE next #-}

807+

808−-- next !s = case next0 s of

808+-- ----------------------------------------------------------------------------

809−-- Done -> Done

809+-- * Searching

810−-- Skip s' -> Skip s'

810+

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

811+-------------------------------------------------------------------------------

812−-- | otherwise -> Done

812+-- ** Searching by equality

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

813+

814−

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

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

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

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

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

817−-- -- dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high

817+ where

818−-- dropWhile p (Stream next0 s0) = Stream next (L s0) -- len -- HINT maybe too high

818+ loop_elem !s = case next s of

819−-- where

819+ Done -> False

820−-- {-# INLINE next #-}

820+ Skip s' -> loop_elem s'

821−-- next (L s) = case next0 s of

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

822−-- Done -> Done

822+ | otherwise -> loop_elem s'

823−-- Skip s' -> Skip (L s')

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

824−-- Yield x s' | p x -> Skip (L s')

824+

825−-- | otherwise -> Yield x (R s')

825+-------------------------------------------------------------------------------

826−-- next (R s) = case next0 s of

826+-- ** Searching with a predicate

827−-- Done -> Done

827+

828−-- Skip s' -> Skip (R s')

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

829−-- Yield x s' -> Yield x (R s')

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

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

830+-- if there is no such element.

831−

831+

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

832+findBy :: (Char -> Bool) -> Stream Char -> Maybe Char

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

833+findBy p (Stream next s0 _len) = loop_find s0

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

834+ where

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

835+ loop_find !s = case next s of

836−-- isPrefixOf (Stream next1 s1) (Stream next2 s2) = loop (next1 s1) (next2 s2)

836+ Done -> Nothing

837−-- where

837+ Skip s' -> loop_find s'

838−-- loop Done _ = True

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

839−-- loop _ Done = False

839+ | otherwise -> loop_find s'

840−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

840+{-# INLINE [0] findBy #-}

841−-- loop (Skip s1') x2 = loop (next1 s1') x2

841+

842−-- loop x1 (Skip s2') = loop x1 (next2 s2')

842+-- | /O(n)/ Stream index (subscript) operator, starting from 0.

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

843+indexI :: Integral a => Stream Char -> a -> Char

844−-- loop (next1 s1') (next2 s2')

844+indexI (Stream next s0 _len) n0

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

845+ | n0 < 0 = streamError "index" "Negative index"

846−

846+ | otherwise = loop_index n0 s0

847−-- -- ----------------------------------------------------------------------------

847+ where

848−-- -- * Searching

848+ loop_index !n !s = case next s of

849−

849+ Done -> streamError "index" "Index too large"

850−-- -------------------------------------------------------------------------------

850+ Skip s' -> loop_index n s'

851−-- -- ** Searching by equality

851+ Yield x s' | n == 0 -> x

852−

852+ | otherwise -> loop_index (n-1) s'

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

853+{-# INLINE [0] indexI #-}

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

854+

855−-- -- elem w (Stream next s0 _len) = loop_elem s0

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

856−-- elem w (Stream next s0) = loop_elem s0

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

857−-- where

857+-- predicate.

858−-- loop_elem !s = case next s of

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

859−-- Done -> False

859+filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

860−-- Skip s' -> loop_elem s'

860+ where

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

861+ next !s = case next0 s of

862−-- | otherwise -> loop_elem s'

862+ Done -> Done

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

863+ Skip s' -> Skip s'

864−

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

865−-- -------------------------------------------------------------------------------

865+ | otherwise -> Skip s'

866−-- -- ** Searching with a predicate

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

867−

867+

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

868+{-# RULES

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

869+ "STREAM filter/filter fusion" forall p q s.

870−-- -- if there is no such element.

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

871−

871+ #-}

872−-- findBy :: (Char -> Bool) -> Stream Char -> Maybe Char

872+

873−-- -- findBy p (Stream next s0 _len) = loop_find s0

873+-- | The 'findIndexI' function takes a predicate and a stream and

874−-- findBy p (Stream next s0) = loop_find s0

874+-- returns the index of the first element in the stream satisfying the

875−-- where

875+-- predicate.

876−-- loop_find !s = case next s of

876+findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a

877−-- Done -> Nothing

877+findIndexI p s = case findIndicesI p s of

878−-- Skip s' -> loop_find s'

878+ (i:_) -> Just i

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

879+ _ -> Nothing

880−-- | otherwise -> loop_find s'

880+{-# INLINE [0] findIndexI #-}

881−-- {-# INLINE [0] findBy #-}

881+

882−

882+-- | The 'findIndicesI' function takes a predicate and a stream and

883−-- -- | /O(n)/ Stream index (subscript) operator, starting from 0.

883+-- returns all indices of the elements in the stream satisfying the

884−-- indexI :: Integral a => Stream Char -> a -> Char

884+-- predicate.

885−-- -- indexI (Stream next s0 _len) n0

885+findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]

886−-- indexI (Stream next s0) n0

886+findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

887−-- | n0 < 0 = streamError "index" "Negative index"

887+ where

888−-- | otherwise = loop_index n0 s0

888+ loop_findIndex !i !s = case next s of

889−-- where

889+ Done -> []

890−-- loop_index !n !s = case next s of

890+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC

891−-- Done -> streamError "index" "Index too large"

891+ Yield x s' | p x -> i : loop_findIndex (i+1) s'

892−-- Skip s' -> loop_index n s'

892+ | otherwise -> loop_findIndex (i+1) s'

893−-- Yield x s' | n == 0 -> x

893+{-# INLINE [0] findIndicesI #-}

894−-- | otherwise -> loop_index (n-1) s'

894+

895−-- {-# INLINE [0] indexI #-}

895+-------------------------------------------------------------------------------

896−

896+-- * Zipping

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

897+

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

898+-- | Strict triple.

899−-- -- predicate.

899+data Zip a b m = Z1 !a !b

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

900+ | Z2 !a !b !m

901−-- -- filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

901+

902−-- filter p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high

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

903−-- where

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

904−-- next !s = case next0 s of

904+zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b

905−-- Done -> Done

905+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

906−-- Skip s' -> Skip s'

906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)

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

907+ where

908−-- | otherwise -> Skip s'

908+ next (Z1 sa sb) = case next0 sa of

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

909+ Done -> Done

910−

910+ Skip sa' -> Skip (Z1 sa' sb)

911−-- {-# RULES

911+ Yield a sa' -> Skip (Z2 sa' sb a)

912−-- "STREAM filter/filter fusion" forall p q s.

912+

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

913+ next (Z2 sa' sb a) = case next1 sb of

914−-- #-}

914+ Done -> Done

915−

915+ Skip sb' -> Skip (Z2 sa' sb' a)

916−-- -- | The 'findIndexI' function takes a predicate and a stream and

916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')

917−-- -- returns the index of the first element in the stream satisfying the

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

918−-- -- predicate.

918+

919−-- findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a

919+-- | /O(n)/ The 'countCharI' function returns the number of times the

920−-- findIndexI p s = case findIndicesI p s of

920+-- query element appears in the given stream.

921−-- (i:_) -> Just i

921+countCharI :: Integral a => Char -> Stream Char -> a

922−-- _ -> Nothing

922+countCharI a (Stream next s0 _len) = loop 0 s0

923−-- {-# INLINE [0] findIndexI #-}

923+ where

924−

924+ loop !i !s = case next s of

925−-- -- | The 'findIndicesI' function takes a predicate and a stream and

925+ Done -> i

926−-- -- returns all indices of the elements in the stream satisfying the

926+ Skip s' -> loop i s'

927−-- -- predicate.

927+ Yield x s' | a == x -> loop (i+1) s'

928−-- findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]

928+ | otherwise -> loop i s'

929−-- -- findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

929+{-# INLINE [0] countCharI #-}

930−-- findIndicesI p (Stream next s0) = loop_findIndex 0 s0

930+

931−-- where

931+streamError :: String -> String -> a

932−-- loop_findIndex !i !s = case next s of

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

933−-- Done -> []

933+

934−-- Skip s' -> loop_findIndex i s' -- hmm. not caught by QC

934+emptyError :: String -> a

935−-- Yield x s' | p x -> i : loop_findIndex (i+1) s'

935+emptyError func = internalError func "Empty input"

936−-- | otherwise -> loop_findIndex (i+1) s'

936+

937−-- {-# INLINE [0] findIndicesI #-}

937+internalError :: String -> a

938−

938+internalError func = streamError func "Internal error"

939−-- -------------------------------------------------------------------------------

940−-- -- * Zipping

941−

942−-- -- | Strict triple.

943−-- data Zip a b m = Z1 !a !b

944−-- | Z2 !a !b !m

945−

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

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

948−-- zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b

949−-- -- zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

950−-- zipWith f (Stream next0 sa0) (Stream next1 sb0) =

951−-- Stream next (Z1 sa0 sb0) -- (smaller len1 len2)

952−-- where

953−-- next (Z1 sa sb) = case next0 sa of

954−-- Done -> Done

955−-- Skip sa' -> Skip (Z1 sa' sb)

956−-- Yield a sa' -> Skip (Z2 sa' sb a)

957−

958−-- next (Z2 sa' sb a) = case next1 sb of

959−-- Done -> Done

960−-- Skip sb' -> Skip (Z2 sa' sb' a)

961−-- Yield b sb' -> Yield (f a b) (Z1 sa' sb')

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

963−

964−-- -- | /O(n)/ The 'countCharI' function returns the number of times the

965−-- -- query element appears in the given stream.

966−-- countCharI :: Integral a => Char -> Stream Char -> a

967−-- -- countCharI a (Stream next s0 _len) = loop 0 s0

968−-- countCharI a (Stream next s0) = loop 0 s0

969−-- where

970−-- loop !i !s = case next s of

971−-- Done -> i

972−-- Skip s' -> loop i s'

973−-- Yield x s' | a == x -> loop (i+1) s'

974−-- | otherwise -> loop i s'

975−-- {-# INLINE [0] countCharI #-}

976−

977−-- streamError :: String -> String -> a

978−-- streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg

979−

980−-- emptyError :: String -> a

981−-- emptyError func = internalError func "Empty input"

982−

983−-- internalError :: String -> a

984−-- internalError func = streamError func "Internal error"

Data/Text/Internal/Fusion/Types.hs+99−102

@@ -19,107 +19,104 @@

20module Data.Text.Internal.Fusion.Types

21 (

22− -- CC(..)

22+ CC(..)

23− -- , PairS(..)

23+ , PairS(..)

24− -- , Scan(..)

24+ , Scan(..)

25− -- , RS(..)

25+ , RS(..)

26− -- , Step(..)

26+ , Step(..)

27− -- , Stream(..)

27+ , Stream(..)

28− -- , empty

28+ , empty

29− module Data.JSString.Internal.Fusion.Types

30 ) where

29 ) where

32−-- import Data.Text.Internal.Fusion.Size

31+import Data.Text.Internal.Fusion.Size

33−-- import Data.Word (Word8)

32+import Data.Word (Word8)

34−

33+

35−import Data.JSString.Internal.Fusion.Types

36−

37−-- -- | Specialised tuple for case conversion.

34+-- | Specialised tuple for case conversion.

38−-- data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

35+data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

39−

36+

40−-- -- | Restreaming state.

37+-- | Restreaming state.

41−-- data RS s

38+data RS s

42−-- = RS0 !s

39+ = RS0 !s

43−-- | RS1 !s {-# UNPACK #-} !Word8

40+ | RS1 !s {-# UNPACK #-} !Word8

44−-- | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

41+ | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

45−-- | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

42+ | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

46−

43+

47−-- -- | Strict pair.

44+-- | Strict pair.

48−-- data PairS a b = !a :*: !b

45+data PairS a b = !a :*: !b

49−-- -- deriving (Eq, Ord, Show)

46+ -- deriving (Eq, Ord, Show)

50−-- infixl 2 :*:

47+infixl 2 :*:

51−

48+

52−-- -- | An intermediate result in a scan.

49+-- | An intermediate result in a scan.

53−-- data Scan s = Scan1 {-# UNPACK #-} !Char !s

50+data Scan s = Scan1 {-# UNPACK #-} !Char !s

54−-- | Scan2 {-# UNPACK #-} !Char !s

51+ | Scan2 {-# UNPACK #-} !Char !s

55−

52+

56−-- -- | Intermediate result in a processing pipeline.

53+-- | Intermediate result in a processing pipeline.

57−-- data Step s a = Done

54+data Step s a = Done

58−-- | Skip !s

55+ | Skip !s

59−-- | Yield !a !s

56+ | Yield !a !s

60−

57+

61−-- {-

58+{-

62−-- instance (Show a) => Show (Step s a)

59+instance (Show a) => Show (Step s a)

63−-- where show Done = "Done"

60+ where show Done = "Done"

64−-- show (Skip _) = "Skip"

61+ show (Skip _) = "Skip"

65−-- show (Yield x _) = "Yield " ++ show x

62+ show (Yield x _) = "Yield " ++ show x

66−-- -}

63+-}

67−

64+

68−-- instance (Eq a) => Eq (Stream a) where

65+instance (Eq a) => Eq (Stream a) where

69−-- (==) = eq

66+ (==) = eq

70−

67+

71−-- instance (Ord a) => Ord (Stream a) where

68+instance (Ord a) => Ord (Stream a) where

72−-- compare = cmp

69+ compare = cmp

73−

70+

74−-- -- The length hint in a Stream has two roles. If its value is zero,

71+-- The length hint in a Stream has two roles. If its value is zero,

75−-- -- we trust it, and treat the stream as empty. Otherwise, we treat it

72+-- we trust it, and treat the stream as empty. Otherwise, we treat it

76−-- -- as a hint: it should usually be accurate, so we use it when

73+-- as a hint: it should usually be accurate, so we use it when

77−-- -- unstreaming to decide what size array to allocate. However, the

74+-- unstreaming to decide what size array to allocate. However, the

78−-- -- unstreaming functions must be able to cope with the hint being too

75+-- unstreaming functions must be able to cope with the hint being too

79−-- -- small or too large.

76+-- small or too large.

80−-- --

77+--

81−-- -- The size hint tries to track the UTF-16 code points in a stream,

78+-- The size hint tries to track the UTF-16 code points in a stream,

82−-- -- but often counts the number of characters instead. It can easily

79+-- but often counts the number of characters instead. It can easily

83−-- -- undercount if, for instance, a transformed stream contains astral

80+-- undercount if, for instance, a transformed stream contains astral

84−-- -- plane characters (those above 0x10000).

81+-- plane characters (those above 0x10000).

85−

82+

86−-- data Stream a =

83+data Stream a =

87−-- forall s. Stream

84+ forall s. Stream

88−-- (s -> Step s a) -- stepper function

85+ (s -> Step s a) -- stepper function

89−-- !s -- current state

86+ !s -- current state

90−-- !Size -- size hint

87+ !Size -- size hint

91−

88+

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

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

93−-- eq :: (Eq a) => Stream a -> Stream a -> Bool

90+eq :: (Eq a) => Stream a -> Stream a -> Bool

94−-- eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

91+eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

95−-- where

92+ where

96−-- loop Done Done = True

93+ loop Done Done = True

97−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

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

98−-- loop (Skip s1') x2 = loop (next1 s1') x2

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

99−-- loop x1 (Skip s2') = loop x1 (next2 s2')

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

100−-- loop Done _ = False

97+ loop Done _ = False

101−-- loop _ Done = False

98+ loop _ Done = False

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

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

103−-- loop (next1 s1') (next2 s2')

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

104−-- {-# INLINE [0] eq #-}

101+{-# INLINE [0] eq #-}

105−

102+

106−-- cmp :: (Ord a) => Stream a -> Stream a -> Ordering

103+cmp :: (Ord a) => Stream a -> Stream a -> Ordering

107−-- cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

104+cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

108−-- where

105+ where

109−-- loop Done Done = EQ

106+ loop Done Done = EQ

110−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

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

111−-- loop (Skip s1') x2 = loop (next1 s1') x2

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

112−-- loop x1 (Skip s2') = loop x1 (next2 s2')

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

113−-- loop Done _ = LT

110+ loop Done _ = LT

114−-- loop _ Done = GT

111+ loop _ Done = GT

115−-- loop (Yield x1 s1') (Yield x2 s2') =

112+ loop (Yield x1 s1') (Yield x2 s2') =

116−-- case compare x1 x2 of

113+ case compare x1 x2 of

117−-- EQ -> loop (next1 s1') (next2 s2')

114+ EQ -> loop (next1 s1') (next2 s2')

118−-- other -> other

115+ other -> other

119−-- {-# INLINE [0] cmp #-}

116+{-# INLINE [0] cmp #-}

120−

117+

121−-- -- | The empty stream.

118+-- | The empty stream.

122−-- empty :: Stream a

119+empty :: Stream a

123−-- empty = Stream next () 0

120+empty = Stream next () 0

124−-- where next _ = Done

121+ where next _ = Done

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

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

Data/Text/Internal/IO.hs−8

@@ -95,11 +95,7 @@ unpack !buf !r !w

95 | r >= w = return T.empty

96 | otherwise = withRawBuffer buf go

97 where

98−#ifndef __GHCJS__

99 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))

98 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))

100−#else

101− go pbuf = return $! unstream (Stream next r)

102−#endif

103 where

99 where

104 next !i | i >= w = Done

100 next !i | i >= w = Done

105 | otherwise = Yield (ix i) (i+1)

101 | otherwise = Yield (ix i) (i+1)

@@ -112,11 +108,7 @@ unpack_nl !buf !r !w

112 | otherwise = withRawBuffer buf $ go

108 | otherwise = withRawBuffer buf $ go

113 where

109 where

114 go pbuf = do

110 go pbuf = do

115−#ifndef __GHCJS__

116 let !t = unstream (Stream next r (maxSize (w-r)))

111 let !t = unstream (Stream next r (maxSize (w-r)))

117−#else

118− let !t = unstream (Stream next r)

119−#endif

120 w' = w - 1

112 w' = w - 1

121 return $ if ix w' == '\r'

113 return $ if ix w' == '\r'

122 then (t,w')

114 then (t,w')

Data/Text/Internal/Lazy.hs+1−20

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

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

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

2{-# OPTIONS_HADDOCK not-home #-}

4-- |

@@ -44,10 +44,6 @@ import Data.Typeable (Typeable)

44import Foreign.Storable (sizeOf)

45import qualified Data.Text.Internal as T

47−#ifdef __GHCJS__

48−import qualified Data.Text as TT

49−#endif

50−

51data Text = Empty

47data Text = Empty

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

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

53 deriving (Typeable)

49 deriving (Typeable)

@@ -61,26 +57,16 @@ data Text = Empty

61-- | Check the invariant strictly.

57-- | Check the invariant strictly.

62strictInvariant :: Text -> Bool

58strictInvariant :: Text -> Bool

63strictInvariant Empty = True

59strictInvariant Empty = True

64−#ifndef __GHCJS__

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

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

66 | len > 0 = strictInvariant cs

61 | len > 0 = strictInvariant cs

67−#else

68−strictInvariant x@(Chunk t cs)

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

70−#endif

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

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

72 ++ showStructure x

63 ++ showStructure x

74-- | Check the invariant lazily.

65-- | Check the invariant lazily.

75lazyInvariant :: Text -> Text

66lazyInvariant :: Text -> Text

76lazyInvariant Empty = Empty

67lazyInvariant Empty = Empty

77−#ifndef __GHCJS__

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

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

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

69 | 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

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

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

85 ++ showStructure x

71 ++ showStructure x

@@ -94,13 +80,8 @@ showStructure (Chunk t ts) =

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

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

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

81chunk :: T.Text -> Text -> Text

96{-# INLINE chunk #-}

82{-# INLINE chunk #-}

97−#ifndef __GHCJS__

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

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

99 | otherwise = Chunk t ts

84 | otherwise = Chunk t ts

100−#else

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

102− | otherwise = Chunk t ts

103−#endif

104

105-- | Smart constructor for 'Empty'.

86-- | Smart constructor for 'Empty'.

106empty :: Text

87empty :: Text

Data/Text/Internal/Lazy/Encoding/Fusion.hs−26

@@ -38,9 +38,7 @@ import qualified Data.ByteString.Unsafe as B

38import Data.Text.Internal.Encoding.Fusion.Common

39import Data.Text.Encoding.Error

40import Data.Text.Internal.Fusion (Step(..), Stream(..))

41−#ifndef __GHCJS__

42import Data.Text.Internal.Fusion.Size

41import Data.Text.Internal.Fusion.Size

43−#endif

44import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)

42import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)

45import Data.Text.Internal.Unsafe.Shift (shiftL)

43import Data.Text.Internal.Unsafe.Shift (shiftL)

46import Data.Word (Word8, Word16, Word32)

44import Data.Word (Word8, Word16, Word32)

@@ -67,11 +65,7 @@ data T = T !ByteString !S {-# UNPACK #-} !Int

67-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using

65-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using

68-- UTF-8 encoding.

66-- UTF-8 encoding.

69streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

67streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

70−#ifndef __GHCJS__

71streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize

68streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize

72−#else

73−streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

74−#endif

75 where

69 where

76 next (T bs@(Chunk ps _) S0 i)

70 next (T bs@(Chunk ps _) S0 i)

77 | i < len && U8.validate1 a =

71 | i < len && U8.validate1 a =

@@ -113,11 +107,7 @@ streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

113-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

107-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

114-- endian UTF-16 encoding.

108-- endian UTF-16 encoding.

115streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char

109streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char

116−#ifndef __GHCJS__

117streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

110streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

118−#else

119−streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

120−#endif

121 where

111 where

122 next (T bs@(Chunk ps _) S0 i)

112 next (T bs@(Chunk ps _) S0 i)

123 | i + 1 < len && U16.validate1 x1 =

113 | i + 1 < len && U16.validate1 x1 =

@@ -157,11 +147,7 @@ streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

157-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

158-- endian UTF-16 encoding.

148-- endian UTF-16 encoding.

159streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char

149streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char

160−#ifndef __GHCJS__

161streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

150streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

162−#else

163−streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

164−#endif

165 where

151 where

166 next (T bs@(Chunk ps _) S0 i)

152 next (T bs@(Chunk ps _) S0 i)

167 | i + 1 < len && U16.validate1 x1 =

153 | i + 1 < len && U16.validate1 x1 =

@@ -201,11 +187,7 @@ streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

201-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

187-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

202-- endian UTF-32 encoding.

188-- endian UTF-32 encoding.

203streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char

189streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char

204−#ifndef __GHCJS__

205streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

190streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

206−#else

207−streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

208−#endif

209 where

191 where

210 next (T bs@(Chunk ps _) S0 i)

192 next (T bs@(Chunk ps _) S0 i)

211 | i + 3 < len && U32.validate x =

193 | i + 3 < len && U32.validate x =

@@ -249,11 +231,7 @@ streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

249-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

231-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

250-- endian UTF-32 encoding.

232-- endian UTF-32 encoding.

251streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char

233streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char

252−#ifndef __GHCJS__

253streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

234streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

254−#else

255−streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

256−#endif

257 where

235 where

258 next (T bs@(Chunk ps _) S0 i)

236 next (T bs@(Chunk ps _) S0 i)

259 | i + 3 < len && U32.validate x =

237 | i + 3 < len && U32.validate x =

@@ -296,11 +274,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

296

274

297-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

275-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

298unstreamChunks :: Int -> Stream Word8 -> ByteString

276unstreamChunks :: Int -> Stream Word8 -> ByteString

299−#ifndef __GHCJS__

300unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)

277unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)

301−#else

302−unstreamChunks chunkSize (Stream next s0) = chunk s0 4

303−#endif

304 where chunk s1 len1 = unsafeDupablePerformIO $ do

278 where chunk s1 len1 = unsafeDupablePerformIO $ do

305 let len = max 4 (min len1 chunkSize)

279 let len = max 4 (min len1 chunkSize)

306 mallocByteString len >>= loop len 0 s1

280 mallocByteString len >>= loop len 0 s1

Data/Text/Internal/Lazy/Fusion.hs−62

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

1{-# LANGUAGE BangPatterns #-}

2−{-# LANGUAGE CPP #-}

3−#ifdef __GHCJS__

4−{-# LANGUAGE ForeignFunctionInterface #-}

5−{-# LANGUAGE MagicHash #-}

6−{-# LANGUAGE UnliftedFFITypes #-}

7−#endif

8-- |

2-- |

9-- Module : Data.Text.Lazy.Fusion

3-- Module : Data.Text.Lazy.Fusion

@@ -35,14 +29,7 @@ import Prelude hiding (length)

35import qualified Data.Text.Internal.Fusion.Common as S

29import qualified Data.Text.Internal.Fusion.Common as S

36import Control.Monad.ST (runST)

30import Control.Monad.ST (runST)

37import Data.Text.Internal.Fusion.Types

31import Data.Text.Internal.Fusion.Types

38−#ifndef __GHCJS__

39import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)

32import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)

40−#else

41−import Data.JSString (JSString)

42−import qualified Data.JSString as JSS

43−import GHC.Base (Int(..))

44−import GHC.Exts (ByteArray#, Int#)

45−#endif

46import Data.Text.Internal.Lazy

33import Data.Text.Internal.Lazy

47import qualified Data.Text.Internal as I

34import qualified Data.Text.Internal as I

48import qualified Data.Text.Array as A

35import qualified Data.Text.Array as A

@@ -55,7 +42,6 @@ default(Int64)

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

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

57stream :: Text -> Stream Char

44stream :: Text -> Stream Char

58−#ifndef __GHCJS__

59stream text = Stream next (text :*: 0) unknownSize

45stream text = Stream next (text :*: 0) unknownSize

60 where

46 where

61 next (Empty :*: _) = Done

47 next (Empty :*: _) = Done

@@ -63,22 +49,11 @@ stream text = Stream next (text :*: 0) unknownSize

63 | i >= len = next (ts :*: 0)

49 | i >= len = next (ts :*: 0)

64 | otherwise = Yield c (txt :*: i+d)

50 | otherwise = Yield c (txt :*: i+d)

65 where Iter c d = iter t i

51 where Iter c d = iter t i

66−#else

67−stream text = Stream next (text :*: 0) -- unknownSize

68− where

69− next (Empty :*: _) = Done

70− next (txt@(Chunk t@(I.Text jst) ts) :*: i)

71− | i >= JSS.length jst = next (ts :*: 0)

72− | otherwise = Yield c (txt :*: i+d)

73− where Iter c d = iter t i

74−#endif

75{-# INLINE [0] stream #-}

52{-# INLINE [0] stream #-}

77−-- TODO

78-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

54-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

79-- chunk size.

55-- chunk size.

80unstreamChunks :: Int -> Stream Char -> Text

56unstreamChunks :: Int -> Stream Char -> Text

81−#ifndef __GHCJS__

82unstreamChunks !chunkSize (Stream next s0 len0)

57unstreamChunks !chunkSize (Stream next s0 len0)

83 | isEmpty len0 = Empty

58 | isEmpty len0 = Empty

84 | otherwise = outer s0

59 | otherwise = outer s0

@@ -109,36 +84,6 @@ unstreamChunks !chunkSize (Stream next s0 len0)

109 finish marr len s' = do

84 finish marr len s' = do

110 arr <- A.unsafeFreeze marr

85 arr <- A.unsafeFreeze marr

111 return (I.Text arr 0 len `Chunk` outer s')

86 return (I.Text arr 0 len `Chunk` outer s')

112−#else

113−unstreamChunks !chunkSize (Stream next s0) = outer s0

114− where

115− outer so = {-# SCC "unstreamChunks/outer" #-}

116− case next so of

117− Done -> Empty

118− Skip s' -> outer s'

119− Yield x s' -> runST $ do

120− a <- A.new unknownLength

121− unsafeWrite a 0 x >>= inner a unknownLength s'

122− where unknownLength = 4

123− where

124− inner marr !len s !i

125− | i + 1 >= chunkSize = finish marr i s

126− | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do

127− let newLen = min (len `shiftL` 1) chunkSize

128− marr' <- A.new newLen

129− A.copyM marr' 0 marr 0 len

130− inner marr' newLen s i

131− | otherwise =

132− {-# SCC "unstreamChunks/inner" #-}

133− case next s of

134− Done -> finish marr i s

135− Skip s' -> inner marr len s' i

136− Yield x s' -> do d <- unsafeWrite marr i x

137− inner marr len s' (i+d)

138− finish marr (I# len#) s' = do

139− arr <- A.unsafeFreeze marr

140− return (I.Text (js_toString (A.aBA arr) 0# len#) `Chunk` outer s')

141−#endif

142{-# INLINE [0] unstreamChunks #-}

87{-# INLINE [0] unstreamChunks #-}

143

144-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using

89-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using

@@ -173,10 +118,3 @@ index = S.indexI

173countChar :: Char -> Stream Char -> Int64

118countChar :: Char -> Stream Char -> Int64

174countChar = S.countCharI

119countChar = S.countCharI

175{-# INLINE [0] countChar #-}

120{-# INLINE [0] countChar #-}

176−

177−#ifdef __GHCJS__

178−foreign import javascript unsafe

179− "h$textToString"

180− js_toString :: ByteArray# -> Int# -> Int# -> JSString

181−#endif

182−

Data/Text/Internal/Lazy/Search.hs+11−55

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

1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}

2−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, JavaScriptFFI,

3− UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,

4− MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}

6-- |

3-- |

7-- Module : Data.Text.Lazy.Search

4-- Module : Data.Text.Lazy.Search

@@ -34,17 +31,6 @@ import Data.Text.Internal.Lazy (Text(..), foldlChunks)

34import Data.Bits ((.|.), (.&.))

31import Data.Bits ((.|.), (.&.))

35import Data.Text.Internal.Unsafe.Shift (shiftL)

32import Data.Text.Internal.Unsafe.Shift (shiftL)

37−import Data.JSString (JSString)

38−import qualified Data.Text as TT

39−import GHC.Exts (Int(..), Int#, ByteArray#)

40−

41−foreign import javascript unsafe

42− "h$textFromString"

43− js_fromString :: JSString -> (# ByteArray#, Int# #)

44−

45−fromString :: T.Text -> (# ByteArray#, Int# #)

46−fromString (T.Text txt) = js_fromString txt

47−

48-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

34-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

49-- @needle@ within @haystack@.

35-- @needle@ within @haystack@.

50--

36--

@@ -61,10 +47,8 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

61 | nlen == 1 = indicesOne (nindex 0) 0 k ks

47 | nlen == 1 = indicesOne (nindex 0) 0 k ks

62 | otherwise = advance k ks 0 0

48 | otherwise = advance k ks 0 0

63 where

49 where

64− -- advance x@(T.Text _ _ l) xs = scan

50+ advance x@(T.Text _ _ l) xs = scan

65− advance x xs = scan

66 where

51 where

67− l = TT.length x

68 scan !g !i

52 scan !g !i

69 | i >= m = case xs of

53 | i >= m = case xs of

70 Empty -> []

54 Empty -> []

@@ -88,23 +72,11 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

88 nlast = nlen - 1

72 nlast = nlen - 1

89 nindex = index n ns

73 nindex = index n ns

90 z = foldlChunks fin 0 needle

74 z = foldlChunks fin 0 needle

91− where

92− -- fin _ (T.Text farr foff flen) =

93− fin _ t =

94− let foff = 0

95− (farr, flen) =

96− let (# ba, len #) = fromString t

97− in (A.Array ba, I# len)

98− in A.unsafeIndex farr (foff+flen-1)

75+ where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)

99 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)

76 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)

100 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)

77 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)

101− -- buildTable (T.Text xarr xoff xlen) xs = go

78+ buildTable (T.Text xarr xoff xlen) xs = go

102− buildTable t xs = go

103 where

79 where

104− xoff = 0

105− (xarr, xlen) =

106− let (# ba, len #) = fromString t

107− in (A.Array ba, I# len)

108 go !(g::Int64) !i !msk !skp

80 go !(g::Int64) !i !msk !skp

109 | i >= xlast = case xs of

81 | i >= xlast = case xs of

110 Empty -> (msk .|. swizzle z) :*: skp

82 Empty -> (msk .|. swizzle z) :*: skp

@@ -119,22 +91,17 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

119 -- given offset would fail.

91 -- given offset would fail.

120 lackingHay q = go 0

92 lackingHay q = go 0

121 where

93 where

122− -- go p (T.Text _ _ l) ps = p' < q && case ps of

94+ go p (T.Text _ _ l) ps = p' < q && case ps of

123− go p t ps = p' < q && case ps of

124− Empty -> True

95+ Empty -> True

125− Chunk r rs -> go p' r rs

96+ Chunk r rs -> go p' r rs

126− where

127− l = TT.length t

128− p' = p + fromIntegral l

97+ where p' = p + fromIntegral l

129−

130indices _ _ = []

98indices _ _ = []

131

132-- | Fast index into a partly unpacked 'Text'. We take into account

100-- | Fast index into a partly unpacked 'Text'. We take into account

133-- the possibility that the caller might try to access one element

101-- the possibility that the caller might try to access one element

134-- past the end.

102-- past the end.

135index :: T.Text -> Text -> Int64 -> Word16

103index :: T.Text -> Text -> Int64 -> Word16

136−-- index (T.Text arr off len) xs !i

104+index (T.Text arr off len) xs !i

137−index t xs !i

138 | j < len = A.unsafeIndex arr (off+j)

105 | j < len = A.unsafeIndex arr (off+j)

139 | otherwise = case xs of

106 | otherwise = case xs of

140 Empty

107 Empty

@@ -143,24 +110,14 @@ index t xs !i

143 -- should never happen, due to lackingHay above

110 -- should never happen, due to lackingHay above

144 | otherwise -> emptyError "index"

111 | otherwise -> emptyError "index"

145 Chunk c cs -> index c cs (i-fromIntegral len)

112 Chunk c cs -> index c cs (i-fromIntegral len)

146− where

147− j = fromIntegral i

113+ where j = fromIntegral i

148− off = 0

149− (arr, len) =

150− let (# ba, len' #) = fromString t

151− in (A.Array ba, I# len')

152

114

153-- | A variant of 'indices' that scans linearly for a single 'Word16'.

115-- | A variant of 'indices' that scans linearly for a single 'Word16'.

154indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]

116indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]

155indicesOne c = chunk

117indicesOne c = chunk

156 where

118 where

157− -- chunk !i (T.Text oarr ooff olen) os = go 0

119+ chunk !i (T.Text oarr ooff olen) os = go 0

158− chunk !i t os = go 0

159 where

120 where

160− ooff = 0

161− (oarr, olen) =

162− let (# ba, len #) = fromString t

163− in (A.Array ba, I# len)

164 go h | h >= olen = case os of

121 go h | h >= olen = case os of

165 Empty -> []

122 Empty -> []

166 Chunk y ys -> chunk (i+fromIntegral olen) y ys

123 Chunk y ys -> chunk (i+fromIntegral olen) y ys

@@ -171,8 +128,7 @@ indicesOne c = chunk

171-- | The number of 'Word16' values in a 'Text'.

128-- | The number of 'Word16' values in a 'Text'.

172wordLength :: Text -> Int64

129wordLength :: Text -> Int64

173wordLength = foldlChunks sumLength 0

130wordLength = foldlChunks sumLength 0

174− where sumLength i t = i + fromIntegral (TT.length t)

175− -- where sumLength i (T.Text _ _ l) = i + fromIntegral l

131+ where sumLength i (T.Text _ _ l) = i + fromIntegral l

176

132

177emptyError :: String -> a

133emptyError :: String -> a

178emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")

134emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")

Data/Text/Internal/Private.hs+1−8

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

1−{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples, CPP #-}

1+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}

3-- |

4-- Module : Data.Text.Internal.Private

@@ -19,12 +19,8 @@ import Control.Monad.ST (ST, runST)

19import Data.Text.Internal (Text(..), text)

20import Data.Text.Unsafe (Iter(..), iter)

21import qualified Data.Text.Array as A

22−#ifdef __GHCJS__

23−import qualified Data.JSString as JSS

24−#endif

26span_ :: (Char -> Bool) -> Text -> (# Text, Text #)

23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)

27−#ifndef __GHCJS__

28span_ p t@(Text arr off len) = (# hd,tl #)

24span_ p t@(Text arr off len) = (# hd,tl #)

29 where hd = text arr off k

25 where hd = text arr off k

30 tl = text arr (off+k) (len-k)

26 tl = text arr (off+k) (len-k)

@@ -32,9 +28,6 @@ span_ p t@(Text arr off len) = (# hd,tl #)

32 loop !i | i < len && p c = loop (i+d)

28 loop !i | i < len && p c = loop (i+d)

33 | otherwise = i

29 | otherwise = i

34 where Iter c d = iter t i

30 where Iter c d = iter t i

35−#else

36−span_ p (Text t) = let (# a, b #) = JSS.span_ p t in (# Text a, Text b #)

37−#endif

38{-# INLINE span_ #-}

31{-# INLINE span_ #-}

40runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text

33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text

Data/Text/Internal/Search.hs+37−40

@@ -37,8 +37,6 @@ import Data.Text.Internal (Text(..))

37import Data.Bits ((.|.), (.&.))

38import Data.Text.Internal.Unsafe.Shift (shiftL)

40−import qualified Data.JSString.Internal.Search as JSS

41−

42data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int

40data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int

44-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

@@ -51,42 +49,41 @@ data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int

51indices :: Text -- ^ Substring to search for (@needle@)

49indices :: Text -- ^ Substring to search for (@needle@)

52 -> Text -- ^ Text to search in (@haystack@)

50 -> Text -- ^ Text to search in (@haystack@)

53 -> [Int]

51 -> [Int]

54−indices = coerce JSS.indices

55−-- indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

52+indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

56−-- | nlen == 1 = scanOne (nindex 0)

53+ | nlen == 1 = scanOne (nindex 0)

57−-- | nlen <= 0 || ldiff < 0 = []

54+ | nlen <= 0 || ldiff < 0 = []

58−-- | otherwise = scan 0

55+ | otherwise = scan 0

59−-- where

56+ where

60−-- ldiff = hlen - nlen

57+ ldiff = hlen - nlen

61−-- nlast = nlen - 1

58+ nlast = nlen - 1

62−-- z = nindex nlast

59+ z = nindex nlast

63−-- nindex k = A.unsafeIndex narr (noff+k)

60+ nindex k = A.unsafeIndex narr (noff+k)

64−-- hindex k = A.unsafeIndex harr (hoff+k)

61+ hindex k = A.unsafeIndex harr (hoff+k)

65−-- hindex' k | k == hlen = 0

62+ hindex' k | k == hlen = 0

66−-- | otherwise = A.unsafeIndex harr (hoff+k)

63+ | otherwise = A.unsafeIndex harr (hoff+k)

67−-- buildTable !i !msk !skp

64+ buildTable !i !msk !skp

68−-- | i >= nlast = (msk .|. swizzle z) :* skp

65+ | i >= nlast = (msk .|. swizzle z) :* skp

69−-- | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'

66+ | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'

70−-- where c = nindex i

67+ where c = nindex i

71−-- skp' | c == z = nlen - i - 2

68+ skp' | c == z = nlen - i - 2

72−-- | otherwise = skp

69+ | otherwise = skp

73−-- swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)

70+ swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)

74−-- scan !i

71+ scan !i

75−-- | i > ldiff = []

72+ | i > ldiff = []

76−-- | c == z && candidateMatch 0 = i : scan (i + nlen)

73+ | c == z && candidateMatch 0 = i : scan (i + nlen)

77−-- | otherwise = scan (i + delta)

74+ | otherwise = scan (i + delta)

78−-- where c = hindex (i + nlast)

75+ where c = hindex (i + nlast)

79−-- candidateMatch !j

76+ candidateMatch !j

80−-- | j >= nlast = True

77+ | j >= nlast = True

81−-- | hindex (i+j) /= nindex j = False

78+ | hindex (i+j) /= nindex j = False

82−-- | otherwise = candidateMatch (j+1)

79+ | otherwise = candidateMatch (j+1)

83−-- delta | nextInPattern = nlen + 1

80+ delta | nextInPattern = nlen + 1

84−-- | c == z = skip + 1

81+ | c == z = skip + 1

85−-- | otherwise = 1

82+ | otherwise = 1

86−-- where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0

83+ where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0

87−-- !(mask :* skip) = buildTable 0 0 (nlen-2)

84+ !(mask :* skip) = buildTable 0 0 (nlen-2)

88−-- scanOne c = loop 0

85+ scanOne c = loop 0

89−-- where loop !i | i >= hlen = []

86+ where loop !i | i >= hlen = []

90−-- | hindex i == c = i : loop (i+1)

87+ | hindex i == c = i : loop (i+1)

91−-- | otherwise = loop (i+1)

88+ | otherwise = loop (i+1)

92{-# INLINE indices #-}

89{-# INLINE indices #-}

Data/Text/Lazy.hs+5−54

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

6#if __GLASGOW_HASKELL__ >= 708

7{-# LANGUAGE TypeFamilies #-}

8#endif

9−#ifdef __GHCJS__

10−{-# LANGUAGE ForeignFunctionInterface #-}

11−#endif

12-- |

10-- |

13-- Module : Data.Text.Lazy

11-- Module : Data.Text.Lazy

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

246#if MIN_VERSION_base(4,7,0)

244#if MIN_VERSION_base(4,7,0)

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

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

248#endif

246#endif

249−#ifdef __GHCJS__

250−import Data.JSString (JSString)

251−#endif

252

247

253-- $fusion

248-- $fusion

254--

249--

@@ -329,7 +324,6 @@ compareText Empty _ = LT

329compareText _ Empty = GT

324compareText _ Empty = GT

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

325compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0

331 where

326 where

332−#ifndef __GHCJS__

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

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

334 where

328 where

335 go !i !j

329 go !i !j

@@ -340,20 +334,6 @@ compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0

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

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

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

335 where T.Iter a di = T.iter ta i

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

336 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

349− | a < b = LT

350− | a > b = GT

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

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

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

354− lenA = T.length ta

355− lenB = T.length tb

356−#endif

357

337

358instance Show Text where

338instance Show Text where

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

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

@@ -1139,20 +1119,11 @@ dropWords i t0

1139 | otherwise = drop' i t0

1119 | otherwise = drop' i t0

1140 where drop' 0 ts = ts

1120 where drop' 0 ts = ts

1141 drop' _ Empty = Empty

1121 drop' _ Empty = Empty

1142−#ifndef __GHCJS__

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

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

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

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

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

1124 | otherwise = drop' (n - len') ts

1146 where len' = fromIntegral len

1125 where len' = fromIntegral len

1147 n' = fromIntegral n

1126 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

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

1152− where len' = fromIntegral len

1153− len = T.length t

1154− n' = fromIntegral n

1155−#endif

1156

1127

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

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

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

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

@@ -1273,22 +1244,12 @@ splitAt = loop

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

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

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

1245splitAtWord :: Int64 -> Text -> PairS Text Text

1275splitAtWord _ Empty = empty :*: empty

1246splitAtWord _ Empty = empty :*: empty

1276−#ifndef __GHCJS__

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

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

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

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

1279 in Chunk c h :*: t

1249 in Chunk c h :*: t

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

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

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

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

1282 where y = fromIntegral x

1252 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

1292

1253

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

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

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

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

@@ -1468,11 +1429,7 @@ splitOn pat src

1468 go _ [] cs = [cs]

1429 go _ [] cs = [cs]

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

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

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

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

1471−#ifndef __GHCJS__

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

1432 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

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

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

1477

1434

1478{-# RULES

1435{-# RULES

@@ -1574,11 +1531,10 @@ isSuffixOf x y = reverse x `isPrefixOf` reverse y

1574-- In (unlikely) bad cases, this function's time complexity degrades

1531-- In (unlikely) bad cases, this function's time complexity degrades

1575-- towards /O(n*m)/.

1532-- towards /O(n*m)/.

1576isInfixOf :: Text -> Text -> Bool

1533isInfixOf :: Text -> Text -> Bool

1577−isInfixOf _ _ = True

1578−-- isInfixOf needle haystack

1534+isInfixOf needle haystack

1579−-- | null needle = True

1535+ | null needle = True

1580−-- | isSingleton needle = S.elem (head needle) . S.stream $ haystack

1536+ | isSingleton needle = S.elem (head needle) . S.stream $ haystack

1581−-- | otherwise = not . L.null . indices needle $ haystack

1537+ | otherwise = not . L.null . indices needle $ haystack

1582{-# INLINE [1] isInfixOf #-}

1538{-# INLINE [1] isInfixOf #-}

1583

1539

1584{-# RULES

1540{-# RULES

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

1737

1693

1738impossibleError :: String -> a

1694impossibleError :: String -> a

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

1695impossibleError 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

Data/Text/Lazy/Builder/Int.hs+259−9

@@ -1,12 +1,262 @@

1−module Data.Text.Lazy.Builder.Int where

1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,

2+ UnboxedTuples #-}

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

3−import Data.Text.Lazy (Text)

7+-- Module: Data.Text.Lazy.Builder.Int

4−import qualified Data.Text.Lazy as L

5−import qualified Data.Text as T

6−import qualified Data.JSString.Int as JSS

10+-- License: BSD-style

7−import Data.Text.Lazy.Builder

11+-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

12+-- Stability: experimental

13+-- Portability: portable

14+--

15+-- Efficiently write an integral value to a 'Builder'.

16+

17+module Data.Text.Lazy.Builder.Int

18+ (

19+ decimal

20+ , hexadecimal

21+ ) where

22+

23+import Data.Int (Int8, Int16, Int32, Int64)

8−import Data.Monoid

24+import Data.Monoid (mempty)

25+import qualified Data.ByteString.Unsafe as B

26+import Data.Text.Internal.Builder.Functions ((<>), i2d)

27+import Data.Text.Internal.Builder

28+import Data.Text.Internal.Builder.Int.Digits (digits)

29+import Data.Text.Array

30+import Data.Word (Word, Word8, Word16, Word32, Word64)

31+import GHC.Base (quotInt, remInt)

32+import GHC.Num (quotRemInteger)

33+import GHC.Types (Int(..))

34+import Control.Monad.ST

35+

36+#ifdef __GLASGOW_HASKELL__

37+# if defined(INTEGER_GMP)

38+import GHC.Integer.GMP.Internals (Integer(S#))

39+# elif defined(INTEGER_SIMPLE)

40+import GHC.Integer

41+# else

42+# error "You need to use either GMP or integer-simple."

43+# endif

44+#endif

45+

46+#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)

47+# define PAIR(a,b) (# a,b #)

48+#else

49+# define PAIR(a,b) (a,b)

50+#endif

10decimal :: Integral a => a -> Builder

52decimal :: Integral a => a -> Builder

11−-- decimal n = L.fromChunks [T.Text $ JSS.decimal n]

53+{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}

12−decimal _ = mempty

54+{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}

55+{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}

56+{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}

57+{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}

58+{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}

59+{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}

60+{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}

61+{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}

62+{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}

63+{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}

64+decimal i = decimal' (<= -128) i

65+{-# NOINLINE decimal #-}

66+

67+boundedDecimal :: (Integral a, Bounded a) => a -> Builder

68+{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}

69+{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}

70+{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}

71+{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}

72+{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}

73+boundedDecimal i = decimal' (== minBound) i

74+

75+decimal' :: (Integral a) => (a -> Bool) -> a -> Builder

76+{-# INLINE decimal' #-}

77+decimal' p i

78+ | i < 0 = if p i

79+ then let (q, r) = i `quotRem` 10

80+ qq = -q

81+ !n = countDigits qq

82+ in writeN (n + 2) $ \marr off -> do

83+ unsafeWrite marr off minus

84+ posDecimal marr (off+1) n qq

85+ unsafeWrite marr (off+n+1) (i2w (-r))

86+ else let j = -i

87+ !n = countDigits j

88+ in writeN (n + 1) $ \marr off ->

89+ unsafeWrite marr off minus >> posDecimal marr (off+1) n j

90+ | otherwise = positive i

91+

92+positive :: (Integral a) => a -> Builder

93+{-# SPECIALIZE positive :: Int -> Builder #-}

94+{-# SPECIALIZE positive :: Int8 -> Builder #-}

95+{-# SPECIALIZE positive :: Int16 -> Builder #-}

96+{-# SPECIALIZE positive :: Int32 -> Builder #-}

97+{-# SPECIALIZE positive :: Int64 -> Builder #-}

98+{-# SPECIALIZE positive :: Word -> Builder #-}

99+{-# SPECIALIZE positive :: Word8 -> Builder #-}

100+{-# SPECIALIZE positive :: Word16 -> Builder #-}

101+{-# SPECIALIZE positive :: Word32 -> Builder #-}

102+{-# SPECIALIZE positive :: Word64 -> Builder #-}

103+positive i

104+ | i < 10 = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)

105+ | otherwise = let !n = countDigits i

106+ in writeN n $ \marr off -> posDecimal marr off n i

107+

108+posDecimal :: (Integral a) =>

109+ forall s. MArray s -> Int -> Int -> a -> ST s ()

110+{-# INLINE posDecimal #-}

111+posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0

112+ where go off v

113+ | v >= 100 = do

114+ let (q, r) = v `quotRem` 100

115+ write2 off r

116+ go (off - 2) q

117+ | v < 10 = unsafeWrite marr off (i2w v)

118+ | otherwise = write2 off v

119+ write2 off i0 = do

120+ let i = fromIntegral i0; j = i + i

121+ unsafeWrite marr off $ get (j + 1)

122+ unsafeWrite marr (off - 1) $ get j

123+ get = fromIntegral . B.unsafeIndex digits

124+

125+minus, zero :: Word16

126+{-# INLINE minus #-}

127+{-# INLINE zero #-}

128+minus = 45

129+zero = 48

130+

131+i2w :: (Integral a) => a -> Word16

132+{-# INLINE i2w #-}

133+i2w v = zero + fromIntegral v

134+

135+countDigits :: (Integral a) => a -> Int

136+{-# INLINE countDigits #-}

137+countDigits v0

138+ | fromIntegral v64 == v0 = go 1 v64

139+ | otherwise = goBig 1 (fromIntegral v0)

140+ where v64 = fromIntegral v0

141+ goBig !k (v :: Integer)

142+ | v > big = goBig (k + 19) (v `quot` big)

143+ | otherwise = go k (fromIntegral v)

144+ big = 10000000000000000000

145+ go !k (v :: Word64)

146+ | v < 10 = k

147+ | v < 100 = k + 1

148+ | v < 1000 = k + 2

149+ | v < 1000000000000 =

150+ k + if v < 100000000

151+ then if v < 1000000

152+ then if v < 10000

153+ then 3

154+ else 4 + fin v 100000

155+ else 6 + fin v 10000000

156+ else if v < 10000000000

157+ then 8 + fin v 1000000000

158+ else 10 + fin v 100000000000

159+ | otherwise = go (k + 12) (v `quot` 1000000000000)

160+ fin v n = if v >= n then 1 else 0

161+

162+hexadecimal :: Integral a => a -> Builder

163+{-# SPECIALIZE hexadecimal :: Int -> Builder #-}

164+{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}

165+{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}

166+{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}

167+{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}

168+{-# SPECIALIZE hexadecimal :: Word -> Builder #-}

169+{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}

170+{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}

171+{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}

172+{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}

173+{-# RULES "hexadecimal/Integer"

174+ hexadecimal = hexInteger :: Integer -> Builder #-}

175+hexadecimal i

176+ | i < 0 = error hexErrMsg

177+ | otherwise = go i

178+ where

179+ go n | n < 16 = hexDigit n

180+ | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)

181+{-# NOINLINE[0] hexadecimal #-}

182+

183+hexInteger :: Integer -> Builder

184+hexInteger i

185+ | i < 0 = error hexErrMsg

186+ | otherwise = integer 16 i

187+

188+hexErrMsg :: String

189+hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"

190+

191+hexDigit :: Integral a => a -> Builder

192+hexDigit n

193+ | n <= 9 = singleton $! i2d (fromIntegral n)

194+ | otherwise = singleton $! toEnum (fromIntegral n + 87)

195+{-# INLINE hexDigit #-}

196+

197+data T = T !Integer !Int

198+

199+integer :: Int -> Integer -> Builder

200+#ifdef INTEGER_GMP

201+integer 10 (S# i#) = decimal (I# i#)

202+integer 16 (S# i#) = hexadecimal (I# i#)

203+#endif

204+integer base i

205+ | i < 0 = singleton '-' <> go (-i)

206+ | otherwise = go i

207+ where

208+ go n | n < maxInt = int (fromInteger n)

209+ | otherwise = putH (splitf (maxInt * maxInt) n)

210+

211+ splitf p n

212+ | p > n = [n]

213+ | otherwise = splith p (splitf (p*p) n)

214+

215+ splith p (n:ns) = case n `quotRemInteger` p of

216+ PAIR(q,r) | q > 0 -> q : r : splitb p ns

217+ | otherwise -> r : splitb p ns

218+ splith _ _ = error "splith: the impossible happened."

219+

220+ splitb p (n:ns) = case n `quotRemInteger` p of

221+ PAIR(q,r) -> q : r : splitb p ns

222+ splitb _ _ = []

223+

224+ T maxInt10 maxDigits10 =

225+ until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)

226+ where mi = fromIntegral (maxBound :: Int)

227+ T maxInt16 maxDigits16 =

228+ until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)

229+ where mi = fromIntegral (maxBound :: Int)

230+

231+ fstT (T a _) = a

232+

233+ maxInt | base == 10 = maxInt10

234+ | otherwise = maxInt16

235+ maxDigits | base == 10 = maxDigits10

236+ | otherwise = maxDigits16

237+

238+ putH (n:ns) = case n `quotRemInteger` maxInt of

239+ PAIR(x,y)

240+ | q > 0 -> int q <> pblock r <> putB ns

241+ | otherwise -> int r <> putB ns

242+ where q = fromInteger x

243+ r = fromInteger y

244+ putH _ = error "putH: the impossible happened"

245+

246+ putB (n:ns) = case n `quotRemInteger` maxInt of

247+ PAIR(x,y) -> pblock q <> pblock r <> putB ns

248+ where q = fromInteger x

249+ r = fromInteger y

250+ putB _ = Data.Monoid.mempty

251+

252+ int :: Int -> Builder

253+ int x | base == 10 = decimal x

254+ | otherwise = hexadecimal x

255+

256+ pblock = loop maxDigits

257+ where

258+ loop !d !n

259+ | d == 1 = hexDigit n

260+ | otherwise = loop (d-1) q <> hexDigit r

261+ where q = n `quotInt` base

262+ r = n `remInt` base

Data/Text/Lazy/Builder/RealFloat.hs+233−2

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

1+{-# LANGUAGE CPP, OverloadedStrings #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

6+-- |

7+-- Module: Data.Text.Lazy.Builder.RealFloat

8+-- Copyright: (c) The University of Glasgow 1994-2002

9+-- License: see libraries/base/LICENSE

10+--

11+-- Write a floating point value to a 'Builder'.

12+

1−module Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) where

13+module Data.Text.Lazy.Builder.RealFloat

14+ (

15+ FPFormat(..)

16+ , realFloat

17+ , formatRealFloat

18+ ) where

19+

20+import Data.Array.Base (unsafeAt)

21+import Data.Array.IArray

22+import Data.Text.Internal.Builder.Functions ((<>), i2d)

23+import Data.Text.Lazy.Builder.Int (decimal)

24+import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)

25+import Data.Text.Lazy.Builder

26+import qualified Data.Text as T

3-- | Control the rendering of floating point numbers.

28-- | Control the rendering of floating point numbers.

4data FPFormat = Exponent

29data FPFormat = Exponent

@@ -8,4 +33,210 @@ data FPFormat = Exponent

8 | Generic

33 | Generic

9 -- ^ Use decimal notation for values between @0.1@ and

34 -- ^ Use decimal notation for values between @0.1@ and

10 -- @9,999,999@, and scientific notation otherwise.

35 -- @9,999,999@, and scientific notation otherwise.

11− deriving (Enum, Read, Show)

36+ deriving (Enum, Read, Show)

37+

38+-- | Show a signed 'RealFloat' value to full precision,

39+-- using standard decimal notation for arguments whose absolute value lies

40+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.

41+realFloat :: (RealFloat a) => a -> Builder

42+{-# SPECIALIZE realFloat :: Float -> Builder #-}

43+{-# SPECIALIZE realFloat :: Double -> Builder #-}

44+realFloat x = formatRealFloat Generic Nothing x

45+

46+formatRealFloat :: (RealFloat a) =>

47+ FPFormat

48+ -> Maybe Int -- ^ Number of decimal places to render.

49+ -> a

50+ -> Builder

51+{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}

52+{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}

53+formatRealFloat fmt decs x

54+ | isNaN x = "NaN"

55+ | isInfinite x = if x < 0 then "-Infinity" else "Infinity"

56+ | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x))

57+ | otherwise = doFmt fmt (floatToDigits x)

58+ where

59+ doFmt format (is, e) =

60+ let ds = map i2d is in

61+ case format of

62+ Generic ->

63+ doFmt (if e < 0 || e > 7 then Exponent else Fixed)

64+ (is,e)

65+ Exponent ->

66+ case decs of

67+ Nothing ->

68+ let show_e' = decimal (e-1) in

69+ case ds of

70+ "0" -> "0.0e0"

71+ [d] -> singleton d <> ".0e" <> show_e'

72+ (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e'

73+ [] -> error "formatRealFloat/doFmt/Exponent: []"

74+ Just dec ->

75+ let dec' = max dec 1 in

76+ case is of

77+ [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"

78+ _ ->

79+ let

80+ (ei,is') = roundTo (dec'+1) is

81+ (d:ds') = map i2d (if ei > 0 then init is' else is')

82+ in

83+ singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)

84+ Fixed ->

85+ let

86+ mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}

87+ in

88+ case decs of

89+ Nothing

90+ | e <= 0 -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds

91+ | otherwise ->

92+ let

93+ f 0 s rs = mk0 (reverse s) <> singleton '.' <> mk0 rs

94+ f n s "" = f (n-1) ('0':s) ""

95+ f n s (r:rs) = f (n-1) (r:s) rs

96+ in

97+ f e "" ds

98+ Just dec ->

99+ let dec' = max dec 0 in

100+ if e >= 0 then

101+ let

102+ (ei,is') = roundTo (dec' + e) is

103+ (ls,rs) = splitAt (e+ei) (map i2d is')

104+ in

105+ mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)

106+ else

107+ let

108+ (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)

109+ d:ds' = map i2d (if ei > 0 then is' else 0:is')

110+ in

111+ singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')

112+

113+

114+-- Based on "Printing Floating-Point Numbers Quickly and Accurately"

115+-- by R.G. Burger and R.K. Dybvig in PLDI 96.

116+-- This version uses a much slower logarithm estimator. It should be improved.

117+

118+-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,

119+-- and returns a list of digits and an exponent.

120+-- In particular, if @x>=0@, and

121+--

122+-- > floatToDigits base x = ([d1,d2,...,dn], e)

123+--

124+-- then

125+--

126+-- (1) @n >= 1@

127+--

128+-- (2) @x = 0.d1d2...dn * (base**e)@

129+--

130+-- (3) @0 <= di <= base-1@

131+

132+floatToDigits :: (RealFloat a) => a -> ([Int], Int)

133+{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}

134+{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}

135+floatToDigits 0 = ([0], 0)

136+floatToDigits x =

137+ let

138+ (f0, e0) = decodeFloat x

139+ (minExp0, _) = floatRange x

140+ p = floatDigits x

141+ b = floatRadix x

142+ minExp = minExp0 - p -- the real minimum exponent

143+ -- Haskell requires that f be adjusted so denormalized numbers

144+ -- will have an impossibly low exponent. Adjust for this.

145+ (f, e) =

146+ let n = minExp - e0 in

147+ if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)

148+ (r, s, mUp, mDn) =

149+ if e >= 0 then

150+ let be = expt b e in

151+ if f == expt b (p-1) then

152+ (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig

153+ else

154+ (f*be*2, 2, be, be)

155+ else

156+ if e > minExp && f == expt b (p-1) then

157+ (f*b*2, expt b (-e+1)*2, b, 1)

158+ else

159+ (f*2, expt b (-e)*2, 1, 1)

160+ k :: Int

161+ k =

162+ let

163+ k0 :: Int

164+ k0 =

165+ if b == 2 then

166+ -- logBase 10 2 is very slightly larger than 8651/28738

167+ -- (about 5.3558e-10), so if log x >= 0, the approximation

168+ -- k1 is too small, hence we add one and need one fixup step less.

169+ -- If log x < 0, the approximation errs rather on the high side.

170+ -- That is usually more than compensated for by ignoring the

171+ -- fractional part of logBase 2 x, but when x is a power of 1/2

172+ -- or slightly larger and the exponent is a multiple of the

173+ -- denominator of the rational approximation to logBase 10 2,

174+ -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,

175+ -- we get a leading zero-digit we don't want.

176+ -- With the approximation 3/10, this happened for

177+ -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.

178+ -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x

179+ -- for IEEE-ish floating point types with exponent fields

180+ -- <= 17 bits and mantissae of several thousand bits, earlier

181+ -- convergents to logBase 10 2 would fail for long double.

182+ -- Using quot instead of div is a little faster and requires

183+ -- fewer fixup steps for negative lx.

184+ let lx = p - 1 + e0

185+ k1 = (lx * 8651) `quot` 28738

186+ in if lx >= 0 then k1 + 1 else k1

187+ else

188+ -- f :: Integer, log :: Float -> Float,

189+ -- ceiling :: Float -> Int

190+ ceiling ((log (fromInteger (f+1) :: Float) +

191+ fromIntegral e * log (fromInteger b)) /

192+ log 10)

193+--WAS: fromInt e * log (fromInteger b))

194+

195+ fixup n =

196+ if n >= 0 then

197+ if r + mUp <= expt 10 n * s then n else fixup (n+1)

198+ else

199+ if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)

200+ in

201+ fixup k0

202+

203+ gen ds rn sN mUpN mDnN =

204+ let

205+ (dn, rn') = (rn * 10) `quotRem` sN

206+ mUpN' = mUpN * 10

207+ mDnN' = mDnN * 10

208+ in

209+ case (rn' < mDnN', rn' + mUpN' > sN) of

210+ (True, False) -> dn : ds

211+ (False, True) -> dn+1 : ds

212+ (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds

213+ (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'

214+

215+ rds =

216+ if k >= 0 then

217+ gen [] r (s * expt 10 k) mUp mDn

218+ else

219+ let bk = expt 10 (-k) in

220+ gen [] (r * bk) s (mUp * bk) (mDn * bk)

221+ in

222+ (map fromIntegral (reverse rds), k)

223+

224+-- Exponentiation with a cache for the most common numbers.

225+minExpt, maxExpt :: Int

226+minExpt = 0

227+maxExpt = 1100

228+

229+expt :: Integer -> Int -> Integer

230+expt base n

231+ | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n

232+ | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n

233+ | otherwise = base^n

234+

235+expts :: Array Int Integer

236+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]

237+

238+maxExpt10 :: Int

239+maxExpt10 = 324

240+

241+expts10 :: Array Int Integer

242+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]

Data/Text/Unsafe.hs−87

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

1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}

2−#ifdef __GHCJS__

3−{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes #-}

4−#endif

5-- |

2-- |

6-- Module : Data.Text.Unsafe

3-- Module : Data.Text.Unsafe

@@ -35,47 +32,31 @@ import Control.Exception (assert)

35import Data.Text.Internal.Encoding.Utf16 (chr2)

32import Data.Text.Internal.Encoding.Utf16 (chr2)

36import Data.Text.Internal (Text(..))

33import Data.Text.Internal (Text(..))

37import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)

34import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)

38−#ifdef __GHCJS__

39−import Data.Coerce

40−import qualified Data.JSString.Raw as JSS

41−import GHC.Exts (Int(..), Int#, chr#, int2Word#, Char(..))

42−import GHC.Word (Word16(..))

43−import Data.JSString (JSString)

44−#else

45import Data.Text.Internal.Unsafe.Char (unsafeChr)

35import Data.Text.Internal.Unsafe.Char (unsafeChr)

46import qualified Data.Text.Array as A

36import qualified Data.Text.Array as A

47−#endif

48import GHC.IO (unsafeDupablePerformIO)

37import GHC.IO (unsafeDupablePerformIO)

50-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

51-- omits the check for the empty case, so there is an obligation on

40-- omits the check for the empty case, so there is an obligation on

52-- the programmer to provide a proof that the 'Text' is non-empty.

41-- the programmer to provide a proof that the 'Text' is non-empty.

53unsafeHead :: Text -> Char

42unsafeHead :: Text -> Char

54−#ifndef __GHCJS__

55unsafeHead (Text arr off _len)

43unsafeHead (Text arr off _len)

56 | m < 0xD800 || m > 0xDBFF = unsafeChr m

44 | m < 0xD800 || m > 0xDBFF = unsafeChr m

57 | otherwise = chr2 m n

45 | otherwise = chr2 m n

58 where m = A.unsafeIndex arr off

46 where m = A.unsafeIndex arr off

59 n = A.unsafeIndex arr (off+1)

47 n = A.unsafeIndex arr (off+1)

60−#else

61−unsafeHead = coerce JSS.rawHead

62−#endif

63{-# INLINE unsafeHead #-}

48{-# INLINE unsafeHead #-}

65-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'

50-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'

66-- omits the check for the empty case, so there is an obligation on

51-- omits the check for the empty case, so there is an obligation on

67-- the programmer to provide a proof that the 'Text' is non-empty.

52-- the programmer to provide a proof that the 'Text' is non-empty.

68unsafeTail :: Text -> Text

53unsafeTail :: Text -> Text

69−#ifndef __GHCJS__

70unsafeTail t@(Text arr off len) =

54unsafeTail t@(Text arr off len) =

71#if defined(ASSERTS)

55#if defined(ASSERTS)

72 assert (d <= len) $

56 assert (d <= len) $

73#endif

57#endif

74 Text arr (off+d) (len-d)

58 Text arr (off+d) (len-d)

75 where d = iter_ t 0

59 where d = iter_ t 0

76−#else

77−unsafeTail = coerce JSS.rawTail

78−#endif

79{-# INLINE unsafeTail #-}

60{-# INLINE unsafeTail #-}

81data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int

62data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int

@@ -84,7 +65,6 @@ data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int

84-- array, returning the current character and the delta to add to give

65-- array, returning the current character and the delta to add to give

85-- the next offset to iterate at.

66-- the next offset to iterate at.

86iter :: Text -> Int -> Iter

67iter :: Text -> Int -> Iter

87−#ifndef __GHCJS__

88iter (Text arr off _len) i

68iter (Text arr off _len) i

89 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1

69 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1

90 | otherwise = Iter (chr2 m n) 2

70 | otherwise = Iter (chr2 m n) 2

@@ -92,40 +72,20 @@ iter (Text arr off _len) i

92 n = A.unsafeIndex arr k

72 n = A.unsafeIndex arr k

93 j = off + i

73 j = off + i

94 k = j + 1

74 k = j + 1

95−#else

96−iter (Text txt) i

97− | m < 0xD800 || m > 0xDBFF = Iter (C# (chr# m#)) 1

98− | otherwise = Iter (chr2 m n) 2

99− where m# = js_charCodeAt j txt

100− n# = js_charCodeAt k txt

101− m = W16# (int2Word# m#)

102− n = W16# (int2Word# n#)

103− j = off + i

104− k = j + 1

105− off = 0

106−#endif

107{-# INLINE iter #-}

75{-# INLINE iter #-}

108

109-- | /O(1)/ Iterate one step through a UTF-16 array, returning the

77-- | /O(1)/ Iterate one step through a UTF-16 array, returning the

110-- delta to add to give the next offset to iterate at.

78-- delta to add to give the next offset to iterate at.

111iter_ :: Text -> Int -> Int

79iter_ :: Text -> Int -> Int

112−#ifndef __GHCJS__

113iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1

80iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1

114 | otherwise = 2

81 | otherwise = 2

115 where m = A.unsafeIndex arr (off+i)

82 where m = A.unsafeIndex arr (off+i)

116−#else

117−iter_ (Text txt) i | m < 0xD800 || m > 0xDBFF = 1

118− | otherwise = 2

119− where m# = js_charCodeAt i txt

120− m = W16# (int2Word# m#)

121−#endif

122{-# INLINE iter_ #-}

83{-# INLINE iter_ #-}

123

124-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

85-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

125-- returning the current character and the delta to add (i.e. a

86-- returning the current character and the delta to add (i.e. a

126-- negative number) to give the next offset to iterate at.

87-- negative number) to give the next offset to iterate at.

127reverseIter :: Text -> Int -> (Char,Int)

88reverseIter :: Text -> Int -> (Char,Int)

128−#ifndef __GHCJS__

129reverseIter (Text arr off _len) i

89reverseIter (Text arr off _len) i

130 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)

90 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)

131 | otherwise = (chr2 n m, -2)

91 | otherwise = (chr2 n m, -2)

@@ -133,78 +93,31 @@ reverseIter (Text arr off _len) i

133 n = A.unsafeIndex arr k

93 n = A.unsafeIndex arr k

134 j = off + i

94 j = off + i

135 k = j - 1

95 k = j - 1

136−#else

137−reverseIter (Text txt) i

138− | m < 0xDC00 || m > 0xDFFF = (C# (chr# m#), -1)

139− | otherwise = (chr2 n m, -2)

140− where m# = js_charCodeAt j txt

141− n# = js_charCodeAt k txt

142− m = W16# (int2Word# m#)

143− n = W16# (int2Word# n#)

144− j = off + i

145− k = j - 1

146− off = 0

147−#endif

148{-# INLINE reverseIter #-}

96{-# INLINE reverseIter #-}

149

150-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

98-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

151-- returning the delta to add (i.e. a negative number) to give the

99-- returning the delta to add (i.e. a negative number) to give the

152-- next offset to iterate at.

100-- next offset to iterate at.

153reverseIter_ :: Text -> Int -> Int

101reverseIter_ :: Text -> Int -> Int

154−#ifndef __GHCJS__

155reverseIter_ (Text arr off _len) i

102reverseIter_ (Text arr off _len) i

156 | m < 0xDC00 || m > 0xDFFF = -1

103 | m < 0xDC00 || m > 0xDFFF = -1

157 | otherwise = -2

104 | otherwise = -2

158 where m = A.unsafeIndex arr (off+i)

105 where m = A.unsafeIndex arr (off+i)

159−#else

160−reverseIter_ (Text txt) i

161− | m < 0xDC00 || m > 0xDFFF = -1

162− | otherwise = -2

163− where m# = js_charCodeAt (off + i) txt

164− m = W16# (int2Word# m#)

165− off = 0

166−#endif

167{-# INLINE reverseIter_ #-}

106{-# INLINE reverseIter_ #-}

168

107

169-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

170-- is useful for sizing a target array appropriately before using

109-- is useful for sizing a target array appropriately before using

171-- 'unsafeCopyToPtr'.

110-- 'unsafeCopyToPtr'.

172lengthWord16 :: Text -> Int

111lengthWord16 :: Text -> Int

173−#ifndef __GHCJS__

174lengthWord16 (Text _arr _off len) = len

112lengthWord16 (Text _arr _off len) = len

175−#else

176−lengthWord16 (Text t) = js_length t

177−#endif

178{-# INLINE lengthWord16 #-}

113{-# INLINE lengthWord16 #-}

179

114

180-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.

115-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.

181takeWord16 :: Int -> Text -> Text

116takeWord16 :: Int -> Text -> Text

182−#ifndef __GHCJS__

183takeWord16 k (Text arr off _len) = Text arr off k

117takeWord16 k (Text arr off _len) = Text arr off k

184−#else

185−takeWord16 k (Text txt) = Text $ js_take k txt

186−#endif

187{-# INLINE takeWord16 #-}

118{-# INLINE takeWord16 #-}

188

119

189-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.

120-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.

190dropWord16 :: Int -> Text -> Text

121dropWord16 :: Int -> Text -> Text

191−#ifndef __GHCJS__

192dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)

122dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)

193−#else

194−dropWord16 k (Text txt) = Text $ js_drop k txt

195−#endif

196{-# INLINE dropWord16 #-}

123{-# INLINE dropWord16 #-}

197−

198−#ifdef __GHCJS__

199−foreign import javascript unsafe

200− "$2.charCodeAt($1)" js_charCodeAt :: Int -> JSString -> Int#

201−

202−foreign import javascript unsafe

203− "h$jsstringTake" js_take :: Int -> JSString -> JSString

204−

205−foreign import javascript unsafe

206− "h$jsstringDrop" js_drop :: Int -> JSString -> JSString

207−

208−foreign import javascript unsafe

209− "$1.length" js_length :: JSString -> Int

210−#endif

text.cabal+59−64

@@ -88,13 +88,13 @@ library

88 Data.Text.Array

89 Data.Text.Encoding

90 Data.Text.Encoding.Error

91− -- Data.Text.Foreign

91+ Data.Text.Foreign

92 Data.Text.IO

93 Data.Text.Internal

94 Data.Text.Internal.Builder

95− -- Data.Text.Internal.Builder.Functions

95+ Data.Text.Internal.Builder.Functions

96− -- Data.Text.Internal.Builder.Int.Digits

96+ Data.Text.Internal.Builder.Int.Digits

97− -- Data.Text.Internal.Builder.RealFloat.Functions

97+ Data.Text.Internal.Builder.RealFloat.Functions

98 Data.Text.Internal.Encoding.Fusion

99 Data.Text.Internal.Encoding.Fusion.Common

100 Data.Text.Internal.Encoding.Utf16

@@ -106,14 +106,14 @@ library

106 Data.Text.Internal.Fusion.Common

107 Data.Text.Internal.Fusion.Size

108 Data.Text.Internal.Fusion.Types

109− -- Data.Text.Internal.IO

109+ Data.Text.Internal.IO

110 Data.Text.Internal.Lazy

111− -- Data.Text.Internal.Lazy.Encoding.Fusion

111+ Data.Text.Internal.Lazy.Encoding.Fusion

112 Data.Text.Internal.Lazy.Fusion

113 Data.Text.Internal.Lazy.Search

114 Data.Text.Internal.Private

115 Data.Text.Internal.Read

116− -- Data.Text.Internal.Search

116+ Data.Text.Internal.Search

117 Data.Text.Internal.Unsafe

118 Data.Text.Internal.Unsafe.Char

119 Data.Text.Internal.Unsafe.Shift

@@ -124,23 +124,18 @@ library

124 Data.Text.Lazy.Encoding

125 Data.Text.Lazy.IO

126 Data.Text.Lazy.Internal

127− -- Data.Text.Lazy.Read

127+ Data.Text.Lazy.Read

128 Data.Text.Read

129 Data.Text.Unsafe

130

131− -- moved from ghcjs-base

132− -- reflex-dom depends in it

133− Data.JSString.Text

134− -- other-modules:

131+ other-modules:

135− -- Data.Text.Show

132+ Data.Text.Show

136

133

137 build-depends:

134 build-depends:

138− -- array >= 0.3,

135+ array >= 0.3,

139 base >= 4.2 && < 5,

136 base >= 4.2 && < 5,

140 binary,

137 binary,

141 deepseq >= 1.1.0.0,

138 deepseq >= 1.1.0.0,

142− ghcjs-base,

143− ghcjs-prim,

144 ghc-prim >= 0.2

139 ghc-prim >= 0.2

145

140

146 if flag(bytestring-builder)

141 if flag(bytestring-builder)

@@ -163,51 +158,51 @@ library

163 cpp-options: -DINTEGER_GMP

158 cpp-options: -DINTEGER_GMP

164 build-depends: integer-gmp >= 0.2

159 build-depends: integer-gmp >= 0.2

165

160

166−-- test-suite tests

161+test-suite tests

167−-- type: exitcode-stdio-1.0

162+ type: exitcode-stdio-1.0

168−-- hs-source-dirs: tests .

163+ hs-source-dirs: tests .

169−-- main-is: Tests.hs

164+ main-is: Tests.hs

170−-- c-sources: cbits/cbits.c

165+ c-sources: cbits/cbits.c

171−-- include-dirs: include

166+ include-dirs: include

172−

167+

173−-- ghc-options:

168+ ghc-options:

174−-- -Wall -threaded -O0 -rtsopts

169+ -Wall -threaded -O0 -rtsopts

175−

170+

176−-- cpp-options:

171+ cpp-options:

177−-- -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE

172+ -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE

178−

173+

179−-- build-depends:

174+ build-depends:

180−-- HUnit >= 1.2,

175+ HUnit >= 1.2,

181−-- QuickCheck >= 2.7,

176+ QuickCheck >= 2.7,

182−-- array,

177+ array,

183−-- base,

178+ base,

184−-- binary,

179+ binary,

185−-- deepseq,

180+ deepseq,

186−-- directory,

181+ directory,

187−-- ghc-prim,

182+ ghc-prim,

188−-- quickcheck-unicode,

183+ quickcheck-unicode,

189−-- random,

184+ random,

190−-- test-framework >= 0.4,

185+ test-framework >= 0.4,

191−-- test-framework-hunit >= 0.2,

186+ test-framework-hunit >= 0.2,

192−-- test-framework-quickcheck2 >= 0.2

187+ test-framework-quickcheck2 >= 0.2

193−

188+

194−-- if flag(bytestring-builder)

189+ if flag(bytestring-builder)

195−-- build-depends: bytestring >= 0.9 && < 0.10.4,

190+ build-depends: bytestring >= 0.9 && < 0.10.4,

196−-- bytestring-builder >= 0.10.4

191+ bytestring-builder >= 0.10.4

197−-- else

192+ else

198−-- build-depends: bytestring >= 0.10.4

193+ build-depends: bytestring >= 0.10.4

199−

194+

200−-- if flag(integer-simple)

195+ if flag(integer-simple)

201−-- cpp-options: -DINTEGER_SIMPLE

196+ cpp-options: -DINTEGER_SIMPLE

202−-- build-depends: integer-simple >= 0.1 && < 0.5

197+ build-depends: integer-simple >= 0.1 && < 0.5

203−-- else

198+ else

204−-- cpp-options: -DINTEGER_GMP

199+ cpp-options: -DINTEGER_GMP

205−-- build-depends: integer-gmp >= 0.2

200+ build-depends: integer-gmp >= 0.2

206−

201+

207−-- source-repository head

202+source-repository head

208−-- type: git

203+ type: git

209−-- location: https://github.com/bos/text

204+ location: https://github.com/bos/text

210−

205+

211−-- source-repository head

206+source-repository head

212−-- type: mercurial

207+ type: mercurial

213−-- location: https://bitbucket.org/bos/text

208+ location: https://bitbucket.org/bos/text