master...34541bf · text

git.iko.soy/text

on 34541bf help sign in

Data/JSString/Text.hsnew file+64

since splitsnapshots

unifiedsplit

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

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

2+ UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,

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

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

7+ -}

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+509−345

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

6#if __GLASGOW_HASKELL__ >= 708

7{-# LANGUAGE TypeFamilies #-}

8#endif

9−

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, firstf, mul, safe, text)

227+import Data.Text.Internal (Text(..), empty, 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,6 +246,53 @@ 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+

249-- $strict

296-- $strict

250--

297--

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

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

@@ -321,14 +368,19 @@ import Text.Printf (PrintfArg, formatArg, formatString)

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

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

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

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

323

370

371+-- instance Eq Text where

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

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

374+-- | otherwise = False

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

324instance Eq Text where

376instance Eq Text where

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

377+ Text x == Text y = x == y

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

378+

327− | otherwise = False

379+-- instance Ord Text where

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

380+-- compare = compareText

329

381

330instance Ord Text where

382instance Ord Text where

331− compare = compareText

383+ compare (Text x) (Text y) = compare x y

332

384

333instance Read Text where

385instance Read Text where

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

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

@@ -398,7 +450,7 @@ instance Data Text where

398#if MIN_VERSION_base(4,7,0)

450#if MIN_VERSION_base(4,7,0)

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

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

400instance PrintfArg Text where

452instance PrintfArg Text where

401− formatArg txt = formatString $ unpack txt

453+ formatArg t = formatString $ unpack t

402#endif

454#endif

403

455

404packConstr :: Constr

456packConstr :: Constr

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

407textDataType :: DataType

459textDataType :: DataType

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

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

409

461

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

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

411−compareText :: Text -> Text -> Ordering

463+-- compareText :: Text -> Text -> Ordering

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

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

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

465+-- | lenA == 0 && lenB == 0 = EQ

414− | otherwise = go 0 0

466+-- | otherwise = go 0 0

415− where

467+-- where

416− go !i !j

468+-- go !i !j

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

469+-- | i >= lenA || j >= lenB = compare lenA lenB

418− | a < b = LT

470+-- | a < b = LT

419− | a > b = GT

471+-- | a > b = GT

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

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

421− where Iter a di = iter ta i

473+-- where Iter a di = iter ta i

422− Iter b dj = iter tb j

474+-- Iter b dj = iter tb j

423

475

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

476-- -----------------------------------------------------------------------------

425-- * Conversion to/from 'Text'

477-- * Conversion to/from 'Text'

@@ -427,7 +479,8 @@ compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)

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

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

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

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

429pack :: String -> Text

481pack :: String -> Text

482+pack = coerce JSS.pack

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

483+-- pack = unstream . S.map safe . S.streamList

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

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

432

485

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

486-- -----------------------------------------------------------------------------

@@ -438,7 +491,8 @@ pack = unstream . S.map safe . S.streamList

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

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

439-- invalid scalar values.

492-- invalid scalar values.

440cons :: Char -> Text -> Text

493cons :: Char -> Text -> Text

494+cons = coerce JSS.cons

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

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

442{-# INLINE cons #-}

496{-# INLINE cons #-}

443

497

444infixr 5 `cons`

498infixr 5 `cons`

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

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

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

448-- Performs replacement on invalid scalar values.

502-- Performs replacement on invalid scalar values.

449snoc :: Text -> Char -> Text

503snoc :: Text -> Char -> Text

504+snoc = coerce JSS.snoc

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

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

451{-# INLINE snoc #-}

506{-# INLINE snoc #-}

452

507

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

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

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

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

455append :: Text -> Text -> Text

510append :: Text -> Text -> Text

511+append = coerce JSS.append

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

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

457− | len1 == 0 = b

513+-- | len1 == 0 = b

458− | len2 == 0 = a

514+-- | len2 == 0 = a

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

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

460− | otherwise = overflowError "append"

516+-- | otherwise = overflowError "append"

461− where

517+-- where

462− len = len1+len2

518+-- len = len1+len2

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

519+-- x :: ST s (A.MArray s)

464− x = do

520+-- x = do

465− arr <- A.new len

521+-- arr <- A.new len

466− A.copyI arr 0 arr1 off1 len1

522+-- A.copyI arr 0 arr1 off1 len1

467− A.copyI arr len1 arr2 off2 len

523+-- A.copyI arr len1 arr2 off2 len

468− return arr

524+-- return arr

469{-# NOINLINE append #-}

525{-# NOINLINE append #-}

470

526

471{-# RULES

527{-# RULES

@@ -478,16 +534,18 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)

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

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

479-- non-empty. Subject to fusion.

535-- non-empty. Subject to fusion.

480head :: Text -> Char

536head :: Text -> Char

537+head = coerce JSS.head

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

538+-- head t = S.head (stream t)

482{-# INLINE head #-}

539{-# INLINE head #-}

483

540

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

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

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

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

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

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

544+uncons = coerce JSS.uncons

487−uncons t@(Text arr off len)

545+-- uncons t@(Text arr off len)

488− | len <= 0 = Nothing

546+-- | len <= 0 = Nothing

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

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

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

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

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

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

492

550

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

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

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

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

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

498-- non-empty. Subject to fusion.

556-- non-empty. Subject to fusion.

499last :: Text -> Char

557last :: Text -> Char

558+last = coerce JSS.last

500−last (Text arr off len)

559+-- last (Text arr off len)

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

560+-- | len <= 0 = emptyError "last"

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

561+-- | n < 0xDC00 || n > 0xDFFF = unsafeChr n

503− | otherwise = U16.chr2 n0 n

562+-- | otherwise = U16.chr2 n0 n

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

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

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

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

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

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

507

566

508{-# RULES

567{-# RULES

@@ -515,10 +574,11 @@ last (Text arr off len)

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

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

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

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

517tail :: Text -> Text

576tail :: Text -> Text

577+tail = coerce JSS.tail

518−tail t@(Text arr off len)

578+-- tail t@(Text arr off len)

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

579+-- | len <= 0 = emptyError "tail"

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

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

521− where d = iter_ t 0

581+-- where d = iter_ t 0

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

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

523

583

524{-# RULES

584{-# RULES

@@ -531,11 +591,12 @@ tail t@(Text arr off len)

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

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

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

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

533init :: Text -> Text

593init :: Text -> Text

594+init = coerce JSS.init

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

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

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

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

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

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

537− where

598+-- where

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

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

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

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

540

601

541{-# RULES

602{-# RULES

@@ -548,11 +609,12 @@ init (Text arr off len) | len <= 0 = emptyError "init"

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

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

549-- fusion.

610-- fusion.

550null :: Text -> Bool

611null :: Text -> Bool

612+null = coerce JSS.null

551−null (Text _arr _off len) =

613+-- null (Text _arr _off len) =

552−#if defined(ASSERTS)

614+-- #if defined(ASSERTS)

553− assert (len >= 0) $

615+-- assert (len >= 0) $

554−#endif

616+-- #endif

555− len <= 0

617+-- len <= 0

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

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

557

619

558{-# RULES

620{-# RULES

@@ -564,14 +626,15 @@ null (Text _arr _off len) =

564

626

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

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

566-- Subject to fusion.

628-- Subject to fusion.

567−isSingleton :: Text -> Bool

629+-- isSingleton :: Text -> Bool

568−isSingleton = S.isSingleton . stream

630+-- isSingleton = S.isSingleton . stream

569−{-# INLINE isSingleton #-}

631+-- {-# INLINE isSingleton #-}

570

632

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

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

572-- Subject to fusion.

634-- Subject to fusion.

573length :: Text -> Int

635length :: Text -> Int

636+length = coerce JSS.length

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

637+-- length t = S.length (stream t)

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

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

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

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

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

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

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

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

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

628-- invalid scalar values.

691-- invalid scalar values.

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

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

693+map = coerce JSS.map

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

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

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

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

632

696

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

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

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

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

635-- argument between each element of the list.

699-- argument between each element of the list.

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

700intercalate :: Text -> [Text] -> Text

701+intercalate = coerce JSS.intercalate

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

702+-- intercalate t = concat . (F.intersperse t)

638{-# INLINE intercalate #-}

703{-# INLINE intercalate #-}

639

704

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

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

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

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

642-- replacement on invalid scalar values.

707-- replacement on invalid scalar values.

643intersperse :: Char -> Text -> Text

708intersperse :: Char -> Text -> Text

709+intersperse = coerce JSS.intersperse

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

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

645{-# INLINE intersperse #-}

711{-# INLINE intersperse #-}

646

712

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

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

648reverse :: Text -> Text

714reverse :: Text -> Text

715+reverse = coerce JSS.reverse

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

716+-- reverse t = S.reverse (stream t)

650{-# INLINE reverse #-}

717{-# INLINE reverse #-}

651

718

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

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

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

680 -> Text

747 -> Text

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

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

682 -> Text

749 -> Text

750+replace = coerce JSS.replace

683−replace needle@(Text _ _ neeLen)

751+-- replace needle@(Text _ _ neeLen)

684− (Text repArr repOff repLen)

752+-- (Text repArr repOff repLen)

685− haystack@(Text hayArr hayOff hayLen)

753+-- haystack@(Text hayArr hayOff hayLen)

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

754+-- | neeLen == 0 = emptyError "replace"

687− | L.null ixs = haystack

755+-- | L.null ixs = haystack

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

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

689− | otherwise = empty

757+-- | otherwise = empty

690− where

758+-- where

691− ixs = indices needle haystack

759+-- ixs = indices needle haystack

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

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

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

761+-- x :: ST s (A.MArray s)

694− x = do

762+-- x = do

695− marr <- A.new len

763+-- marr <- A.new len

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

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

697− let d0 = d + i - o

765+-- let d0 = d + i - o

698− d1 = d0 + repLen

766+-- d1 = d0 + repLen

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

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

700− A.copyI marr d0 repArr repOff d1

768+-- A.copyI marr d0 repArr repOff d1

701− loop is (i + neeLen) d1

769+-- loop is (i + neeLen) d1

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

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

703− loop ixs 0 0

771+-- loop ixs 0 0

704− return marr

772+-- return marr

705

773

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

774-- ----------------------------------------------------------------------------

707-- ** Case conversions (folds)

775-- ** Case conversions (folds)

@@ -740,7 +808,8 @@ replace needle@(Text _ _ neeLen)

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

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

741-- instead of itself.

809-- instead of itself.

742toCaseFold :: Text -> Text

810toCaseFold :: Text -> Text

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

811+-- toCaseFold t = unstream (S.toCaseFold (stream t))

812+toCaseFold = coerce JSS.toCaseFold

744{-# INLINE toCaseFold #-}

813{-# INLINE toCaseFold #-}

745

814

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

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

@@ -751,7 +820,8 @@ toCaseFold t = unstream (S.toCaseFold (stream t))

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

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

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

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

753toLower :: Text -> Text

822toLower :: Text -> Text

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

823+-- toLower t = unstream (S.toLower (stream t))

824+toLower = coerce JSS.toLower

755{-# INLINE toLower #-}

825{-# INLINE toLower #-}

756

826

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

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

@@ -761,7 +831,8 @@ toLower t = unstream (S.toLower (stream t))

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

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

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

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

763toUpper :: Text -> Text

833toUpper :: Text -> Text

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

834+-- toUpper t = unstream (S.toUpper (stream t))

835+toUpper = coerce JSS.toUpper

765{-# INLINE toUpper #-}

836{-# INLINE toUpper #-}

766

837

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

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

@@ -783,7 +854,8 @@ toUpper t = unstream (S.toUpper (stream t))

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

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

784-- capitalize /every/ word.

855-- capitalize /every/ word.

785toTitle :: Text -> Text

856toTitle :: Text -> Text

857+toTitle = coerce JSS.toTitle

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

858+-- toTitle t = unstream (S.toTitle (stream t))

787{-# INLINE toTitle #-}

859{-# INLINE toTitle #-}

788

860

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

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

@@ -795,10 +867,11 @@ toTitle t = unstream (S.toTitle (stream t))

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

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

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

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

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

869justifyLeft :: Int -> Char -> Text -> Text

798−justifyLeft k c t

870+justifyLeft = coerce JSS.justifyLeft

871+-- justifyLeft k c t

799− | len >= k = t

872+-- | len >= k = t

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

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

801− where len = length t

874+-- where len = length t

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

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

803

876

804{-# RULES

877{-# RULES

@@ -817,10 +890,11 @@ justifyLeft k c t

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

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

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

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

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

892justifyRight :: Int -> Char -> Text -> Text

820−justifyRight k c t

893+justifyRight = coerce JSS.justifyRight

894+-- justifyRight k c t

821− | len >= k = t

895+-- | len >= k = t

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

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

823− where len = length t

897+-- where len = length t

824{-# INLINE justifyRight #-}

898{-# INLINE justifyRight #-}

825

899

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

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

@@ -831,13 +905,14 @@ justifyRight k c t

831--

905--

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

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

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

907center :: Int -> Char -> Text -> Text

834−center k c t

908+center = coerce JSS.center

909+-- center k c t

835− | len >= k = t

910+-- | len >= k = t

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

911+-- | otherwise = replicateChar l c `append` t `append` replicateChar r c

837− where len = length t

912+-- where len = length t

838− d = k - len

913+-- d = k - len

839− r = d `quot` 2

914+-- r = d `quot` 2

840− l = d - r

915+-- l = d - r

841{-# INLINE center #-}

916{-# INLINE center #-}

842

917

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

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

@@ -845,7 +920,8 @@ center k c t

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

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

846-- efficient.

921-- efficient.

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

922transpose :: [Text] -> [Text]

923+transpose = coerce JSS.transpose

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

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

849

925

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

926-- -----------------------------------------------------------------------------

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

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

@@ -855,23 +931,27 @@ transpose ts = P.map pack (L.transpose (P.map unpack ts))

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

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

856-- Subject to fusion.

932-- Subject to fusion.

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

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

934+foldl f a0 (Text t) = JSS.foldl f a0 t

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

935+-- foldl f z t = S.foldl f z (stream t)

859{-# INLINE foldl #-}

936{-# INLINE foldl #-}

860

937

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

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

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

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

940+foldl' f a0 (Text t) = JSS.foldl' f a0 t

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

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

864{-# INLINE foldl' #-}

942{-# INLINE foldl' #-}

865

943

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

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

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

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

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

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

947+foldl1 = coerce JSS.foldl1

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

948+-- foldl1 f t = S.foldl1 f (stream t)

870{-# INLINE foldl1 #-}

949{-# INLINE foldl1 #-}

871

950

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

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

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

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

953+foldl1' = coerce JSS.foldl1'

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

954+-- foldl1' f t = S.foldl1' f (stream t)

875{-# INLINE foldl1' #-}

955{-# INLINE foldl1' #-}

876

956

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

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

@@ -879,14 +959,16 @@ foldl1' f t = S.foldl1' f (stream t)

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

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

880-- Subject to fusion.

960-- Subject to fusion.

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

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

962+foldr f a0 (Text t) = JSS.foldr f a0 t

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

963+-- foldr f z t = S.foldr f z (stream t)

883{-# INLINE foldr #-}

964{-# INLINE foldr #-}

884

965

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

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

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

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

887-- fusion.

968-- fusion.

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

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

970+foldr1 = coerce JSS.foldr1

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

971+-- foldr1 f t = S.foldr1 f (stream t)

890{-# INLINE foldr1 #-}

972{-# INLINE foldr1 #-}

891

973

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

974-- -----------------------------------------------------------------------------

@@ -894,48 +976,54 @@ foldr1 f t = S.foldr1 f (stream t)

894

976

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

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

896concat :: [Text] -> Text

978concat :: [Text] -> Text

979+concat = coerce JSS.concat

897−concat ts = case ts' of

980+-- concat ts = case ts' of

898− [] -> empty

981+-- [] -> empty

899− [t] -> t

982+-- [t] -> t

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

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

901− where

984+-- where

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

985+-- ts' = L.filter (not . null) ts

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

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

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

987+-- go :: ST s (A.MArray s)

905− go = do

988+-- go = do

906− arr <- A.new len

989+-- arr <- A.new len

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

990+-- let step i (Text a o l) =

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

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

909− foldM step 0 ts' >> return arr

992+-- foldM step 0 ts' >> return arr

910

993

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

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

912-- concatenate the results.

995-- concatenate the results.

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

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

997+concatMap = coerce JSS.concatMap

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

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

915{-# INLINE concatMap #-}

999{-# INLINE concatMap #-}

916

1000

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

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

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

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

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

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

1004+any = coerce JSS.any

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

1005+-- any p t = S.any p (stream t)

921{-# INLINE any #-}

1006{-# INLINE any #-}

922

1007

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

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

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

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

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

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

1011+all = coerce JSS.all

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

1012+-- all p t = S.all p (stream t)

927{-# INLINE all #-}

1013{-# INLINE all #-}

928

1014

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

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

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

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

931maximum :: Text -> Char

1017maximum :: Text -> Char

1018+maximum = coerce JSS.maximum

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

1019+-- maximum t = S.maximum (stream t)

933{-# INLINE maximum #-}

1020{-# INLINE maximum #-}

934

1021

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

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

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

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

937minimum :: Text -> Char

1024minimum :: Text -> Char

1025+minimum = coerce JSS.minimum

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

1026+-- minimum t = S.minimum (stream t)

939{-# INLINE minimum #-}

1027{-# INLINE minimum #-}

940

1028

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

1029-- -----------------------------------------------------------------------------

@@ -951,8 +1039,9 @@ minimum t = S.minimum (stream t)

951--

1039--

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

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

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

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

1042+scanl = coerce JSS.scanl

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

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

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

1044+-- where g a b = safe (f a b)

956{-# INLINE scanl #-}

1045{-# INLINE scanl #-}

957

1046

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

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

@@ -961,8 +1050,9 @@ scanl f z t = unstream (S.scanl g z (stream t))

961--

1050--

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

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

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

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

1053+scanl1 = coerce JSS.scanl1

964−scanl1 f t | null t = empty

1054+-- scanl1 f t | null t = empty

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

1055+-- | otherwise = scanl f (unsafeHead t) (unsafeTail t)

966{-# INLINE scanl1 #-}

1056{-# INLINE scanl1 #-}

967

1057

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

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

@@ -970,16 +1060,18 @@ scanl1 f t | null t = empty

970--

1060--

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

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

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

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

1063+scanr = coerce JSS.scanr

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

1064+-- scanr f z = S.reverse . S.reverseScanr g z . reverseStream

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

1065+-- where g a b = safe (f a b)

975{-# INLINE scanr #-}

1066{-# INLINE scanr #-}

976

1067

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

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

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

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

979-- invalid scalar values.

1070-- invalid scalar values.

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

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

1072+scanr1 = coerce JSS.scanr1

981−scanr1 f t | null t = empty

1073+-- scanr1 f t | null t = empty

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

1074+-- | otherwise = scanr f (last t) (init t)

983{-# INLINE scanr1 #-}

1075{-# INLINE scanr1 #-}

984

1076

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

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

@@ -987,8 +1079,11 @@ scanr1 f t | null t = empty

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

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

988-- replacement on invalid scalar values.

1080-- replacement on invalid scalar values.

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

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

1082+mapAccumL f z0 (Text a) =

1083+ let (a', t) = JSS.mapAccumL f z0 a

1084+ in (a', Text t)

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

1085+-- mapAccumL f z0 = S.mapAccumL g z0 . stream

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

1086+-- where g a b = second safe (f a b)

992{-# INLINE mapAccumL #-}

1087{-# INLINE mapAccumL #-}

993

1088

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

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

@@ -998,8 +1093,11 @@ mapAccumL f z0 = S.mapAccumL g z0 . stream

998-- 'Text'.

1093-- 'Text'.

999-- Performs replacement on invalid scalar values.

1094-- Performs replacement on invalid scalar values.

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

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

1096+mapAccumR f z0 (Text a) =

1097+ let (a', t) = JSS.mapAccumR f z0 a

1098+ in (a', Text t)

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

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

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

1100+-- where g a b = second safe (f a b)

1003{-# INLINE mapAccumR #-}

1101{-# INLINE mapAccumR #-}

1004

1102

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

1103-- -----------------------------------------------------------------------------

@@ -1008,20 +1106,21 @@ mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream

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

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

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

1107-- @t@ repeated @n@ times.

1010replicate :: Int -> Text -> Text

1108replicate :: Int -> Text -> Text

1109+replicate = coerce JSS.replicate

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

1110+-- replicate n t@(Text a o l)

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

1111+-- | n <= 0 || l <= 0 = empty

1013− | n == 1 = t

1112+-- | n == 1 = t

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

1113+-- | isSingleton t = replicateChar n (unsafeHead t)

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

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

1016− where

1115+-- where

1017− len = l `mul` n

1116+-- len = l `mul` n

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

1117+-- x :: ST s (A.MArray s)

1019− x = do

1118+-- x = do

1020− arr <- A.new len

1119+-- arr <- A.new len

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

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

1022− | otherwise = let m = d + l

1121+-- | otherwise = let m = d + l

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

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

1024− loop 0 0

1123+-- loop 0 0

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

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

1026

1125

1027{-# RULES

1126{-# RULES

@@ -1032,8 +1131,19 @@ replicate n t@(Text a o l)

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

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

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

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

1034replicateChar :: Int -> Char -> Text

1133replicateChar :: Int -> Char -> Text

1134+#ifndef __GHCJS__

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

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

1036{-# INLINE replicateChar #-}

1136{-# INLINE replicateChar #-}

1137+#else

1138+replicateChar n c = Text $ js_replicateChar n c

1139+{-# INLINE [1] replicateChar #-}

1140+{-# RULES

1141+"JSSTRING replicateChar -> fused" [~1] forall n c.

1142+ replicateChar n c = unstream (S.replicateCharI n (safe c))

1143+"JSSTRING replicateChar -> unfused" [1] forall n c.

1144+ unstream (S.replicateCharI n (safe c)) = replicateChar n c

1145+ #-}

1146+#endif

1037

1147

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

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

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

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

@@ -1043,7 +1153,8 @@ replicateChar n c = unstream (S.replicateCharI n (safe c))

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

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

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

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

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

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

1156+unfoldr f a = Text $ JSS.unfoldr f a

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

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

1047{-# INLINE unfoldr #-}

1158{-# INLINE unfoldr #-}

1048

1159

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

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

@@ -1053,7 +1164,8 @@ unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)

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

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

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

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

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

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

1167+unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0

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

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

1057{-# INLINE unfoldrN #-}

1169{-# INLINE unfoldrN #-}

1058

1170

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

1171-- -----------------------------------------------------------------------------

@@ -1063,18 +1175,19 @@ unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)

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

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

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

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

1065take :: Int -> Text -> Text

1177take :: Int -> Text -> Text

1178+take = coerce JSS.take

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

1179+-- take n t@(Text arr off len)

1067− | n <= 0 = empty

1180+-- | n <= 0 = empty

1068− | n >= len = t

1181+-- | n >= len = t

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

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

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

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

1071

1184

1072−iterN :: Int -> Text -> Int

1185+-- iterN :: Int -> Text -> Int

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

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

1074− where loop !i !cnt

1187+-- where loop !i !cnt

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

1188+-- | i >= len || cnt >= n = i

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

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

1077− where d = iter_ t i

1190+-- where d = iter_ t i

1078

1191

1079{-# RULES

1192{-# RULES

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

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

@@ -1090,29 +1203,31 @@ iterN n t@(Text _arr _off len) = loop 0 0

1090--

1203--

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

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

1092takeEnd :: Int -> Text -> Text

1205takeEnd :: Int -> Text -> Text

1206+takeEnd = coerce JSS.takeEnd

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

1207+-- takeEnd n t@(Text arr off len)

1094− | n <= 0 = empty

1208+-- | n <= 0 = empty

1095− | n >= len = t

1209+-- | n >= len = t

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

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

1097− where i = iterNEnd n t

1211+-- where i = iterNEnd n t

1098−

1212+

1099−iterNEnd :: Int -> Text -> Int

1213+-- iterNEnd :: Int -> Text -> Int

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

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

1101− where loop i !m

1215+-- where loop i !m

1102− | i <= 0 = 0

1216+-- | i <= 0 = 0

1103− | m <= 1 = i

1217+-- | m <= 1 = i

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

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

1105− where d = reverseIter_ t i

1219+-- where d = reverseIter_ t i

1106

1220

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

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

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

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

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

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

1110drop :: Int -> Text -> Text

1224drop :: Int -> Text -> Text

1225+drop = coerce JSS.drop

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

1226+-- drop n t@(Text arr off len)

1112− | n <= 0 = t

1227+-- | n <= 0 = t

1113− | n >= len = empty

1228+-- | n >= len = empty

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

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

1115− where i = iterN n t

1230+-- where i = iterN n t

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

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

1117

1232

1118{-# RULES

1233{-# RULES

@@ -1129,20 +1244,22 @@ drop n t@(Text arr off len)

1129--

1244--

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

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

1131dropEnd :: Int -> Text -> Text

1246dropEnd :: Int -> Text -> Text

1247+dropEnd = coerce JSS.dropEnd

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

1248+-- dropEnd n t@(Text arr off len)

1133− | n <= 0 = t

1249+-- | n <= 0 = t

1134− | n >= len = empty

1250+-- | n >= len = empty

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

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

1136

1252

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

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

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

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

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

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

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

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

1257+takeWhile = coerce JSS.takeWhile

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

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

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

1259+-- where loop !i | i >= len = t

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

1260+-- | p c = loop (i+d)

1144− | otherwise = text arr off i

1261+-- | otherwise = text arr off i

1145− where Iter c d = iter t i

1262+-- where Iter c d = iter t i

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

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

1147

1264

1148{-# RULES

1265{-# RULES

@@ -1159,11 +1276,20 @@ takeWhile p t@(Text arr off len) = loop 0

1159--

1276--

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

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

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

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

1279+#ifndef __GHCJS__

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

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

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

1281 where loop !i !l | l <= 0 = t

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

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

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

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

1166 where (c,d) = reverseIter t i

1284 where (c,d) = reverseIter t i

1285+#else

1286+takeWhileEnd p t@(Text jst) = loop (len-1) len

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

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

1289+ | otherwise = Text $ js_substr1 l jst

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

1291+ len = length t

1292+#endif

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

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

1168

1294

1169{-# RULES

1295{-# RULES

@@ -1176,11 +1302,12 @@ takeWhileEnd p t@(Text arr off len) = loop (len-1) len

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

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

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

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

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

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

1305+dropWhile = coerce JSS.dropWhile

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

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

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

1307+-- where loop !i !l | l >= len = empty

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

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

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

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

1183− where Iter c d = iter t i

1310+

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

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

1185

1312

1186{-# RULES

1313{-# RULES

@@ -1198,11 +1325,12 @@ dropWhile p t@(Text arr off len) = loop 0 0

1198--

1325--

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

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

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

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

1328+dropWhileEnd = coerce JSS.dropWhileEnd

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

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

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

1330+-- where loop !i !l | l <= 0 = empty

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

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

1204− | otherwise = Text arr off l

1332+-- | otherwise = Text arr off l

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

1333+-- where (c,d) = reverseIter t i

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

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

1207

1335

1208{-# RULES

1336{-# RULES

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

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

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

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

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

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

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

1376+splitAt = coerce JSS.splitAt

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

1377+-- splitAt n t@(Text arr off len)

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

1378+-- | n <= 0 = (empty, t)

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

1379+-- | n >= len = (t, empty)

1251− | otherwise = let k = iterN n t

1380+-- | otherwise = let k = iterN n t

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

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

1253

1382

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

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

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

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

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

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

1257-- remainder of the list.

1386-- remainder of the list.

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

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

1388+span = coerce JSS.span

1259−span p t = case span_ p t of

1389+-- span p t = case span_ p t of

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

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

1261{-# INLINE span #-}

1391{-# INLINE span #-}

1262

1392

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

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

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

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

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

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

1396+break = coerce JSS.break

1266−break p = span (not . p)

1397+-- break p = span (not . p)

1267{-# INLINE break #-}

1398{-# INLINE break #-}

1268

1399

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

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

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

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

1402+groupBy = coerce JSS.groupBy

1271−groupBy p = loop

1403+-- groupBy p = loop

1272− where

1404+-- where

1273− loop t@(Text arr off len)

1405+-- loop t@(Text arr off len)

1274− | null t = []

1406+-- | null t = []

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

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

1276− where Iter c d = iter t 0

1408+-- where Iter c d = iter t 0

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

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

1278

1410

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

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

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

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

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

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

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

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

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

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

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

1416+-- where go !i | i >= len || q c = i

1285− | otherwise = go (i+d)

1417+-- | otherwise = go (i+d)

1286− where Iter c d = iter t i

1418+-- where Iter c d = iter t i

1287

1419

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

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

1289group :: Text -> [Text]

1421group :: Text -> [Text]

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

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

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

1293-- first.

1425-- first.

1294inits :: Text -> [Text]

1426inits :: Text -> [Text]

1427+inits = coerce JSS.inits

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

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

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

1429+-- where loop i | i >= len = [t]

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

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

1298

1431

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

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

1300-- first.

1433-- first.

1301tails :: Text -> [Text]

1434tails :: Text -> [Text]

1435+tails = coerce JSS.tails

1302−tails t | null t = [empty]

1436+-- tails t | null t = [empty]

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

1437+-- | otherwise = t : tails (unsafeTail t)

1304

1438

1305-- $split

1439-- $split

1306--

1440--

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

1333 -> Text

1467 -> Text

1334 -- ^ Input text.

1468 -- ^ Input text.

1335 -> [Text]

1469 -> [Text]

1470+splitOn = coerce JSS.splitOn

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

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

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

1472+-- | l <= 0 = emptyError "splitOn"

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

1473+-- | isSingleton pat = split (== unsafeHead pat) src

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

1474+-- | otherwise = go 0 (indices pat src)

1340− where

1475+-- where

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

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

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

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

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

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

1344

1479

1345{-# RULES

1480{-# RULES

@@ -1355,11 +1490,12 @@ splitOn pat@(Text _ _ l) src@(Text arr off len)

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

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

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

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

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

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

1493+split = coerce JSS.split

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

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

1359−split p t = loop t

1495+-- split p t = loop t

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

1496+-- where loop s | null s' = [l]

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

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

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

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

1363{-# INLINE split #-}

1499{-# INLINE split #-}

1364

1500

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

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

@@ -1369,11 +1505,12 @@ split p t = loop t

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

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

1370-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]

1506-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]

1371chunksOf :: Int -> Text -> [Text]

1507chunksOf :: Int -> Text -> [Text]

1372−chunksOf k = go

1508+chunksOf = coerce JSS.chunksOf

1509+-- chunksOf k = go

1373− where

1510+-- where

1374− go t = case splitAt k t of

1511+-- go t = case splitAt k t of

1375− (a,b) | null a -> []

1512+-- (a,b) | null a -> []

1376− | otherwise -> a : go b

1513+-- | otherwise -> a : go b

1377{-# INLINE chunksOf #-}

1514{-# INLINE chunksOf #-}

1378

1515

1379-- ----------------------------------------------------------------------------

1516-- ----------------------------------------------------------------------------

@@ -1386,7 +1523,8 @@ chunksOf k = go

1386-- returns the first element matching the predicate, or 'Nothing' if

1523-- returns the first element matching the predicate, or 'Nothing' if

1387-- there is no such element.

1524-- there is no such element.

1388find :: (Char -> Bool) -> Text -> Maybe Char

1525find :: (Char -> Bool) -> Text -> Maybe Char

1526+find = coerce JSS.find

1389−find p t = S.findBy p (stream t)

1527+-- find p t = S.findBy p (stream t)

1390{-# INLINE find #-}

1528{-# INLINE find #-}

1391

1529

1392-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',

1530-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',

@@ -1395,14 +1533,16 @@ find p t = S.findBy p (stream t)

1395--

1533--

1396-- > partition p t == (filter p t, filter (not . p) t)

1534-- > partition p t == (filter p t, filter (not . p) t)

1397partition :: (Char -> Bool) -> Text -> (Text, Text)

1535partition :: (Char -> Bool) -> Text -> (Text, Text)

1536+partition = coerce JSS.partition

1398−partition p t = (filter p t, filter (not . p) t)

1537+-- partition p t = (filter p t, filter (not . p) t)

1399{-# INLINE partition #-}

1538{-# INLINE partition #-}

1400

1539

1401-- | /O(n)/ 'filter', applied to a predicate and a 'Text',

1540-- | /O(n)/ 'filter', applied to a predicate and a 'Text',

1402-- returns a 'Text' containing those characters that satisfy the

1541-- returns a 'Text' containing those characters that satisfy the

1403-- predicate.

1542-- predicate.

1404filter :: (Char -> Bool) -> Text -> Text

1543filter :: (Char -> Bool) -> Text -> Text

1544+filter = coerce JSS.filter

1405−filter p t = unstream (S.filter p (stream t))

1545+-- filter p t = unstream (S.filter p (stream t))

1406{-# INLINE filter #-}

1546{-# INLINE filter #-}

1407

1547

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

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

@@ -1427,11 +1567,12 @@ filter p t = unstream (S.filter p (stream t))

1427-- In (unlikely) bad cases, this function's time complexity degrades

1567-- In (unlikely) bad cases, this function's time complexity degrades

1428-- towards /O(n*m)/.

1568-- towards /O(n*m)/.

1429breakOn :: Text -> Text -> (Text, Text)

1569breakOn :: Text -> Text -> (Text, Text)

1570+breakOn = coerce JSS.breakOn

1430−breakOn pat src@(Text arr off len)

1571+-- breakOn pat src@(Text arr off len)

1431− | null pat = emptyError "breakOn"

1572+-- | null pat = emptyError "breakOn"

1432− | otherwise = case indices pat src of

1573+-- | otherwise = case indices pat src of

1433− [] -> (src, empty)

1574+-- [] -> (src, empty)

1434− (x:_) -> (text arr off x, text arr (off+x) (len-x))

1575+-- (x:_) -> (text arr off x, text arr (off+x) (len-x))

1435{-# INLINE breakOn #-}

1576{-# INLINE breakOn #-}

1436

1577

1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the

1578-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the

@@ -1443,8 +1584,9 @@ breakOn pat src@(Text arr off len)

1443--

1584--

1444-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")

1585-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")

1445breakOnEnd :: Text -> Text -> (Text, Text)

1586breakOnEnd :: Text -> Text -> (Text, Text)

1587+breakOnEnd = coerce JSS.breakOnEnd

1446−breakOnEnd pat src = (reverse b, reverse a)

1588+-- breakOnEnd pat src = (reverse b, reverse a)

1447− where (a,b) = breakOn (reverse pat) (reverse src)

1589+-- where (a,b) = breakOn (reverse pat) (reverse src)

1448{-# INLINE breakOnEnd #-}

1590{-# INLINE breakOnEnd #-}

1449

1591

1450-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in

1592-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in

@@ -1468,12 +1610,13 @@ breakOnEnd pat src = (reverse b, reverse a)

1468breakOnAll :: Text -- ^ @needle@ to search for

1610breakOnAll :: Text -- ^ @needle@ to search for

1469 -> Text -- ^ @haystack@ in which to search

1611 -> Text -- ^ @haystack@ in which to search

1470 -> [(Text, Text)]

1612 -> [(Text, Text)]

1613+breakOnAll = coerce JSS.breakOnAll

1471−breakOnAll pat src@(Text arr off slen)

1614+-- breakOnAll pat src@(Text arr off slen)

1472− | null pat = emptyError "breakOnAll"

1615+-- | null pat = emptyError "breakOnAll"

1473− | otherwise = L.map step (indices pat src)

1616+-- | otherwise = L.map step (indices pat src)

1474− where

1617+-- where

1475− step x = (chunk 0 x, chunk x (slen-x))

1618+-- step x = (chunk 0 x, chunk x (slen-x))

1476− chunk !n !l = text arr (n+off) l

1619+-- chunk !n !l = text arr (n+off) l

1477{-# INLINE breakOnAll #-}

1620{-# INLINE breakOnAll #-}

1478

1621

1479-------------------------------------------------------------------------------

1622-------------------------------------------------------------------------------

@@ -1497,14 +1640,16 @@ breakOnAll pat src@(Text arr off slen)

1497

1640

1498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.

1641-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.

1499index :: Text -> Int -> Char

1642index :: Text -> Int -> Char

1643+index = coerce JSS.index

1500−index t n = S.index (stream t) n

1644+-- index t n = S.index (stream t) n

1501{-# INLINE index #-}

1645{-# INLINE index #-}

1502

1646

1503-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'

1647-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'

1504-- and returns the index of the first element in the 'Text' satisfying

1648-- and returns the index of the first element in the 'Text' satisfying

1505-- the predicate. Subject to fusion.

1649-- the predicate. Subject to fusion.

1506findIndex :: (Char -> Bool) -> Text -> Maybe Int

1650findIndex :: (Char -> Bool) -> Text -> Maybe Int

1651+findIndex = coerce JSS.findIndex

1507−findIndex p t = S.findIndex p (stream t)

1652+-- findIndex p t = S.findIndex p (stream t)

1508{-# INLINE findIndex #-}

1653{-# INLINE findIndex #-}

1509

1654

1510-- | /O(n+m)/ The 'count' function returns the number of times the

1655-- | /O(n+m)/ The 'count' function returns the number of times the

@@ -1514,10 +1659,11 @@ findIndex p t = S.findIndex p (stream t)

1514-- In (unlikely) bad cases, this function's time complexity degrades

1659-- In (unlikely) bad cases, this function's time complexity degrades

1515-- towards /O(n*m)/.

1660-- towards /O(n*m)/.

1516count :: Text -> Text -> Int

1661count :: Text -> Text -> Int

1662+count = coerce JSS.count

1517−count pat src

1663+-- count pat src

1518− | null pat = emptyError "count"

1664+-- | null pat = emptyError "count"

1519− | isSingleton pat = countChar (unsafeHead pat) src

1665+-- | isSingleton pat = countChar (unsafeHead pat) src

1520− | otherwise = L.length (indices pat src)

1666+-- | otherwise = L.length (indices pat src)

1521{-# INLINE [1] count #-}

1667{-# INLINE [1] count #-}

1522

1668

1523{-# RULES

1669{-# RULES

@@ -1539,42 +1685,46 @@ countChar c t = S.countChar c (stream t)

1539-- excess elements of the longer 'Text' are discarded. This is

1685-- excess elements of the longer 'Text' are discarded. This is

1540-- equivalent to a pair of 'unpack' operations.

1686-- equivalent to a pair of 'unpack' operations.

1541zip :: Text -> Text -> [(Char,Char)]

1687zip :: Text -> Text -> [(Char,Char)]

1688+zip = coerce JSS.zip

1542−zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)

1689+-- zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)

1543{-# INLINE zip #-}

1690{-# INLINE zip #-}

1544

1691

1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function

1692-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function

1546-- given as the first argument, instead of a tupling function.

1693-- given as the first argument, instead of a tupling function.

1547-- Performs replacement on invalid scalar values.

1694-- Performs replacement on invalid scalar values.

1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text

1695zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text

1696+zipWith = coerce JSS.zipWith

1549−zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))

1697+-- zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))

1550− where g a b = safe (f a b)

1698+-- where g a b = safe (f a b)

1551{-# INLINE zipWith #-}

1699{-# INLINE zipWith #-}

1552

1700

1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's

1701-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's

1554-- representing white space.

1702-- representing white space.

1555words :: Text -> [Text]

1703words :: Text -> [Text]

1704+words = coerce JSS.words

1556−words t@(Text arr off len) = loop 0 0

1705+-- words t@(Text arr off len) = loop 0 0

1557− where

1706+-- where

1558− loop !start !n

1707+-- loop !start !n

1559− | n >= len = if start == n

1708+-- | n >= len = if start == n

1560− then []

1709+-- then []

1561− else [Text arr (start+off) (n-start)]

1710+-- else [Text arr (start+off) (n-start)]

1562− | isSpace c =

1711+-- | isSpace c =

1563− if start == n

1712+-- if start == n

1564− then loop (start+1) (start+1)

1713+-- then loop (start+1) (start+1)

1565− else Text arr (start+off) (n-start) : loop (n+d) (n+d)

1714+-- else Text arr (start+off) (n-start) : loop (n+d) (n+d)

1566− | otherwise = loop start (n+d)

1715+-- | otherwise = loop start (n+d)

1567− where Iter c d = iter t n

1716+-- where Iter c d = iter t n

1568{-# INLINE words #-}

1717{-# INLINE words #-}

1569

1718

1570-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at

1719-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at

1571-- newline 'Char's. The resulting strings do not contain newlines.

1720-- newline 'Char's. The resulting strings do not contain newlines.

1572lines :: Text -> [Text]

1721lines :: Text -> [Text]

1722+lines = coerce JSS.lines

1573−lines ps | null ps = []

1723+-- lines ps | null ps = []

1574− | otherwise = h : if null t

1724+-- | otherwise = h : if null t

1575− then []

1725+-- then []

1576− else lines (unsafeTail t)

1726+-- else lines (unsafeTail t)

1577− where (# h,t #) = span_ (/= '\n') ps

1727+-- where (# h,t #) = span_ (/= '\n') ps

1578{-# INLINE lines #-}

1728{-# INLINE lines #-}

1579

1729

1580{-

1730{-

@@ -1602,34 +1752,40 @@ lines' ps | null ps = []

1602-- | /O(n)/ Joins lines, after appending a terminating newline to

1752-- | /O(n)/ Joins lines, after appending a terminating newline to

1603-- each.

1753-- each.

1604unlines :: [Text] -> Text

1754unlines :: [Text] -> Text

1755+unlines = coerce JSS.unlines

1605−unlines = concat . L.map (`snoc` '\n')

1756+-- unlines = concat . L.map (`snoc` '\n')

1606{-# INLINE unlines #-}

1757{-# INLINE unlines #-}

1607

1758

1608-- | /O(n)/ Joins words using single space characters.

1759-- | /O(n)/ Joins words using single space characters.

1609unwords :: [Text] -> Text

1760unwords :: [Text] -> Text

1761+unwords = coerce JSS.unwords

1610−unwords = intercalate (singleton ' ')

1762+-- unwords = intercalate (singleton ' ')

1611{-# INLINE unwords #-}

1763{-# INLINE unwords #-}

1612

1764

1613-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns

1765-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns

1614-- 'True' iff the first is a prefix of the second. Subject to fusion.

1766-- 'True' iff the first is a prefix of the second. Subject to fusion.

1615isPrefixOf :: Text -> Text -> Bool

1767isPrefixOf :: Text -> Text -> Bool

1768+isPrefixOf = coerce JSS.isPrefixOf

1616−isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =

1769+-- isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =

1617− alen <= blen && S.isPrefixOf (stream a) (stream b)

1770+-- alen <= blen && S.isPrefixOf (stream a) (stream b)

1618{-# INLINE [1] isPrefixOf #-}

1771{-# INLINE [1] isPrefixOf #-}

1619

1772

1620{-# RULES

1773{-# RULES

1621"TEXT isPrefixOf -> fused" [~1] forall s t.

1774"TEXT isPrefixOf -> fused" [~1] forall s t.

1622 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)

1775 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)

1776+"JSSTRING isPrefixOf -> unfused" [1] forall x y.

1777+ S.isPrefixOf (stream x) (stream y) = isPrefixOf x y

1623 #-}

1778 #-}

1624

1779

1625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns

1780-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns

1626-- 'True' iff the first is a suffix of the second.

1781-- 'True' iff the first is a suffix of the second.

1627isSuffixOf :: Text -> Text -> Bool

1782isSuffixOf :: Text -> Text -> Bool

1783+isSuffixOf = coerce JSS.isSuffixOf

1628−isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =

1784+-- isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =

1629− d >= 0 && a == b'

1785+-- d >= 0 && a == b'

1630− where d = blen - alen

1786+-- where d = blen - alen

1631− b' | d == 0 = b

1787+-- b' | d == 0 = b

1632− | otherwise = Text barr (boff+d) alen

1788+-- | otherwise = Text barr (boff+d) alen

1633{-# INLINE isSuffixOf #-}

1789{-# INLINE isSuffixOf #-}

1634

1790

1635-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns

1791-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns

@@ -1639,10 +1795,11 @@ isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =

1639-- In (unlikely) bad cases, this function's time complexity degrades

1795-- In (unlikely) bad cases, this function's time complexity degrades

1640-- towards /O(n*m)/.

1796-- towards /O(n*m)/.

1641isInfixOf :: Text -> Text -> Bool

1797isInfixOf :: Text -> Text -> Bool

1798+isInfixOf = coerce JSS.isInfixOf

1642−isInfixOf needle haystack

1799+-- isInfixOf needle haystack

1643− | null needle = True

1800+-- | null needle = True

1644− | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack

1801+-- | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack

1645− | otherwise = not . L.null . indices needle $ haystack

1802+-- | otherwise = not . L.null . indices needle $ haystack

1646{-# INLINE [1] isInfixOf #-}

1803{-# INLINE [1] isInfixOf #-}

1647

1804

1648{-# RULES

1805{-# RULES

@@ -1672,9 +1829,10 @@ isInfixOf needle haystack

1672-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf

1829-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf

1673-- > fnordLength _ = -1

1830-- > fnordLength _ = -1

1674stripPrefix :: Text -> Text -> Maybe Text

1831stripPrefix :: Text -> Text -> Maybe Text

1832+stripPrefix = coerce JSS.stripPrefix

1675−stripPrefix p@(Text _arr _off plen) t@(Text arr off len)

1833+-- stripPrefix p@(Text _arr _off plen) t@(Text arr off len)

1676− | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)

1834+-- | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)

1677− | otherwise = Nothing

1835+-- | otherwise = Nothing

1678

1836

1679-- | /O(n)/ Find the longest non-empty common prefix of two strings

1837-- | /O(n)/ Find the longest non-empty common prefix of two strings

1680-- and return it, along with the suffixes of each string at which they

1838-- and return it, along with the suffixes of each string at which they

@@ -1689,15 +1847,16 @@ stripPrefix p@(Text _arr _off plen) t@(Text arr off len)

1689-- > commonPrefixes "veeble" "fetzer" == Nothing

1847-- > commonPrefixes "veeble" "fetzer" == Nothing

1690-- > commonPrefixes "" "baz" == Nothing

1848-- > commonPrefixes "" "baz" == Nothing

1691commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)

1849commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)

1850+commonPrefixes = coerce JSS.commonPrefixes

1692−commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

1851+-- commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

1693− where

1852+-- where

1694− go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)

1853+-- go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)

1695− | i > 0 = Just (Text arr0 off0 i,

1854+-- | i > 0 = Just (Text arr0 off0 i,

1696− text arr0 (off0+i) (len0-i),

1855+-- text arr0 (off0+i) (len0-i),

1697− text arr1 (off1+j) (len1-j))

1856+-- text arr1 (off1+j) (len1-j))

1698− | otherwise = Nothing

1857+-- | otherwise = Nothing

1699− where Iter a d0 = iter t0 i

1858+-- where Iter a d0 = iter t0 i

1700− Iter b d1 = iter t1 j

1859+-- Iter b d1 = iter t1 j

1701

1860

1702-- | /O(n)/ Return the prefix of the second string if its suffix

1861-- | /O(n)/ Return the prefix of the second string if its suffix

1703-- matches the entire first string.

1862-- matches the entire first string.

@@ -1718,21 +1877,22 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

1718-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre

1877-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre

1719-- > quuxLength _ = -1

1878-- > quuxLength _ = -1

1720stripSuffix :: Text -> Text -> Maybe Text

1879stripSuffix :: Text -> Text -> Maybe Text

1880+stripSuffix = coerce JSS.stripSuffix

1721−stripSuffix p@(Text _arr _off plen) t@(Text arr off len)

1881+-- stripSuffix p@(Text _arr _off plen) t@(Text arr off len)

1722− | p `isSuffixOf` t = Just $! text arr off (len-plen)

1882+-- | p `isSuffixOf` t = Just $! text arr off (len-plen)

1723− | otherwise = Nothing

1883+-- | otherwise = Nothing

1724−

1884+

1725−-- | Add a list of non-negative numbers. Errors out on overflow.

1885+-- -- | Add a list of non-negative numbers. Errors out on overflow.

1726−sumP :: String -> [Int] -> Int

1886+-- sumP :: String -> [Int] -> Int

1727−sumP fun = go 0

1887+-- sumP fun = go 0

1728− where go !a (x:xs)

1888+-- where go !a (x:xs)

1729− | ax >= 0 = go ax xs

1889+-- | ax >= 0 = go ax xs

1730− | otherwise = overflowError fun

1890+-- | otherwise = overflowError fun

1731− where ax = a + x

1891+-- where ax = a + x

1732− go a _ = a

1892+-- go a _ = a

1733−

1893+

1734−emptyError :: String -> a

1894+-- emptyError :: String -> a

1735−emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"

1895+-- emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"

1736

1896

1737overflowError :: String -> a

1897overflowError :: String -> a

1738overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"

1898overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"

@@ -1746,10 +1906,14 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"

1746-- copy \"breaks the link\" to the original array, allowing it to be

1906-- copy \"breaks the link\" to the original array, allowing it to be

1747-- garbage collected if there are no other live references to it.

1907-- garbage collected if there are no other live references to it.

1748copy :: Text -> Text

1908copy :: Text -> Text

1909+copy = P.id -- TODO

1749−copy (Text arr off len) = Text (A.run go) 0 len

1910+-- copy (Text arr off len) = Text (A.run go) 0 len

1750− where

1911+-- where

1751− go :: ST s (A.MArray s)

1912+-- go :: ST s (A.MArray s)

1752− go = do

1913+-- go = do

1753− marr <- A.new len

1914+-- marr <- A.new len

1754− A.copyI marr 0 arr off len

1915+

1755− return marr

1916+foreign import javascript unsafe

1917+ "h$jsstringReplicateChar" js_replicateChar :: Int -> Char -> JSString

1918+foreign import javascript unsafe

1919+ "$2.substr($1)" js_substr1 :: Int -> JSString -> JSString

Data/Text/Encoding.hs+28

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

3#if __GLASGOW_HASKELL__ >= 702

4{-# LANGUAGE Trustworthy #-}

5#endif

6+{-# LANGUAGE UnboxedTuples #-}

6-- |

7-- |

7-- Module : Data.Text.Encoding

8-- Module : Data.Text.Encoding

@@ -76,7 +77,9 @@ import Data.Text.Internal (Text(..), safe, text)

76import Data.Text.Internal.Private (runText)

77import Data.Text.Internal.Private (runText)

77import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)

78import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)

78import Data.Text.Internal.Unsafe.Shift (shiftR)

79import Data.Text.Internal.Unsafe.Shift (shiftR)

80+#ifndef __GHCJS__

79import Data.Text.Show ()

81import Data.Text.Show ()

82+#endif

80import Data.Text.Unsafe (unsafeDupablePerformIO)

83import Data.Text.Unsafe (unsafeDupablePerformIO)

81import Data.Word (Word8, Word32)

84import Data.Word (Word8, Word32)

82import Foreign.C.Types (CSize(..))

85import Foreign.C.Types (CSize(..))

@@ -95,6 +98,12 @@ import qualified Data.Text.Internal.Encoding.Utf16 as U16

95import qualified Data.Text.Internal.Fusion as F

98import qualified Data.Text.Internal.Fusion as F

97#include "text_cbits.h"

100#include "text_cbits.h"

101+#ifdef __GHCJS__

102+import GHC.Exts (Int(..), Int#)

103+import Data.ByteString (ByteString)

104+import GHCJS.Buffer

105+import Data.JSString (JSString)

106+#endif

107

99-- $strict

108-- $strict

100--

109--

@@ -326,9 +335,18 @@ encodeUtf8BuilderEscaped be =

326 where

335 where

327 bound = max 4 $ BP.sizeBound be

336 bound = max 4 $ BP.sizeBound be

328

337

338+#ifndef __GHCJS__

329 mkBuildstep (Text arr off len) !k =

339 mkBuildstep (Text arr off len) !k =

340+#else

341+ mkBuildstep (Text t) !k =

342+#endif

330 outerLoop off

343 outerLoop off

331 where

344 where

345+#ifdef __GHCJS__

346+ off = 0

347+ (arr, len) = let (# ba, len' #) = js_fromString t

348+ in (A.Array ba, I# len')

349+#endif

332 iend = off + len

350 iend = off + len

333

351

334 outerLoop !i0 !br@(B.BufferRange op0 ope)

352 outerLoop !i0 !br@(B.BufferRange op0 ope)

@@ -370,6 +388,7 @@ encodeUtf8BuilderEscaped be =

370

388

371-- | Encode text using UTF-8 encoding.

389-- | Encode text using UTF-8 encoding.

372encodeUtf8 :: Text -> ByteString

390encodeUtf8 :: Text -> ByteString

391+#ifndef __GHCJS__

373encodeUtf8 (Text arr off len)

392encodeUtf8 (Text arr off len)

374 | len == 0 = B.empty

393 | len == 0 = B.empty

375 | otherwise = unsafeDupablePerformIO $ do

394 | otherwise = unsafeDupablePerformIO $ do

@@ -386,6 +405,10 @@ encodeUtf8 (Text arr off len)

386 withForeignPtr fp' $ \ptr' -> do

405 withForeignPtr fp' $ \ptr' -> do

387 memcpy ptr' ptr (fromIntegral utf8len)

406 memcpy ptr' ptr (fromIntegral utf8len)

388 return (PS fp' 0 utf8len)

407 return (PS fp' 0 utf8len)

408+#else

409+encodeUtf8 (Text txt) = toByteString 0 (Just (byteLength buf - 1)) buf

410+ where buf = js_encodeUtf8 txt

411+#endif

389

412

390-- | Decode text from little endian UTF-16 encoding.

413-- | Decode text from little endian UTF-16 encoding.

391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

414decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

@@ -475,5 +498,10 @@ foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_stat

475foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1

498foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1

476 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()

499 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()

477

500

501+#ifndef __GHCJS__

478foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8

502foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8

479 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()

503 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()

504+#else

505+foreign import javascript unsafe "h$textFromString" js_fromString :: JSString -> (# ByteArray#, Int# #)

506+foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8 :: JSString -> Buffer

507+#endif

Data/Text/IO.hs+16

@@ -185,7 +185,11 @@ hPutStr h t = do

185 | otherwise -> writeBlocksRaw h buf str

186

187hPutChars :: Handle -> Stream Char -> IO ()

188+#ifndef __GHCJS__

188hPutChars h (Stream next0 s0 _len) = loop s0

189hPutChars h (Stream next0 s0 _len) = loop s0

190+#else

191+hPutChars h (Stream next0 s0) = loop s0

192+#endif

189 where

193 where

190 loop !s = case next0 s of

194 loop !s = case next0 s of

191 Done -> return ()

195 Done -> return ()

@@ -203,7 +207,11 @@ hPutChars h (Stream next0 s0 _len) = loop s0

203-- handling gave a few more percent on top.

207-- handling gave a few more percent on top.

204

208

205writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()

209writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()

210+#ifndef __GHCJS__

206writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0

211writeLines 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

207 where

215 where

208 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

216 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

209 where

217 where

@@ -223,7 +231,11 @@ writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0

223 commit = commitBuffer h raw len

231 commit = commitBuffer h raw len

224

232

225writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()

233writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()

234+#ifndef __GHCJS__

226writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0

235writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0

236+#else

237+writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0

238+#endif

227 where

239 where

228 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

240 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

229 where

241 where

@@ -239,7 +251,11 @@ writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0

239 commit = commitBuffer h raw len

251 commit = commitBuffer h raw len

240

252

241writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()

253writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()

254+#ifndef __GHCJS__

242writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0

255writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0

256+#else

257+writeBlocksRaw h buf0 (Stream next0 s0) = outer s0 buf0

258+#endif

243 where

259 where

244 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

260 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

245 where

261 where

Data/Text/Internal.hs+48−125

@@ -1,127 +1,67 @@

1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}

1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples, MagicHash,

2−{-# OPTIONS_HADDOCK not-home #-}

2+ BangPatterns, ForeignFunctionInterface, JavaScriptFFI, GeneralizedNewtypeDeriving #-}

3−

3+{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes,

4−-- |

4+ GHCForeignImportPrim, MagicHash, FlexibleInstances #-}

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−

27module Data.Text.Internal

5module Data.Text.Internal

28− (

6+ ( module Data.Text.Internal

29− -- * Types

30− -- $internals

31− Text(..)

32− -- * Construction

33− , text

34− , textP

35− -- * Safety

36− , safe

7+ , JSS.safe

37− -- * Code that must be here for accessibility

38− , empty

39− , empty_

40− -- * Utilities

41− , firstf

8+ , JSS.firstf

42− -- * Checked multiplication

43− , mul

44− , mul32

45− , mul64

46− -- * Debugging

47− , showText

48− ) where

9+ ) 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

53import Data.Bits

25import Data.Bits

54import Data.Int (Int32, Int64)

26import Data.Int (Int32, Int64)

55−import Data.Text.Internal.Unsafe.Char (ord)

27+-- import Data.Text.Internal.Unsafe.Char (ord)

56import Data.Typeable (Typeable)

28import Data.Typeable (Typeable)

29+import GHC.Exts (ByteArray#, Char(..), ord#, andI#, (/=#), isTrue#, (==#), Int(..), Int#, isTrue#)

57−import qualified Data.Text.Array as A

30+-- 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)

66−-- | Smart constructor.

36+newtype Text = Text JSString

67−text_ :: A.Array -> Int -> Int -> Text

37+ deriving (PToJSVal, PFromJSVal, FromJSVal, ToJSVal)

68−text_ arr off len =

38+

69−#if defined(ASSERTS)

39+instance Show Text where

70− let c = A.unsafeIndex arr off

40+ showsPrec p (Text jsstring) r = showsPrec p jsstring r

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'.

81empty :: Text

42empty :: Text

82−empty = Text A.empty 0 0

43+empty = Text JSS.empty

83{-# INLINE [1] empty #-}

44{-# INLINE [1] empty #-}

85−-- | A non-inlined version of 'empty'.

86empty_ :: Text

46empty_ :: Text

87−empty_ = Text A.empty 0 0

47+empty_ = Text JSS.empty

88{-# NOINLINE empty_ #-}

48{-# NOINLINE empty_ #-}

50+foreign import javascript unsafe

51+ "String.fromCharCode.apply(null, $1['u8'])"

52+ js_decodeBytes :: ByteArray# -> JSString

53+

54+foreign import javascript unsafe

55+ "h$textToString"

56+ js_textToString :: ByteArray# -> Int# -> Int# -> JSString

57+

90-- | Construct a 'Text' without invisibly pinning its byte array in

58-- | Construct a 'Text' without invisibly pinning its byte array in

91-- memory if its length has dwindled to zero.

59-- memory if its length has dwindled to zero.

92text :: A.Array -> Int -> Int -> Text

60text :: A.Array -> Int -> Int -> Text

93−text arr off len | len == 0 = empty

61+-- text arr off len | len == 0 = empty

94− | otherwise = text_ arr off len

62+-- | otherwise = text_ arr off len

95−{-# INLINE text #-}

63+text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty

96−

64+ | otherwise = Text $ js_textToString ba off# len#

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

126-- | Checked multiplication. Calls 'error' if the result would

66-- | Checked multiplication. Calls 'error' if the result would

127-- overflow.

67-- overflow.

@@ -168,21 +108,4 @@ mul32 a b = case fromIntegral a * fromIntegral b of

168{-# INLINE mul32 #-}

108{-# INLINE mul32 #-}

169infixl 7 `mul32`

109infixl 7 `mul32`

170

110

171−-- $internals

111+--------------------------------------

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+47−5

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

1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}

2+{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, UnboxedTuples,

3+ MagicHash #-}

2{-# OPTIONS_HADDOCK not-home #-}

4{-# OPTIONS_HADDOCK not-home #-}

4-----------------------------------------------------------------------------

6-----------------------------------------------------------------------------

@@ -73,6 +75,8 @@ import qualified Data.Text as S

73import qualified Data.Text.Array as A

75import qualified Data.Text.Array as A

74import qualified Data.Text.Lazy as L

76import qualified Data.Text.Lazy as L

78+import Data.JSString (JSString)

79+import GHC.Exts (ByteArray#, Int#, Int(I#))

76------------------------------------------------------------------------

80------------------------------------------------------------------------

78-- | A @Builder@ is an efficient way to build lazy @Text@ values.

82-- | A @Builder@ is an efficient way to build lazy @Text@ values.

@@ -164,10 +168,17 @@ copyLimit = 128

164-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@

168-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@

165--

169--

166fromText :: S.Text -> Builder

170fromText :: S.Text -> Builder

167−fromText t@(Text arr off l)

171+fromText t@(Text t')

168 | S.null t = empty

172 | S.null t = empty

169 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

173 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

170 | otherwise = flush `append` mapBuilder (t :)

174 | 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 :)

171{-# INLINE [1] fromText #-}

182{-# INLINE [1] fromText #-}

172

183

173{-# RULES

184{-# RULES

@@ -182,10 +193,10 @@ fromText t@(Text arr off l)

182fromString :: String -> Builder

193fromString :: String -> Builder

183fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

194fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

184 let loop !marr !o !u !l [] = k (Buffer marr o u l)

195 let loop !marr !o !u !l [] = k (Buffer marr o u l)

185− loop marr o u l s@(c:cs)

196+ loop marr o@(I# o#) u@(I# u#) l s@(c:cs)

186 | l <= 1 = do

197 | l <= 1 = do

187 arr <- A.unsafeFreeze marr

198 arr <- A.unsafeFreeze marr

188− let !t = Text arr o u

199+ let !t = Text $ js_toString (A.aBA arr) o# u#

189 marr' <- A.new chunkSize

200 marr' <- A.new chunkSize

190 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

201 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

191 return $ t : ts

202 return $ t : ts

@@ -195,6 +206,21 @@ fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

195 in loop p0 o0 u0 l0 str

206 in loop p0 o0 u0 l0 str

196 where

207 where

197 chunkSize = smallChunkSize

208 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

198{-# INLINE fromString #-}

224{-# INLINE fromString #-}

199

225

200-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying

226-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying

@@ -234,16 +260,24 @@ toLazyTextWith chunkSize m = L.fromChunks (runST $

234-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,

260-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,

235-- yielding a new chunk in the result lazy @Text@.

261-- yielding a new chunk in the result lazy @Text@.

236flush :: Builder

262flush :: Builder

237−flush = Builder $ \ k buf@(Buffer p o u l) ->

263+flush = Builder $ \ k buf@(Buffer p o@(I# o#) u@(I# u#) l) ->

238 if u == 0

264 if u == 0

239 then k buf

265 then k buf

240 else do arr <- A.unsafeFreeze p

266 else do arr <- A.unsafeFreeze p

241 let !b = Buffer p (o+u) 0 l

267 let !b = Buffer p (o+u) 0 l

242− !t = Text arr o u

268+ !t = Text $ js_toString (A.aBA arr) o# u#

243 ts <- inlineInterleaveST (k b)

269 ts <- inlineInterleaveST (k b)

244 return $! t : ts

270 return $! t : ts

245{-# INLINE [1] flush #-}

271{-# INLINE [1] flush #-}

246-- defer inlining so that flush/flush rule may fire.

272-- 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

247

281

248------------------------------------------------------------------------

282------------------------------------------------------------------------

249

283

@@ -327,3 +361,11 @@ append' (Builder f) (Builder g) = Builder (f . g)

327 append flush flush = flush

361 append flush flush = flush

328

362

329 #-}

363 #-}

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+10−8

@@ -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,8 +166,10 @@ 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

170− let mlen = upperBound 4 len

171+ -- let mlen = upperBound 4 len

172+ let mlen = 4

171 mallocByteString mlen >>= loop mlen 0 s0

173 mallocByteString mlen >>= loop mlen 0 s0

172 where

174 where

173 loop !n !off !s fp = case next s of

175 loop !n !off !s fp = case next s of

Data/Text/Internal/Encoding/Fusion/Common.hs+8−4

@@ -37,7 +37,8 @@ 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)

41 where

42 where

42 next (RS0 s) = case next0 s of

43 next (RS0 s) = case next0 s of

43 Done -> Done

44 Done -> Done

@@ -61,7 +62,8 @@ restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

61{-# INLINE restreamUtf16BE #-}

62{-# INLINE restreamUtf16BE #-}

63restreamUtf16LE :: Stream Char -> Stream Word8

64restreamUtf16LE :: Stream Char -> Stream Word8

64−restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

65+-- restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

66+restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)

65 where

67 where

66 next (RS0 s) = case next0 s of

68 next (RS0 s) = case next0 s of

67 Done -> Done

69 Done -> Done

@@ -85,7 +87,8 @@ restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

85{-# INLINE restreamUtf16LE #-}

87{-# INLINE restreamUtf16LE #-}

87restreamUtf32BE :: Stream Char -> Stream Word8

89restreamUtf32BE :: Stream Char -> Stream Word8

88−restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

90+restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)

91+-- restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

89 where

92 where

90 next (RS0 s) = case next0 s of

93 next (RS0 s) = case next0 s of

91 Done -> Done

94 Done -> Done

@@ -104,7 +107,8 @@ restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

104{-# INLINE restreamUtf32BE #-}

107{-# INLINE restreamUtf32BE #-}

105

108

106restreamUtf32LE :: Stream Char -> Stream Word8

109restreamUtf32LE :: Stream Char -> Stream Word8

107−restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

110+restreamUtf32LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)

111+-- restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

108 where

112 where

109 next (RS0 s) = case next0 s of

113 next (RS0 s) = case next0 s of

110 Done -> Done

114 Done -> Done

Data/Text/Internal/Fusion.hs+40−166

@@ -28,217 +28,91 @@ module Data.Text.Internal.Fusion

28 , unstream

29 , reverseStream

31− , length

31+ , Data.Text.Internal.Fusion.length

33 -- * Transformations

34− , reverse

34+ , Data.Text.Internal.Fusion.reverse

36 -- * Construction

37 -- ** Scans

38 , reverseScanr

40 -- ** Accumulating maps

41− , mapAccumL

41+ , Data.Text.Internal.Fusion.mapAccumL

43 -- ** Generation and unfolding

44 , unfoldrN

46 -- * Indexing

47− , index

47+ , Data.Text.Internal.Fusion.index

48− , findIndex

48+ , Data.Text.Internal.Fusion.findIndex

49 , countChar

50 ) where

52−import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,

52+import GHC.Exts (Char(..), Int(..), chr#, Int#, isTrue#, (-#), (+#), (>=#))

53− Num(..), Ord(..), ($), (&&),

53+

54− fromIntegral, otherwise)

54+import Prelude hiding (length, reverse)

55−import Data.Bits ((.&.))

55+import Data.Char

56+

56−import Data.Text.Internal (Text(..))

57+import Data.JSString.Internal.Type (JSString(..))

57−import Data.Text.Internal.Private (runText)

58+import qualified Data.JSString.Internal.Type as I

58−import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)

59−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)

59+import Data.JSString.Internal.Fusion.Types

60−import qualified Data.Text.Array as A

61−import qualified Data.Text.Internal.Fusion.Common as S

60+import qualified Data.JSString.Internal.Fusion.Common as S

62−import Data.Text.Internal.Fusion.Types

61+

62+import System.IO.Unsafe

63+

64+import GHCJS.Prim

65+

66+import Data.Coerce

63−import Data.Text.Internal.Fusion.Size

67+import Data.Text.Internal

64−import qualified Data.Text.Internal as I

68+import qualified Data.JSString.Internal.Fusion as JSS

65−import qualified Data.Text.Internal.Encoding.Utf16 as U16

69+import Data.JSString.Internal.Fusion.Types (Stream(..))

67default(Int)

71default(Int)

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

70stream :: Text -> Stream Char

73stream :: Text -> Stream Char

71−stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)

74+stream = coerce JSS.stream

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)

81{-# INLINE [0] stream #-}

75{-# INLINE [0] stream #-}

83−-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate

84−-- backwards.

85reverseStream :: Text -> Stream Char

77reverseStream :: Text -> Stream Char

86−reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)

78+reverseStream = coerce JSS.reverseStream

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)

96{-# INLINE [0] reverseStream #-}

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

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

99unstream :: Stream Char -> Text

81unstream :: Stream Char -> Text

100−unstream (Stream next0 s0 len) = runText $ \done -> do

82+unstream = coerce JSS.unstream

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

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

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

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

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

132

133−

134−-- ----------------------------------------------------------------------------

135−-- * Basic stream functions

136−

137length :: Stream Char -> Int

86length :: Stream Char -> Int

138−length = S.lengthI

87+length = JSS.length

139−{-# INLINE[0] length #-}

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

140

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

142reverse :: Stream Char -> Text

90reverse :: Stream Char -> Text

143−reverse (Stream next s len0)

91+reverse = coerce JSS.reverse

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

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

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

175

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

177−-- the input and result reversed.

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

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

179−reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

95+reverseScanr = JSS.reverseScanr

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

188{-# INLINE reverseScanr #-}

96{-# INLINE reverseScanr #-}

189

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

98+mapAccumL :: (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)

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

99+mapAccumL f z0 st =

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

100+ let (a, t) = JSS.mapAccumL f z0 st

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

101+ in (a, Text t)

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

103+

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

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

195−unfoldrN n = S.unfoldrNI n

105+unfoldrN = JSS.unfoldrN

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

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

197

107

198−-------------------------------------------------------------------------------

199−-- ** Indexing streams

200−

201−-- | /O(n)/ stream index (subscript) operator, starting from 0.

202index :: Stream Char -> Int -> Char

108index :: Stream Char -> Int -> Char

203−index = S.indexI

109+index = JSS.index

204{-# INLINE [0] index #-}

110{-# INLINE [0] index #-}

205

111

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.

209findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int

112findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int

210−findIndex = S.findIndexI

113+findIndex = JSS.findIndex

211{-# INLINE [0] findIndex #-}

114{-# INLINE [0] findIndex #-}

212

115

213−-- | /O(n)/ The 'count' function returns the number of times the query

214−-- element appears in the given stream.

215countChar :: Char -> Stream Char -> Int

116countChar :: Char -> Stream Char -> Int

216−countChar = S.countCharI

117+countChar = JSS.countChar

217{-# INLINE [0] countChar #-}

118{-# 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+968−922

@@ -14,925 +14,971 @@

14--

15-- Common stream fusion functionality for text.

17−module Data.Text.Internal.Fusion.Common

17+module Data.Text.Internal.Fusion.Common (module Data.JSString.Internal.Fusion.Common) where

18− (

18+import Data.JSString.Internal.Fusion.Common

19− -- * Creation and elimination

19+-- module Data.Text.Internal.Fusion.Common

20− singleton

20+-- (

21− , streamList

21+-- -- * Creation and elimination

22− , unstreamList

22+-- singleton

23− , streamCString#

23+-- , streamList

24−

24+-- , unstreamList

25− -- * Basic interface

25+-- , streamCString#

26− , cons

26+

27− , snoc

27+-- -- * Basic interface

28− , append

28+-- , cons

29− , head

29+-- , snoc

30− , uncons

30+-- , append

31− , last

31+-- , head

32− , tail

32+-- , uncons

33− , init

33+-- , last

34− , null

34+-- , tail

35− , lengthI

35+-- , init

36− , compareLengthI

36+-- , null

37− , isSingleton

37+-- , lengthI

38−

38+-- , compareLengthI

39− -- * Transformations

39+-- , isSingleton

40− , map

40+

41− , intercalate

41+-- -- * Transformations

42− , intersperse

42+-- , map

43−

43+-- , intercalate

44− -- ** Case conversion

44+-- , intersperse

45− -- $case

45+

46− , toCaseFold

46+-- -- ** Case conversion

47− , toLower

47+-- -- $case

48− , toTitle

48+-- , toCaseFold

49− , toUpper

49+-- , toLower

50−

50+-- , toTitle

51− -- ** Justification

51+-- , toUpper

52− , justifyLeftI

52+

53−

53+-- -- ** Justification

54− -- * Folds

54+-- , justifyLeftI

55− , foldl

55+

56− , foldl'

56+-- -- * Folds

57− , foldl1

57+-- , foldl

58− , foldl1'

58+-- , foldl'

59− , foldr

59+-- , foldl1

60− , foldr1

60+-- , foldl1'

61−

61+-- , foldr

62− -- ** Special folds

62+-- , foldr1

63− , concat

63+

64− , concatMap

64+-- -- ** Special folds

65− , any

65+-- , concat

66− , all

66+-- , concatMap

67− , maximum

67+-- , any

68− , minimum

68+-- , all

69−

69+-- , maximum

70− -- * Construction

70+-- , minimum

71− -- ** Scans

71+

72− , scanl

72+-- -- * Construction

73−

73+-- -- ** Scans

74− -- ** Generation and unfolding

74+-- , scanl

75− , replicateCharI

75+

76− , replicateI

76+-- -- ** Generation and unfolding

77− , unfoldr

77+-- , replicateCharI

78− , unfoldrNI

78+-- , replicateI

79−

79+-- , unfoldr

80− -- * Substrings

80+-- , unfoldrNI

81− -- ** Breaking strings

81+

82− , take

82+-- -- * Substrings

83− , drop

83+-- -- ** Breaking strings

84− , takeWhile

84+-- , take

85− , dropWhile

85+-- , drop

86−

86+-- , takeWhile

87− -- * Predicates

87+-- , dropWhile

88− , isPrefixOf

88+

89−

89+-- -- * Predicates

90− -- * Searching

90+-- , isPrefixOf

91− , elem

91+

92− , filter

92+-- -- * Searching

93−

93+-- , elem

94− -- * Indexing

94+-- , filter

95− , findBy

95+

96− , indexI

96+-- -- * Indexing

97− , findIndexI

97+-- , findBy

98− , countCharI

98+-- , indexI

99−

99+-- , findIndexI

100− -- * Zipping and unzipping

100+-- , countCharI

101− , zipWith

101+

102− ) where

102+-- -- * Zipping and unzipping

103−

103+-- , zipWith

104−import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

104+-- ) where

105− Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),

105+

106− (&&), fromIntegral, otherwise)

106+-- import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

107−import qualified Data.List as L

107+-- Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),

108−import qualified Prelude as P

108+-- (&&), fromIntegral, otherwise)

109−import Data.Bits (shiftL)

109+-- import qualified Data.List as L

110−import Data.Char (isLetter)

110+-- import qualified Prelude as P

111−import Data.Int (Int64)

111+-- import Data.Bits (shiftL)

112−import Data.Text.Internal.Fusion.Types

112+-- import Data.Char (isLetter)

113−import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,

113+-- import Data.Int (Int64)

114− upperMapping)

114+-- import Data.Text.Internal.Fusion.Types

115−import Data.Text.Internal.Fusion.Size

115+-- import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,

116−import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)

116+-- upperMapping)

117−import GHC.Types (Char(..), Int(..))

117+-- import Data.Text.Internal.Fusion.Size

118−

118+-- import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)

119−singleton :: Char -> Stream Char

119+-- import GHC.Types (Char(..), Int(..))

120−singleton c = Stream next False 1

120+

121− where next False = Yield c True

121+-- singleton :: Char -> Stream Char

122− next True = Done

122+-- singleton c = Stream next False -- 1

123−{-# INLINE [0] singleton #-}

123+-- where next False = Yield c True

124−

124+-- next True = Done

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

125+-- {-# INLINE [0] singleton #-}

126−{-# INLINE [0] streamList #-}

126+

127−streamList s = Stream next s unknownSize

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

128− where next [] = Done

128+-- {-# INLINE [0] streamList #-}

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

129+-- streamList s = Stream next s -- unknownSize

130−

130+-- where next [] = Done

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

131+-- next (x:xs) = Yield x xs

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

132+

133− where unfold !s = case next s of

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

134− Done -> []

134+-- -- unstreamList (Stream next s0 _len) = unfold s0

135− Skip s' -> unfold s'

135+-- unstreamList (Stream next s0) = unfold s0

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

136+-- where unfold !s = case next s of

137−{-# INLINE [0] unstreamList #-}

137+-- Done -> []

138−

138+-- Skip s' -> unfold s'

139−{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

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

140−

140+-- {-# INLINE [0] unstreamList #-}

141−-- | Stream the UTF-8-like packed encoding used by GHC to represent

141+

142−-- constant strings in generated code.

142+-- {-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

143−--

143+

144−-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,

144+-- -- | Stream the UTF-8-like packed encoding used by GHC to represent

145−-- and the string is NUL-terminated.

145+-- -- constant strings in generated code.

146−streamCString# :: Addr# -> Stream Char

146+-- --

147−streamCString# addr = Stream step 0 unknownSize

147+-- -- This encoding uses the byte sequence "\xc0\x80" to represent NUL,

148− where

148+-- -- and the string is NUL-terminated.

149− step !i

149+-- streamCString# :: Addr# -> Stream Char

150− | b == 0 = Done

150+-- streamCString# addr = Stream step 0 -- unknownSize

151− | b <= 0x7f = Yield (C# b#) (i+1)

151+-- where

152− | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1

152+-- step !i

153− in Yield c (i+2)

153+-- | b == 0 = Done

154− | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +

154+-- | b <= 0x7f = Yield (C# b#) (i+1)

155− (next 1 `shiftL` 6) +

155+-- | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1

156− next 2

156+-- in Yield c (i+2)

157− in Yield c (i+3)

157+-- | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +

158− | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +

158+-- (next 1 `shiftL` 6) +

159− (next 1 `shiftL` 12) +

159+-- next 2

160− (next 2 `shiftL` 6) +

160+-- in Yield c (i+3)

161− next 3

161+-- | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +

162− in Yield c (i+4)

162+-- (next 1 `shiftL` 12) +

163− where b = I# (ord# b#)

163+-- (next 2 `shiftL` 6) +

164− next n = I# (ord# (at# (i+n))) - 0x80

164+-- next 3

165− !b# = at# i

165+-- in Yield c (i+4)

166− at# (I# i#) = indexCharOffAddr# addr i#

166+-- where b = I# (ord# b#)

167− chr (I# i#) = C# (chr# i#)

167+-- next n = I# (ord# (at# (i+n))) - 0x80

168−{-# INLINE [0] streamCString# #-}

168+-- !b# = at# i

169−

169+-- at# (I# i#) = indexCharOffAddr# addr i#

170−-- ----------------------------------------------------------------------------

170+-- chr (I# i#) = C# (chr# i#)

171−-- * Basic stream functions

171+-- {-# INLINE [0] streamCString# #-}

172−

172+

173−data C s = C0 !s

173+-- -- ----------------------------------------------------------------------------

174− | C1 !s

174+-- -- * Basic stream functions

175−

175+

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

176+-- data C s = C0 !s

177−cons :: Char -> Stream Char -> Stream Char

177+-- | C1 !s

178−cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

178+

179− where

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

180− next (C1 s) = Yield w (C0 s)

180+-- cons :: Char -> Stream Char -> Stream Char

181− next (C0 s) = case next0 s of

181+-- -- cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

182− Done -> Done

182+-- cons !w (Stream next0 s0) = Stream next (C1 s0) -- (len+1)

183− Skip s' -> Skip (C0 s')

183+-- where

184− Yield x s' -> Yield x (C0 s')

184+-- next (C1 s) = Yield w (C0 s)

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

185+-- next (C0 s) = case next0 s of

186−

186+-- Done -> Done

187−data Snoc a = N

187+-- Skip s' -> Skip (C0 s')

188− | J !a

188+-- Yield x s' -> Yield x (C0 s')

189−

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

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

190+

191−snoc :: Stream Char -> Char -> Stream Char

191+-- data Snoc a = N

192−snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

192+-- | J !a

193− where

193+

194− next (J xs) = case next0 xs of

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

195− Done -> Yield w N

195+-- snoc :: Stream Char -> Char -> Stream Char

196− Skip xs' -> Skip (J xs')

196+-- -- snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

197− Yield x xs' -> Yield x (J xs')

197+-- snoc (Stream next0 xs0) w = Stream next (J xs0) -- (len+1)

198− next N = Done

198+-- where

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

199+-- next (J xs) = case next0 xs of

200−

200+-- Done -> Yield w N

201−data E l r = L !l

201+-- Skip xs' -> Skip (J xs')

202− | R !r

202+-- Yield x xs' -> Yield x (J xs')

203−

203+-- next N = Done

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

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

205−append :: Stream Char -> Stream Char -> Stream Char

205+

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

206+-- data E l r = L !l

207− Stream next (L s01) (len1 + len2)

207+-- | R !r

208− where

208+

209− next (L s1) = case next0 s1 of

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

210− Done -> Skip (R s02)

210+-- append :: Stream Char -> Stream Char -> Stream Char

211− Skip s1' -> Skip (L s1')

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

212− Yield x s1' -> Yield x (L s1')

212+-- -- Stream next (L s01) (len1 + len2)

213− next (R s2) = case next1 s2 of

213+-- append (Stream next0 s01) (Stream next1 s02) =

214− Done -> Done

214+-- Stream next (L s01)

215− Skip s2' -> Skip (R s2')

215+-- where

216− Yield x s2' -> Yield x (R s2')

216+-- next (L s1) = case next0 s1 of

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

217+-- Done -> Skip (R s02)

218−

218+-- Skip s1' -> Skip (L s1')

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

219+-- Yield x s1' -> Yield x (L s1')

220−-- Subject to array fusion.

220+-- next (R s2) = case next1 s2 of

221−head :: Stream Char -> Char

221+-- Done -> Done

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

222+-- Skip s2' -> Skip (R s2')

223− where

223+-- Yield x s2' -> Yield x (R s2')

224− loop_head !s = case next s of

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

225− Yield x _ -> x

225+

226− Skip s' -> loop_head s'

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

227− Done -> head_empty

227+-- -- Subject to array fusion.

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

228+-- head :: Stream Char -> Char

229−

229+-- -- head (Stream next s0 _len) = loop_head s0

230−head_empty :: a

230+-- head (Stream next s0) = loop_head s0

231−head_empty = streamError "head" "Empty stream"

231+-- where

232−{-# NOINLINE head_empty #-}

232+-- loop_head !s = case next s of

233−

233+-- Yield x _ -> x

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

234+-- Skip s' -> loop_head s'

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

235+-- Done -> head_empty

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

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

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

237+

238− where

238+-- head_empty :: a

239− loop_uncons !s = case next s of

239+-- head_empty = streamError "head" "Empty stream"

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

240+-- {-# NOINLINE head_empty #-}

241− Skip s' -> loop_uncons s'

241+

242− Done -> Nothing

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

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

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

244−

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

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

245+-- -- uncons (Stream next s0 len) = loop_uncons s0

246−-- be non-empty.

246+-- uncons (Stream next s0) = loop_uncons s0

247−last :: Stream Char -> Char

247+-- where

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

248+-- loop_uncons !s = case next s of

249− where

249+-- Yield x s1 -> Just (x, Stream next s1)

250− loop0_last !s = case next s of

250+-- Skip s' -> loop_uncons s'

251− Done -> emptyError "last"

251+-- Done -> Nothing

252− Skip s' -> loop0_last s'

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

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

253+

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

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

255− Done -> x

255+-- -- be non-empty.

256− Skip s' -> loop_last x s'

256+-- last :: Stream Char -> Char

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

257+-- -- last (Stream next s0 _len) = loop0_last s0

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

258+-- last (Stream next s0) = loop0_last s0

259−

259+-- where

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

260+-- loop0_last !s = case next s of

261−-- be non-empty.

261+-- Done -> emptyError "last"

262−tail :: Stream Char -> Stream Char

262+-- Skip s' -> loop0_last s'

263−tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)

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

264− where

264+-- loop_last !x !s = case next s of

265− next (C0 s) = case next0 s of

265+-- Done -> x

266− Done -> emptyError "tail"

266+-- Skip s' -> loop_last x s'

267− Skip s' -> Skip (C0 s')

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

268− Yield _ s' -> Skip (C1 s')

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

269− next (C1 s) = case next0 s of

269+

270− Done -> Done

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

271− Skip s' -> Skip (C1 s')

271+-- -- be non-empty.

272− Yield x s' -> Yield x (C1 s')

272+-- tail :: Stream Char -> Stream Char

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

273+-- -- tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)

274−

274+-- tail (Stream next0 s0) = Stream next (C0 s0) -- (len-1)

275−data Init s = Init0 !s

275+-- where

276− | Init1 {-# UNPACK #-} !Char !s

276+-- next (C0 s) = case next0 s of

277−

277+-- Done -> emptyError "tail"

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

278+-- Skip s' -> Skip (C0 s')

279−-- must be non-empty.

279+-- Yield _ s' -> Skip (C1 s')

280−init :: Stream Char -> Stream Char

280+-- next (C1 s) = case next0 s of

281−init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)

281+-- Done -> Done

282− where

282+-- Skip s' -> Skip (C1 s')

283− next (Init0 s) = case next0 s of

283+-- Yield x s' -> Yield x (C1 s')

284− Done -> emptyError "init"

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

285− Skip s' -> Skip (Init0 s')

285+

286− Yield x s' -> Skip (Init1 x s')

286+-- data Init s = Init0 !s

287− next (Init1 x s) = case next0 s of

287+-- | Init1 {-# UNPACK #-} !Char !s

288− Done -> Done

288+

289− Skip s' -> Skip (Init1 x s')

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

290− Yield x' s' -> Yield x (Init1 x' s')

290+-- -- must be non-empty.

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

291+-- init :: Stream Char -> Stream Char

292−

292+-- -- init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)

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

293+-- init (Stream next0 s0) = Stream next (Init0 s0) -- (len-1)

294−null :: Stream Char -> Bool

294+-- where

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

295+-- next (Init0 s) = case next0 s of

296− where

296+-- Done -> emptyError "init"

297− loop_null !s = case next s of

297+-- Skip s' -> Skip (Init0 s')

298− Done -> True

298+-- Yield x s' -> Skip (Init1 x s')

299− Yield _ _ -> False

299+-- next (Init1 x s) = case next0 s of

300− Skip s' -> loop_null s'

300+-- Done -> Done

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

301+-- Skip s' -> Skip (Init1 x s')

302−

302+-- Yield x' s' -> Yield x (Init1 x' s')

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

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

304−lengthI :: Integral a => Stream Char -> a

304+

305−lengthI (Stream next s0 _len) = loop_length 0 s0

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

306− where

306+-- null :: Stream Char -> Bool

307− loop_length !z s = case next s of

307+-- -- null (Stream next s0 _len) = loop_null s0

308− Done -> z

308+-- null (Stream next s0) = loop_null s0

309− Skip s' -> loop_length z s'

309+-- where

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

310+-- loop_null !s = case next s of

311−{-# INLINE[0] lengthI #-}

311+-- Done -> True

312−

312+-- Yield _ _ -> False

313−-- | /O(n)/ Compares the count of characters in a string to a number.

313+-- Skip s' -> loop_null s'

314−-- Subject to fusion.

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

315−--

315+

316−-- This function gives the same answer as comparing against the result

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

317−-- of 'lengthI', but can short circuit if the count of characters is

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

318−-- greater than the number or if the stream can't possibly be as long

318+-- -- lengthI (Stream next s0 _len) = loop_length 0 s0

319−-- as the number supplied, and hence be more efficient.

319+-- lengthI (Stream next s0) = loop_length 0 s0

320−compareLengthI :: Integral a => Stream Char -> a -> Ordering

320+-- where

321−compareLengthI (Stream next s0 len) n =

321+-- loop_length !z s = case next s of

322− case compareSize len (fromIntegral n) of

322+-- Done -> z

323− Just o -> o

323+-- Skip s' -> loop_length z s'

324− Nothing -> loop_cmp 0 s0

324+-- Yield _ s' -> loop_length (z + 1) s'

325− where

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

326− loop_cmp !z s = case next s of

326+

327− Done -> compare z n

327+-- -- | /O(n)/ Compares the count of characters in a string to a number.

328− Skip s' -> loop_cmp z s'

328+-- -- Subject to fusion.

329− Yield _ s' | z > n -> GT

329+-- --

330− | otherwise -> loop_cmp (z + 1) s'

330+-- -- This function gives the same answer as comparing against the result

331−{-# INLINE[0] compareLengthI #-}

331+-- -- of 'lengthI', but can short circuit if the count of characters is

332−

332+-- -- greater than the number or if the stream can't possibly be as long

333−-- | /O(n)/ Indicate whether a string contains exactly one element.

333+-- -- as the number supplied, and hence be more efficient.

334−isSingleton :: Stream Char -> Bool

334+-- compareLengthI :: Integral a => Stream Char -> a -> Ordering

335−isSingleton (Stream next s0 _len) = loop 0 s0

335+-- -- compareLengthI (Stream next s0 len) n =

336− where

336+-- compareLengthI (Stream next s0) n =

337− loop !z s = case next s of

337+-- -- case compareSize len (fromIntegral n) of

338− Done -> z == (1::Int)

338+-- -- Just o -> o

339− Skip s' -> loop z s'

339+-- -- Nothing -> loop_cmp 0 s0

340− Yield _ s'

340+-- loop_cmp 0 s0

341− | z >= 1 -> False

341+-- where

342− | otherwise -> loop (z+1) s'

342+-- loop_cmp !z s = case next s of

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

343+-- Done -> compare z n

344−

344+-- Skip s' -> loop_cmp z s'

345−-- ----------------------------------------------------------------------------

345+-- Yield _ s' | z > n -> GT

346−-- * Stream transformations

346+-- | otherwise -> loop_cmp (z + 1) s'

347−

347+-- {-# INLINE[0] compareLengthI #-}

348−-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@

348+

349−-- to each element of @xs@.

349+-- -- | /O(n)/ Indicate whether a string contains exactly one element.

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

350+-- isSingleton :: Stream Char -> Bool

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

351+-- -- isSingleton (Stream next s0 _len) = loop 0 s0

352− where

352+-- isSingleton (Stream next s0) = loop 0 s0

353− next !s = case next0 s of

353+-- where

354− Done -> Done

354+-- loop !z s = case next s of

355− Skip s' -> Skip s'

355+-- Done -> z == (1::Int)

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

356+-- Skip s' -> loop z s'

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

357+-- Yield _ s'

358−

358+-- | z >= 1 -> False

359−{-#

359+-- | otherwise -> loop (z+1) s'

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

360+-- {-# INLINE[0] isSingleton #-}

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

361+

362− #-}

362+-- -- ----------------------------------------------------------------------------

363−

363+-- -- * Stream transformations

364−data I s = I1 !s

364+

365− | I2 !s {-# UNPACK #-} !Char

365+-- -- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@

366− | I3 !s

366+-- -- to each element of @xs@.

367−

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

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

368+-- -- map f (Stream next0 s0 len) = Stream next s0 len

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

369+-- map f (Stream next0 s0) = Stream next s0 -- len

370−intersperse :: Char -> Stream Char -> Stream Char

370+-- where

371−intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len

371+-- next !s = case next0 s of

372− where

372+-- Done -> Done

373− next (I1 s) = case next0 s of

373+-- Skip s' -> Skip s'

374− Done -> Done

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

375− Skip s' -> Skip (I1 s')

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

376− Yield x s' -> Skip (I2 s' x)

376+

377− next (I2 s x) = Yield x (I3 s)

377+-- {-#

378− next (I3 s) = case next0 s of

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

379− Done -> Done

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

380− Skip s' -> Skip (I3 s')

380+-- #-}

381− Yield x s' -> Yield c (I2 s' x)

381+

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

382+-- data I s = I1 !s

383−

383+-- | I2 !s {-# UNPACK #-} !Char

384−-- ----------------------------------------------------------------------------

384+-- | I3 !s

385−-- ** Case conversions (folds)

385+

386−

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

387−-- $case

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

388−--

388+-- intersperse :: Char -> Stream Char -> Stream Char

389−-- With Unicode text, it is incorrect to use combinators like @map

389+-- intersperse c (Stream next0 s0) = Stream next (I1 s0) -- len

390−-- toUpper@ to case convert each character of a string individually.

390+-- -- intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len

391−-- Instead, use the whole-string case conversion functions from this

391+-- where

392−-- module. For correctness in different writing systems, these

392+-- next (I1 s) = case next0 s of

393−-- functions may map one input character to two or three output

393+-- Done -> Done

394−-- characters.

394+-- Skip s' -> Skip (I1 s')

395−

395+-- Yield x s' -> Skip (I2 s' x)

396−caseConvert :: (forall s. Char -> s -> Step (CC s) Char)

396+-- next (I2 s x) = Yield x (I3 s)

397− -> Stream Char -> Stream Char

397+-- next (I3 s) = case next0 s of

398−caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len

398+-- Done -> Done

399− where

399+-- Skip s' -> Skip (I3 s')

400− next (CC s '\0' _) =

400+-- Yield x s' -> Yield c (I2 s' x)

401− case next0 s of

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

402− Done -> Done

402+

403− Skip s' -> Skip (CC s' '\0' '\0')

403+-- -- ----------------------------------------------------------------------------

404− Yield c s' -> remap c s'

404+-- -- ** Case conversions (folds)

405− next (CC s a b) = Yield a (CC s b '\0')

405+

406−

406+-- -- $case

407−-- | /O(n)/ Convert a string to folded case. This function is mainly

407+-- --

408−-- useful for performing caseless (or case insensitive) string

408+-- -- With Unicode text, it is incorrect to use combinators like @map

409−-- comparisons.

409+-- -- toUpper@ to case convert each character of a string individually.

410−--

410+-- -- Instead, use the whole-string case conversion functions from this

411−-- A string @x@ is a caseless match for a string @y@ if and only if:

411+-- -- module. For correctness in different writing systems, these

412−--

412+-- -- functions may map one input character to two or three output

413−-- @toCaseFold x == toCaseFold y@

413+-- -- characters.

414−--

414+

415−-- The result string may be longer than the input string, and may

415+-- caseConvert :: (forall s. Char -> s -> Step (CC s) Char)

416−-- differ from applying 'toLower' to the input string. For instance,

416+-- -> Stream Char -> Stream Char

417−-- the Armenian small ligature men now (U+FB13) is case folded to the

417+-- -- caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len

418−-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is

418+-- caseConvert remap (Stream next0 s0) = Stream next (CC s0 '\0' '\0') -- len

419−-- case folded to the Greek small letter letter mu (U+03BC) instead of

419+-- where

420−-- itself.

420+-- next (CC s '\0' _) =

421−toCaseFold :: Stream Char -> Stream Char

421+-- case next0 s of

422−toCaseFold = caseConvert foldMapping

422+-- Done -> Done

423−{-# INLINE [0] toCaseFold #-}

423+-- Skip s' -> Skip (CC s' '\0' '\0')

424−

424+-- Yield c s' -> remap c s'

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

425+-- next (CC s a b) = Yield a (CC s b '\0')

426−-- conversion. The result string may be longer than the input string.

426+

427−-- For instance, the German eszett (U+00DF) maps to the two-letter

427+-- -- | /O(n)/ Convert a string to folded case. This function is mainly

428−-- sequence SS.

428+-- -- useful for performing caseless (or case insensitive) string

429−toUpper :: Stream Char -> Stream Char

429+-- -- comparisons.

430−toUpper = caseConvert upperMapping

430+-- --

431−{-# INLINE [0] toUpper #-}

431+-- -- A string @x@ is a caseless match for a string @y@ if and only if:

432−

432+-- --

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

433+-- -- @toCaseFold x == toCaseFold y@

434−-- conversion. The result string may be longer than the input string.

434+-- --

435−-- For instance, the Latin capital letter I with dot above (U+0130)

435+-- -- The result string may be longer than the input string, and may

436−-- maps to the sequence Latin small letter i (U+0069) followed by

436+-- -- differ from applying 'toLower' to the input string. For instance,

437−-- combining dot above (U+0307).

437+-- -- the Armenian small ligature men now (U+FB13) is case folded to the

438−toLower :: Stream Char -> Stream Char

438+-- -- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is

439−toLower = caseConvert lowerMapping

439+-- -- case folded to the Greek small letter letter mu (U+03BC) instead of

440−{-# INLINE [0] toLower #-}

440+-- -- itself.

441−

441+-- toCaseFold :: Stream Char -> Stream Char

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

442+-- toCaseFold = caseConvert foldMapping

443−-- conversion.

443+-- {-# INLINE [0] toCaseFold #-}

444−--

444+

445−-- The first letter of the input is converted to title case, as is

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

446−-- every subsequent letter that immediately follows a non-letter.

446+-- -- conversion. The result string may be longer than the input string.

447−-- Every letter that immediately follows another letter is converted

447+-- -- For instance, the German eszett (U+00DF) maps to the two-letter

448−-- to lower case.

448+-- -- sequence SS.

449−--

449+-- toUpper :: Stream Char -> Stream Char

450−-- The result string may be longer than the input string. For example,

450+-- toUpper = caseConvert upperMapping

451−-- the Latin small ligature ﬂ (U+FB02) is converted to the

451+-- {-# INLINE [0] toUpper #-}

452−-- sequence Latin capital letter F (U+0046) followed by Latin small

452+

453−-- letter l (U+006C).

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

454−--

454+-- -- conversion. The result string may be longer than the input string.

455−-- /Note/: this function does not take language or culture specific

455+-- -- For instance, the Latin capital letter I with dot above (U+0130)

456−-- rules into account. For instance, in English, different style

456+-- -- maps to the sequence Latin small letter i (U+0069) followed by

457−-- guides disagree on whether the book name \"The Hill of the Red

457+-- -- combining dot above (U+0307).

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

458+-- toLower :: Stream Char -> Stream Char

459−-- capitalize /every/ word.

459+-- toLower = caseConvert lowerMapping

460−toTitle :: Stream Char -> Stream Char

460+-- {-# INLINE [0] toLower #-}

461−toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

461+

462− where

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

463− next (CC (letter :*: s) '\0' _) =

463+-- -- conversion.

464− case next0 s of

464+-- --

465− Done -> Done

465+-- -- The first letter of the input is converted to title case, as is

466− Skip s' -> Skip (CC (letter :*: s') '\0' '\0')

466+-- -- every subsequent letter that immediately follows a non-letter.

467− Yield c s'

467+-- -- Every letter that immediately follows another letter is converted

468− | letter' -> if letter

468+-- -- to lower case.

469− then lowerMapping c (letter' :*: s')

469+-- --

470− else titleMapping c (letter' :*: s')

470+-- -- The result string may be longer than the input string. For example,

471− | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')

471+-- -- the Latin small ligature ﬂ (U+FB02) is converted to the

472− where letter' = isLetter c

472+-- -- sequence Latin capital letter F (U+0046) followed by Latin small

473− next (CC s a b) = Yield a (CC s b '\0')

473+-- -- letter l (U+006C).

474−{-# INLINE [0] toTitle #-}

474+-- --

475−

475+-- -- /Note/: this function does not take language or culture specific

476−data Justify i s = Just1 !i !s

476+-- -- rules into account. For instance, in English, different style

477− | Just2 !i !s

477+-- -- guides disagree on whether the book name \"The Hill of the Red

478−

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

479−justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

479+-- -- capitalize /every/ word.

480−justifyLeftI k c (Stream next0 s0 len) =

480+-- toTitle :: Stream Char -> Stream Char

481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)

481+-- -- toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

482− where

482+-- toTitle (Stream next0 s0) = Stream next (CC (False :*: s0) '\0' '\0') -- len

483− next (Just1 n s) =

483+-- where

484− case next0 s of

484+-- next (CC (letter :*: s) '\0' _) =

485− Done -> next (Just2 n s)

485+-- case next0 s of

486− Skip s' -> Skip (Just1 n s')

486+-- Done -> Done

487− Yield x s' -> Yield x (Just1 (n+1) s')

487+-- Skip s' -> Skip (CC (letter :*: s') '\0' '\0')

488− next (Just2 n s)

488+-- Yield c s'

489− | n < k = Yield c (Just2 (n+1) s)

489+-- | letter' -> if letter

490− | otherwise = Done

490+-- then lowerMapping c (letter' :*: s')

491− {-# INLINE next #-}

491+-- else titleMapping c (letter' :*: s')

492−{-# INLINE [0] justifyLeftI #-}

492+-- | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')

493−

493+-- where letter' = isLetter c

494−-- ----------------------------------------------------------------------------

494+-- next (CC s a b) = Yield a (CC s b '\0')

495−-- * Reducing Streams (folds)

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

496−

496+

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

497+-- data Justify i s = Just1 !i !s

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

498+-- | Just2 !i !s

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

499+

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

500+-- justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

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

501+-- -- justifyLeftI k c (Stream next0 s0 len) =

502− where

502+-- justifyLeftI k c (Stream next0 s0) =

503− loop_foldl z !s = case next s of

503+-- Stream next (Just1 0 s0) -- (larger (fromIntegral k) len)

504− Done -> z

504+-- where

505− Skip s' -> loop_foldl z s'

505+-- next (Just1 n s) =

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

506+-- case next0 s of

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

507+-- Done -> next (Just2 n s)

508−

508+-- Skip s' -> Skip (Just1 n s')

509−-- | A strict version of foldl.

509+-- Yield x s' -> Yield x (Just1 (n+1) s')

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

510+-- next (Just2 n s)

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

511+-- | n < k = Yield c (Just2 (n+1) s)

512− where

512+-- | otherwise = Done

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

513+-- {-# INLINE next #-}

514− Done -> z

514+-- {-# INLINE [0] justifyLeftI #-}

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

515+

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

516+-- -- ----------------------------------------------------------------------------

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

517+-- -- * Reducing Streams (folds)

518−

518+

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

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

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

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

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

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

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

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

523− where

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

524− loop0_foldl1 !s = case next s of

524+-- foldl f z0 (Stream next s0) = loop_foldl z0 s0

525− Skip s' -> loop0_foldl1 s'

525+-- where

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

526+-- loop_foldl z !s = case next s of

527− Done -> emptyError "foldl1"

527+-- Done -> z

528− loop_foldl1 z !s = case next s of

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

529− Done -> z

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

530− Skip s' -> loop_foldl1 z s'

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

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

531+

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

532+-- -- | A strict version of foldl.

533−

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

534−-- | A strict version of foldl1.

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

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

535+-- foldl' f z0 (Stream next s0) = loop_foldl' z0 s0

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

536+-- where

537− where

537+-- loop_foldl' !z !s = case next s of

538− loop0_foldl1' !s = case next s of

538+-- Done -> z

539− Skip s' -> loop0_foldl1' s'

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

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

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

541− Done -> emptyError "foldl1"

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

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

542+

543− Done -> z

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

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

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

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

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

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

546+-- -- foldl1 f (Stream next s0 _len) = loop0_foldl1 s0

547−

547+-- foldl1 f (Stream next s0) = loop0_foldl1 s0

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

548+-- where

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

549+-- loop0_foldl1 !s = case next s of

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

550+-- Skip s' -> loop0_foldl1 s'

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

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

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

552+-- Done -> emptyError "foldl1"

553− where

553+-- loop_foldl1 z !s = case next s of

554− loop_foldr !s = case next s of

554+-- Done -> z

555− Done -> z

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

556− Skip s' -> loop_foldr s'

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

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

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

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

558+

559−

559+-- -- | A strict version of foldl1.

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

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

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

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

562−-- Subject to array fusion.

562+-- foldl1' f (Stream next s0) = loop0_foldl1' s0

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

563+-- where

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

564+-- loop0_foldl1' !s = case next s of

565− where

565+-- Skip s' -> loop0_foldl1' s'

566− loop0_foldr1 !s = case next s of

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

567− Done -> emptyError "foldr1"

567+-- Done -> emptyError "foldl1"

568− Skip s' -> loop0_foldr1 s'

568+-- loop_foldl1' !z !s = case next s of

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

569+-- Done -> z

570−

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

571− loop_foldr1 x !s = case next s of

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

572− Done -> x

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

573− Skip s' -> loop_foldr1 x s'

573+

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

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

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

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

576−

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

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

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

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

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

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

579+-- foldr f z (Stream next s0) = loop_foldr s0

580−

580+-- where

581−-- ----------------------------------------------------------------------------

581+-- loop_foldr !s = case next s of

582−-- ** Special folds

582+-- Done -> z

583−

583+-- Skip s' -> loop_foldr s'

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

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

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

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

586−concat = L.foldr append empty

586+

587−{-# INLINE [0] concat #-}

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

588−

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

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

589+-- -- Subject to array fusion.

590−-- results.

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

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

591+-- -- foldr1 f (Stream next s0 _len) = loop0_foldr1 s0

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

592+-- foldr1 f (Stream next s0) = loop0_foldr1 s0

593−{-# INLINE [0] concatMap #-}

593+-- where

594−

594+-- loop0_foldr1 !s = case next s of

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

595+-- Done -> emptyError "foldr1"

596−-- @xs@ satisfies the predicate @p@.

596+-- Skip s' -> loop0_foldr1 s'

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

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

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

598+

599− where

599+-- loop_foldr1 x !s = case next s of

600− loop_any !s = case next0 s of

600+-- Done -> x

601− Done -> False

601+-- Skip s' -> loop_foldr1 x s'

602− Skip s' -> loop_any s'

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

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

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

604− | otherwise -> loop_any s'

604+

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

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

606−

606+-- intercalate s = concat . (L.intersperse s)

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

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

608−-- @xs@ satisfy the predicate @p@.

608+

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

609+-- -- ----------------------------------------------------------------------------

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

610+-- -- ** Special folds

611− where

611+

612− loop_all !s = case next0 s of

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

613− Done -> True

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

614− Skip s' -> loop_all s'

614+-- concat = L.foldr append empty

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

615+-- {-# INLINE [0] concat #-}

616− | otherwise -> False

616+

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

617+-- -- | Map a function over a stream that results in a stream and concatenate the

618−

618+-- -- results.

619−-- | /O(n)/ maximum returns the maximum value from a stream, which must be

619+-- concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char

620−-- non-empty.

620+-- concatMap f = foldr (append . f) empty

621−maximum :: Stream Char -> Char

621+-- {-# INLINE [0] concatMap #-}

622−maximum (Stream next0 s0 _len) = loop0_maximum s0

622+

623− where

623+-- -- | /O(n)/ any @p @xs determines if any character in the stream

624− loop0_maximum !s = case next0 s of

624+-- -- @xs@ satisfies the predicate @p@.

625− Done -> emptyError "maximum"

625+-- any :: (Char -> Bool) -> Stream Char -> Bool

626− Skip s' -> loop0_maximum s'

626+-- -- any p (Stream next0 s0 _len) = loop_any s0

627− Yield x s' -> loop_maximum x s'

627+-- any p (Stream next0 s0) = loop_any s0

628− loop_maximum !z !s = case next0 s of

628+-- where

629− Done -> z

629+-- loop_any !s = case next0 s of

630− Skip s' -> loop_maximum z s'

630+-- Done -> False

631− Yield x s'

631+-- Skip s' -> loop_any s'

632− | x > z -> loop_maximum x s'

632+-- Yield x s' | p x -> True

633− | otherwise -> loop_maximum z s'

633+-- | otherwise -> loop_any s'

634−{-# INLINE [0] maximum #-}

634+-- {-# INLINE [0] any #-}

635−

635+

636−-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be

636+-- -- | /O(n)/ all @p @xs determines if all characters in the 'Text'

637−-- non-empty.

637+-- -- @xs@ satisfy the predicate @p@.

638−minimum :: Stream Char -> Char

638+-- all :: (Char -> Bool) -> Stream Char -> Bool

639−minimum (Stream next0 s0 _len) = loop0_minimum s0

639+-- -- all p (Stream next0 s0 _len) = loop_all s0

640− where

640+-- all p (Stream next0 s0) = loop_all s0

641− loop0_minimum !s = case next0 s of

641+-- where

642− Done -> emptyError "minimum"

642+-- loop_all !s = case next0 s of

643− Skip s' -> loop0_minimum s'

643+-- Done -> True

644− Yield x s' -> loop_minimum x s'

644+-- Skip s' -> loop_all s'

645− loop_minimum !z !s = case next0 s of

645+-- Yield x s' | p x -> loop_all s'

646− Done -> z

646+-- | otherwise -> False

647− Skip s' -> loop_minimum z s'

647+-- {-# INLINE [0] all #-}

648− Yield x s'

648+

649− | x < z -> loop_minimum x s'

649+-- -- | /O(n)/ maximum returns the maximum value from a stream, which must be

650− | otherwise -> loop_minimum z s'

650+-- -- non-empty.

651−{-# INLINE [0] minimum #-}

651+-- maximum :: Stream Char -> Char

652−

652+-- -- maximum (Stream next0 s0 _len) = loop0_maximum s0

653−-- -----------------------------------------------------------------------------

653+-- maximum (Stream next0 s0) = loop0_maximum s0

654−-- * Building streams

654+-- where

655−

655+-- loop0_maximum !s = case next0 s of

656−scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

656+-- Done -> emptyError "maximum"

657−scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

657+-- Skip s' -> loop0_maximum s'

658− where

658+-- Yield x s' -> loop_maximum x s'

659− {-# INLINE next #-}

659+-- loop_maximum !z !s = case next0 s of

660− next (Scan1 z s) = Yield z (Scan2 z s)

660+-- Done -> z

661− next (Scan2 z s) = case next0 s of

661+-- Skip s' -> loop_maximum z s'

662− Yield x s' -> let !x' = f z x

662+-- Yield x s'

663− in Yield x' (Scan2 x' s')

663+-- | x > z -> loop_maximum x s'

664− Skip s' -> Skip (Scan2 z s')

664+-- | otherwise -> loop_maximum z s'

665− Done -> Done

665+-- {-# INLINE [0] maximum #-}

666−{-# INLINE [0] scanl #-}

666+

667−

667+-- -- | /O(n)/ minimum returns the minimum value from a 'Text', which must be

668−-- -----------------------------------------------------------------------------

668+-- -- non-empty.

669−-- ** Generating and unfolding streams

669+-- minimum :: Stream Char -> Char

670−

670+-- -- minimum (Stream next0 s0 _len) = loop0_minimum s0

671−replicateCharI :: Integral a => a -> Char -> Stream Char

671+-- minimum (Stream next0 s0) = loop0_minimum s0

672−replicateCharI !n !c

672+-- where

673− | n < 0 = empty

673+-- loop0_minimum !s = case next0 s of

674− | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

674+-- Done -> emptyError "minimum"

675− where

675+-- Skip s' -> loop0_minimum s'

676− next !i | i >= n = Done

676+-- Yield x s' -> loop_minimum x s'

677− | otherwise = Yield c (i + 1)

677+-- loop_minimum !z !s = case next0 s of

678−{-# INLINE [0] replicateCharI #-}

678+-- Done -> z

679−

679+-- Skip s' -> loop_minimum z s'

680−data RI s = RI !s {-# UNPACK #-} !Int64

680+-- Yield x s'

681−

681+-- | x < z -> loop_minimum x s'

682−replicateI :: Int64 -> Stream Char -> Stream Char

682+-- | otherwise -> loop_minimum z s'

683−replicateI n (Stream next0 s0 len) =

683+-- {-# INLINE [0] minimum #-}

684− Stream next (RI s0 0) (fromIntegral (max 0 n) * len)

684+

685− where

685+-- -- -----------------------------------------------------------------------------

686− next (RI s k)

686+-- -- * Building streams

687− | k >= n = Done

687+

688− | otherwise = case next0 s of

688+-- scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

689− Done -> Skip (RI s0 (k+1))

689+-- -- scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

690− Skip s' -> Skip (RI s' k)

690+-- scanl f z0 (Stream next0 s0) = Stream next (Scan1 z0 s0) -- (len+1) -- HINT maybe too low

691− Yield x s' -> Yield x (RI s' k)

691+-- where

692−{-# INLINE [0] replicateI #-}

692+-- {-# INLINE next #-}

693−

693+-- next (Scan1 z s) = Yield z (Scan2 z s)

694−-- | /O(n)/, where @n@ is the length of the result. The unfoldr function

694+-- next (Scan2 z s) = case next0 s of

695−-- is analogous to the List 'unfoldr'. unfoldr builds a stream

695+-- Yield x s' -> let !x' = f z x

696−-- from a seed value. The function takes the element and returns

696+-- in Yield x' (Scan2 x' s')

697−-- Nothing if it is done producing the stream or returns Just

697+-- Skip s' -> Skip (Scan2 z s')

698−-- (a,b), in which case, a is the next Char in the string, and b is

698+-- Done -> Done

699−-- the seed value for further production.

699+-- {-# INLINE [0] scanl #-}

700−unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char

700+

701−unfoldr f s0 = Stream next s0 1 -- HINT maybe too low

701+-- -- -----------------------------------------------------------------------------

702− where

702+-- -- ** Generating and unfolding streams

703− {-# INLINE next #-}

703+

704− next !s = case f s of

704+-- replicateCharI :: Integral a => a -> Char -> Stream Char

705− Nothing -> Done

705+-- replicateCharI n c

706− Just (w, s') -> Yield w s'

706+-- | n < 0 = empty

707−{-# INLINE [0] unfoldr #-}

707+-- | otherwise = Stream next 0 -- (fromIntegral n) -- HINT maybe too low

708−

708+-- where

709−-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed

709+-- next i | i >= n = Done

710−-- value. However, the length of the result is limited by the

710+-- | otherwise = Yield c (i + 1)

711−-- first argument to 'unfoldrNI'. This function is more efficient than

711+-- {-# INLINE [0] replicateCharI #-}

712−-- 'unfoldr' when the length of the result is known.

712+

713−unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char

713+-- data RI s = RI !s {-# UNPACK #-} !Int64

714−unfoldrNI n f s0 | n < 0 = empty

714+

715− | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high

715+-- replicateI :: Int64 -> Stream Char -> Stream Char

716− where

716+-- -- replicateI n (Stream next0 s0 len) =

717− {-# INLINE next #-}

717+-- replicateI n (Stream next0 s0) =

718− next (z :*: s) = case f s of

718+-- Stream next (RI s0 0) -- (fromIntegral (max 0 n) * len)

719− Nothing -> Done

719+-- where

720− Just (w, s') | z >= n -> Done

720+-- next (RI s k)

721− | otherwise -> Yield w ((z + 1) :*: s')

721+-- | k >= n = Done

722−{-# INLINE unfoldrNI #-}

722+-- | otherwise = case next0 s of

723−

723+-- Done -> Skip (RI s0 (k+1))

724−-------------------------------------------------------------------------------

724+-- Skip s' -> Skip (RI s' k)

725−-- * Substreams

725+-- Yield x s' -> Yield x (RI s' k)

726−

726+-- {-# INLINE [0] replicateI #-}

727−-- | /O(n)/ take n, applied to a stream, returns the prefix of the

727+

728−-- stream of length @n@, or the stream itself if @n@ is greater than the

728+-- -- | /O(n)/, where @n@ is the length of the result. The unfoldr function

729−-- length of the stream.

729+-- -- is analogous to the List 'unfoldr'. unfoldr builds a stream

730−take :: Integral a => a -> Stream Char -> Stream Char

730+-- -- from a seed value. The function takes the element and returns

731−take n0 (Stream next0 s0 len) =

731+-- -- Nothing if it is done producing the stream or returns Just

732− Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))

732+-- -- (a,b), in which case, a is the next Char in the string, and b is

733− where

733+-- -- the seed value for further production.

734− {-# INLINE next #-}

734+-- unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char

735− next (n :*: s) | n <= 0 = Done

735+-- unfoldr f s0 = Stream next s0 -- 1 -- HINT maybe too low

736− | otherwise = case next0 s of

736+-- where

737− Done -> Done

737+-- {-# INLINE next #-}

738− Skip s' -> Skip (n :*: s')

738+-- next !s = case f s of

739− Yield x s' -> Yield x ((n-1) :*: s')

739+-- Nothing -> Done

740−{-# INLINE [0] take #-}

740+-- Just (w, s') -> Yield w s'

741−

741+-- {-# INLINE [0] unfoldr #-}

742−data Drop a s = NS !s

742+

743− | JS !a !s

743+-- -- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed

744−

744+-- -- value. However, the length of the result is limited by the

745−-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

745+-- -- first argument to 'unfoldrNI'. This function is more efficient than

746−-- stream after the first @n@ characters, or the empty stream if @n@

746+-- -- 'unfoldr' when the length of the result is known.

747−-- is greater than the length of the stream.

747+-- unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char

748−drop :: Integral a => a -> Stream Char -> Stream Char

748+-- unfoldrNI n f s0 | n < 0 = empty

749−drop n0 (Stream next0 s0 len) =

749+-- | otherwise = Stream next (0 :*: s0) -- (fromIntegral (n*2)) -- HINT maybe too high

750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

750+-- where

751− where

751+-- {-# INLINE next #-}

752− {-# INLINE next #-}

752+-- next (z :*: s) = case f s of

753− next (JS n s)

753+-- Nothing -> Done

754− | n <= 0 = Skip (NS s)

754+-- Just (w, s') | z >= n -> Done

755− | otherwise = case next0 s of

755+-- | otherwise -> Yield w ((z + 1) :*: s')

756− Done -> Done

756+-- {-# INLINE unfoldrNI #-}

757− Skip s' -> Skip (JS n s')

757+

758− Yield _ s' -> Skip (JS (n-1) s')

758+-- -------------------------------------------------------------------------------

759− next (NS s) = case next0 s of

759+-- -- * Substreams

760− Done -> Done

760+

761− Skip s' -> Skip (NS s')

761+-- -- | /O(n)/ take n, applied to a stream, returns the prefix of the

762− Yield x s' -> Yield x (NS s')

762+-- -- stream of length @n@, or the stream itself if @n@ is greater than the

763−{-# INLINE [0] drop #-}

763+-- -- length of the stream.

764−

764+-- take :: Integral a => a -> Stream Char -> Stream Char

765−-- | takeWhile, applied to a predicate @p@ and a stream, returns the

765+-- take n0 (Stream next0 s0) =

766−-- longest prefix (possibly empty) of elements that satisfy p.

766+-- -- take n0 (Stream next0 s0 len) =

767−takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char

767+-- Stream next (n0 :*: s0) -- (smaller len (fromIntegral (max 0 n0)))

768−takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

768+-- where

769− where

769+-- {-# INLINE next #-}

770− {-# INLINE next #-}

770+-- next (n :*: s) | n <= 0 = Done

771− next !s = case next0 s of

771+-- | otherwise = case next0 s of

772− Done -> Done

772+-- Done -> Done

773− Skip s' -> Skip s'

773+-- Skip s' -> Skip (n :*: s')

774− Yield x s' | p x -> Yield x s'

774+-- Yield x s' -> Yield x ((n-1) :*: s')

775− | otherwise -> Done

775+-- {-# INLINE [0] take #-}

776−{-# INLINE [0] takeWhile #-}

776+

777−

777+-- data Drop a s = NS !s

778−-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

778+-- | JS !a !s

779−dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

779+

780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high

780+-- -- | /O(n)/ drop n, applied to a stream, returns the suffix of the

781− where

781+-- -- stream after the first @n@ characters, or the empty stream if @n@

782− {-# INLINE next #-}

782+-- -- is greater than the length of the stream.

783− next (L s) = case next0 s of

783+-- drop :: Integral a => a -> Stream Char -> Stream Char

784− Done -> Done

784+-- -- drop n0 (Stream next0 s0 len) =

785− Skip s' -> Skip (L s')

785+-- drop n0 (Stream next0 s0) =

786− Yield x s' | p x -> Skip (L s')

786+-- Stream next (JS n0 s0) -- (len - fromIntegral (max 0 n0))

787− | otherwise -> Yield x (R s')

787+-- where

788− next (R s) = case next0 s of

788+-- {-# INLINE next #-}

789− Done -> Done

789+-- next (JS n s)

790− Skip s' -> Skip (R s')

790+-- | n <= 0 = Skip (NS s)

791− Yield x s' -> Yield x (R s')

791+-- | otherwise = case next0 s of

792−{-# INLINE [0] dropWhile #-}

792+-- Done -> Done

793−

793+-- Skip s' -> Skip (JS n s')

794−-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

794+-- Yield _ s' -> Skip (JS (n-1) s')

795−-- 'True' iff the first is a prefix of the second.

795+-- next (NS s) = case next0 s of

796−isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool

796+-- Done -> Done

797−isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

797+-- Skip s' -> Skip (NS s')

798− where

798+-- Yield x s' -> Yield x (NS s')

799− loop Done _ = True

799+-- {-# INLINE [0] drop #-}

800− loop _ Done = False

800+

801− loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

801+-- -- | takeWhile, applied to a predicate @p@ and a stream, returns the

802− loop (Skip s1') x2 = loop (next1 s1') x2

802+-- -- longest prefix (possibly empty) of elements that satisfy p.

803− loop x1 (Skip s2') = loop x1 (next2 s2')

803+-- takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char

804− loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

804+-- -- takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

805− loop (next1 s1') (next2 s2')

805+-- takeWhile p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high

806−{-# INLINE [0] isPrefixOf #-}

806+-- where

807−

807+-- {-# INLINE next #-}

808−-- ----------------------------------------------------------------------------

808+-- next !s = case next0 s of

809−-- * Searching

809+-- Done -> Done

810−

810+-- Skip s' -> Skip s'

811−-------------------------------------------------------------------------------

811+-- Yield x s' | p x -> Yield x s'

812−-- ** Searching by equality

812+-- | otherwise -> Done

813−

813+-- {-# INLINE [0] takeWhile #-}

814−-- | /O(n)/ elem is the stream membership predicate.

814+

815−elem :: Char -> Stream Char -> Bool

815+-- -- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

816−elem w (Stream next s0 _len) = loop_elem s0

816+-- dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

817− where

817+-- -- dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high

818− loop_elem !s = case next s of

818+-- dropWhile p (Stream next0 s0) = Stream next (L s0) -- len -- HINT maybe too high

819− Done -> False

819+-- where

820− Skip s' -> loop_elem s'

820+-- {-# INLINE next #-}

821− Yield x s' | x == w -> True

821+-- next (L s) = case next0 s of

822− | otherwise -> loop_elem s'

822+-- Done -> Done

823−{-# INLINE [0] elem #-}

823+-- Skip s' -> Skip (L s')

824−

824+-- Yield x s' | p x -> Skip (L s')

825−-------------------------------------------------------------------------------

825+-- | otherwise -> Yield x (R s')

826−-- ** Searching with a predicate

826+-- next (R s) = case next0 s of

827−

827+-- Done -> Done

828−-- | /O(n)/ The 'findBy' function takes a predicate and a stream,

828+-- Skip s' -> Skip (R s')

829−-- and returns the first element in matching the predicate, or 'Nothing'

829+-- Yield x s' -> Yield x (R s')

830−-- if there is no such element.

830+-- {-# INLINE [0] dropWhile #-}

831−

831+

832−findBy :: (Char -> Bool) -> Stream Char -> Maybe Char

832+-- -- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

833−findBy p (Stream next s0 _len) = loop_find s0

833+-- -- 'True' iff the first is a prefix of the second.

834− where

834+-- isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool

835− loop_find !s = case next s of

835+-- -- isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

836− Done -> Nothing

836+-- isPrefixOf (Stream next1 s1) (Stream next2 s2) = loop (next1 s1) (next2 s2)

837− Skip s' -> loop_find s'

837+-- where

838− Yield x s' | p x -> Just x

838+-- loop Done _ = True

839− | otherwise -> loop_find s'

839+-- loop _ Done = False

840−{-# INLINE [0] findBy #-}

840+-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

841−

841+-- loop (Skip s1') x2 = loop (next1 s1') x2

842−-- | /O(n)/ Stream index (subscript) operator, starting from 0.

842+-- loop x1 (Skip s2') = loop x1 (next2 s2')

843−indexI :: Integral a => Stream Char -> a -> Char

843+-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

844−indexI (Stream next s0 _len) n0

844+-- loop (next1 s1') (next2 s2')

845− | n0 < 0 = streamError "index" "Negative index"

845+-- {-# INLINE [0] isPrefixOf #-}

846− | otherwise = loop_index n0 s0

846+

847− where

847+-- -- ----------------------------------------------------------------------------

848− loop_index !n !s = case next s of

848+-- -- * Searching

849− Done -> streamError "index" "Index too large"

849+

850− Skip s' -> loop_index n s'

850+-- -------------------------------------------------------------------------------

851− Yield x s' | n == 0 -> x

851+-- -- ** Searching by equality

852− | otherwise -> loop_index (n-1) s'

852+

853−{-# INLINE [0] indexI #-}

853+-- -- | /O(n)/ elem is the stream membership predicate.

854−

854+-- elem :: Char -> Stream Char -> Bool

855−-- | /O(n)/ 'filter', applied to a predicate and a stream,

855+-- -- elem w (Stream next s0 _len) = loop_elem s0

856−-- returns a stream containing those characters that satisfy the

856+-- elem w (Stream next s0) = loop_elem s0

857−-- predicate.

857+-- where

858−filter :: (Char -> Bool) -> Stream Char -> Stream Char

858+-- loop_elem !s = case next s of

859−filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

859+-- Done -> False

860− where

860+-- Skip s' -> loop_elem s'

861− next !s = case next0 s of

861+-- Yield x s' | x == w -> True

862− Done -> Done

862+-- | otherwise -> loop_elem s'

863− Skip s' -> Skip s'

863+-- {-# INLINE [0] elem #-}

864− Yield x s' | p x -> Yield x s'

864+

865− | otherwise -> Skip s'

865+-- -------------------------------------------------------------------------------

866−{-# INLINE [0] filter #-}

866+-- -- ** Searching with a predicate

867−

867+

868−{-# RULES

868+-- -- | /O(n)/ The 'findBy' function takes a predicate and a stream,

869− "STREAM filter/filter fusion" forall p q s.

869+-- -- and returns the first element in matching the predicate, or 'Nothing'

870− filter p (filter q s) = filter (\x -> q x && p x) s

870+-- -- if there is no such element.

871− #-}

871+

872−

872+-- findBy :: (Char -> Bool) -> Stream Char -> Maybe Char

873−-- | The 'findIndexI' function takes a predicate and a stream and

873+-- -- findBy p (Stream next s0 _len) = loop_find s0

874−-- returns the index of the first element in the stream satisfying the

874+-- findBy p (Stream next s0) = loop_find s0

875−-- predicate.

875+-- where

876−findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a

876+-- loop_find !s = case next s of

877−findIndexI p s = case findIndicesI p s of

877+-- Done -> Nothing

878− (i:_) -> Just i

878+-- Skip s' -> loop_find s'

879− _ -> Nothing

879+-- Yield x s' | p x -> Just x

880−{-# INLINE [0] findIndexI #-}

880+-- | otherwise -> loop_find s'

881−

881+-- {-# INLINE [0] findBy #-}

882−-- | The 'findIndicesI' function takes a predicate and a stream and

882+

883−-- returns all indices of the elements in the stream satisfying the

883+-- -- | /O(n)/ Stream index (subscript) operator, starting from 0.

884−-- predicate.

884+-- indexI :: Integral a => Stream Char -> a -> Char

885−findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]

885+-- -- indexI (Stream next s0 _len) n0

886−findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

886+-- indexI (Stream next s0) n0

887− where

887+-- | n0 < 0 = streamError "index" "Negative index"

888− loop_findIndex !i !s = case next s of

888+-- | otherwise = loop_index n0 s0

889− Done -> []

889+-- where

890− Skip s' -> loop_findIndex i s' -- hmm. not caught by QC

890+-- loop_index !n !s = case next s of

891− Yield x s' | p x -> i : loop_findIndex (i+1) s'

891+-- Done -> streamError "index" "Index too large"

892− | otherwise -> loop_findIndex (i+1) s'

892+-- Skip s' -> loop_index n s'

893−{-# INLINE [0] findIndicesI #-}

893+-- Yield x s' | n == 0 -> x

894−

894+-- | otherwise -> loop_index (n-1) s'

895−-------------------------------------------------------------------------------

895+-- {-# INLINE [0] indexI #-}

896−-- * Zipping

896+

897−

897+-- -- | /O(n)/ 'filter', applied to a predicate and a stream,

898−-- | Strict triple.

898+-- -- returns a stream containing those characters that satisfy the

899−data Zip a b m = Z1 !a !b

899+-- -- predicate.

900− | Z2 !a !b !m

900+-- filter :: (Char -> Bool) -> Stream Char -> Stream Char

901−

901+-- -- filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

902−-- | zipWith generalises 'zip' by zipping with the function given as

902+-- filter p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high

903−-- the first argument, instead of a tupling function.

903+-- where

904−zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b

904+-- next !s = case next0 s of

905−zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

905+-- Done -> Done

906− Stream next (Z1 sa0 sb0) (smaller len1 len2)

906+-- Skip s' -> Skip s'

907− where

907+-- Yield x s' | p x -> Yield x s'

908− next (Z1 sa sb) = case next0 sa of

908+-- | otherwise -> Skip s'

909− Done -> Done

909+-- {-# INLINE [0] filter #-}

910− Skip sa' -> Skip (Z1 sa' sb)

910+

911− Yield a sa' -> Skip (Z2 sa' sb a)

911+-- {-# RULES

912−

912+-- "STREAM filter/filter fusion" forall p q s.

913− next (Z2 sa' sb a) = case next1 sb of

913+-- filter p (filter q s) = filter (\x -> q x && p x) s

914− Done -> Done

914+-- #-}

915− Skip sb' -> Skip (Z2 sa' sb' a)

915+

916− Yield b sb' -> Yield (f a b) (Z1 sa' sb')

916+-- -- | The 'findIndexI' function takes a predicate and a stream and

917−{-# INLINE [0] zipWith #-}

917+-- -- returns the index of the first element in the stream satisfying the

918−

918+-- -- predicate.

919−-- | /O(n)/ The 'countCharI' function returns the number of times the

919+-- findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a

920−-- query element appears in the given stream.

920+-- findIndexI p s = case findIndicesI p s of

921−countCharI :: Integral a => Char -> Stream Char -> a

921+-- (i:_) -> Just i

922−countCharI a (Stream next s0 _len) = loop 0 s0

922+-- _ -> Nothing

923− where

923+-- {-# INLINE [0] findIndexI #-}

924− loop !i !s = case next s of

924+

925− Done -> i

925+-- -- | The 'findIndicesI' function takes a predicate and a stream and

926− Skip s' -> loop i s'

926+-- -- returns all indices of the elements in the stream satisfying the

927− Yield x s' | a == x -> loop (i+1) s'

927+-- -- predicate.

928− | otherwise -> loop i s'

928+-- findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]

929−{-# INLINE [0] countCharI #-}

929+-- -- findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

930−

930+-- findIndicesI p (Stream next s0) = loop_findIndex 0 s0

931−streamError :: String -> String -> a

931+-- where

932−streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg

932+-- loop_findIndex !i !s = case next s of

933−

933+-- Done -> []

934−emptyError :: String -> a

934+-- Skip s' -> loop_findIndex i s' -- hmm. not caught by QC

935−emptyError func = internalError func "Empty input"

935+-- Yield x s' | p x -> i : loop_findIndex (i+1) s'

936−

936+-- | otherwise -> loop_findIndex (i+1) s'

937−internalError :: String -> a

937+-- {-# INLINE [0] findIndicesI #-}

938−internalError func = streamError func "Internal error"

938+

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+102−99

@@ -19,104 +19,107 @@

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

29 ) where

30 ) where

31−import Data.Text.Internal.Fusion.Size

32+-- import Data.Text.Internal.Fusion.Size

32−import Data.Word (Word8)

33+-- import Data.Word (Word8)

33−

34+

35+import Data.JSString.Internal.Fusion.Types

36+

34−-- | Specialised tuple for case conversion.

37+-- -- | Specialised tuple for case conversion.

35−data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

38+-- data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

36−

39+

37−-- | Restreaming state.

40+-- -- | Restreaming state.

38−data RS s

41+-- data RS s

39− = RS0 !s

42+-- = RS0 !s

40− | RS1 !s {-# UNPACK #-} !Word8

43+-- | RS1 !s {-# UNPACK #-} !Word8

41− | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

44+-- | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

42− | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

45+-- | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

43−

46+

44−-- | Strict pair.

47+-- -- | Strict pair.

45−data PairS a b = !a :*: !b

48+-- data PairS a b = !a :*: !b

46− -- deriving (Eq, Ord, Show)

49+-- -- deriving (Eq, Ord, Show)

47−infixl 2 :*:

50+-- infixl 2 :*:

48−

51+

49−-- | An intermediate result in a scan.

52+-- -- | An intermediate result in a scan.

50−data Scan s = Scan1 {-# UNPACK #-} !Char !s

53+-- data Scan s = Scan1 {-# UNPACK #-} !Char !s

51− | Scan2 {-# UNPACK #-} !Char !s

54+-- | Scan2 {-# UNPACK #-} !Char !s

52−

55+

53−-- | Intermediate result in a processing pipeline.

56+-- -- | Intermediate result in a processing pipeline.

54−data Step s a = Done

57+-- data Step s a = Done

55− | Skip !s

58+-- | Skip !s

56− | Yield !a !s

59+-- | Yield !a !s

57−

60+

58−{-

61+-- {-

59−instance (Show a) => Show (Step s a)

62+-- instance (Show a) => Show (Step s a)

60− where show Done = "Done"

63+-- where show Done = "Done"

61− show (Skip _) = "Skip"

64+-- show (Skip _) = "Skip"

62− show (Yield x _) = "Yield " ++ show x

65+-- show (Yield x _) = "Yield " ++ show x

63−-}

66+-- -}

64−

67+

65−instance (Eq a) => Eq (Stream a) where

68+-- instance (Eq a) => Eq (Stream a) where

66− (==) = eq

69+-- (==) = eq

67−

70+

68−instance (Ord a) => Ord (Stream a) where

71+-- instance (Ord a) => Ord (Stream a) where

69− compare = cmp

72+-- compare = cmp

70−

73+

71−-- The length hint in a Stream has two roles. If its value is zero,

74+-- -- The length hint in a Stream has two roles. If its value is zero,

72−-- we trust it, and treat the stream as empty. Otherwise, we treat it

75+-- -- we trust it, and treat the stream as empty. Otherwise, we treat it

73−-- as a hint: it should usually be accurate, so we use it when

76+-- -- as a hint: it should usually be accurate, so we use it when

74−-- unstreaming to decide what size array to allocate. However, the

77+-- -- unstreaming to decide what size array to allocate. However, the

75−-- unstreaming functions must be able to cope with the hint being too

78+-- -- unstreaming functions must be able to cope with the hint being too

76−-- small or too large.

79+-- -- small or too large.

77−--

80+-- --

78−-- The size hint tries to track the UTF-16 code points in a stream,

81+-- -- The size hint tries to track the UTF-16 code points in a stream,

79−-- but often counts the number of characters instead. It can easily

82+-- -- but often counts the number of characters instead. It can easily

80−-- undercount if, for instance, a transformed stream contains astral

83+-- -- undercount if, for instance, a transformed stream contains astral

81−-- plane characters (those above 0x10000).

84+-- -- plane characters (those above 0x10000).

82−

85+

83−data Stream a =

86+-- data Stream a =

84− forall s. Stream

87+-- forall s. Stream

85− (s -> Step s a) -- stepper function

88+-- (s -> Step s a) -- stepper function

86− !s -- current state

89+-- !s -- current state

87− !Size -- size hint

90+-- !Size -- size hint

88−

91+

89−-- | /O(n)/ Determines if two streams are equal.

92+-- -- | /O(n)/ Determines if two streams are equal.

90−eq :: (Eq a) => Stream a -> Stream a -> Bool

93+-- eq :: (Eq a) => Stream a -> Stream a -> Bool

91−eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

94+-- eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

92− where

95+-- where

93− loop Done Done = True

96+-- loop Done Done = True

94− loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

97+-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

95− loop (Skip s1') x2 = loop (next1 s1') x2

98+-- loop (Skip s1') x2 = loop (next1 s1') x2

96− loop x1 (Skip s2') = loop x1 (next2 s2')

99+-- loop x1 (Skip s2') = loop x1 (next2 s2')

97− loop Done _ = False

100+-- loop Done _ = False

98− loop _ Done = False

101+-- loop _ Done = False

99− loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

102+-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

100− loop (next1 s1') (next2 s2')

103+-- loop (next1 s1') (next2 s2')

101−{-# INLINE [0] eq #-}

104+-- {-# INLINE [0] eq #-}

102−

105+

103−cmp :: (Ord a) => Stream a -> Stream a -> Ordering

106+-- cmp :: (Ord a) => Stream a -> Stream a -> Ordering

104−cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

107+-- cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

105− where

108+-- where

106− loop Done Done = EQ

109+-- loop Done Done = EQ

107− loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

110+-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')

108− loop (Skip s1') x2 = loop (next1 s1') x2

111+-- loop (Skip s1') x2 = loop (next1 s1') x2

109− loop x1 (Skip s2') = loop x1 (next2 s2')

112+-- loop x1 (Skip s2') = loop x1 (next2 s2')

110− loop Done _ = LT

113+-- loop Done _ = LT

111− loop _ Done = GT

114+-- loop _ Done = GT

112− loop (Yield x1 s1') (Yield x2 s2') =

115+-- loop (Yield x1 s1') (Yield x2 s2') =

113− case compare x1 x2 of

116+-- case compare x1 x2 of

114− EQ -> loop (next1 s1') (next2 s2')

117+-- EQ -> loop (next1 s1') (next2 s2')

115− other -> other

118+-- other -> other

116−{-# INLINE [0] cmp #-}

119+-- {-# INLINE [0] cmp #-}

117−

120+

118−-- | The empty stream.

121+-- -- | The empty stream.

119−empty :: Stream a

122+-- empty :: Stream a

120−empty = Stream next () 0

123+-- empty = Stream next () 0

121− where next _ = Done

124+-- where next _ = Done

122−{-# INLINE [0] empty #-}

125+-- {-# INLINE [0] empty #-}

Data/Text/Internal/IO.hs+8

@@ -95,7 +95,11 @@ unpack !buf !r !w

95 | r >= w = return T.empty

96 | otherwise = withRawBuffer buf go

97 where

98+#ifndef __GHCJS__

98 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))

99 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))

100+#else

101+ go pbuf = return $! unstream (Stream next r)

102+#endif

99 where

103 where

100 next !i | i >= w = Done

104 next !i | i >= w = Done

101 | otherwise = Yield (ix i) (i+1)

105 | otherwise = Yield (ix i) (i+1)

@@ -108,7 +112,11 @@ unpack_nl !buf !r !w

108 | otherwise = withRawBuffer buf $ go

112 | otherwise = withRawBuffer buf $ go

109 where

113 where

110 go pbuf = do

114 go pbuf = do

115+#ifndef __GHCJS__

111 let !t = unstream (Stream next r (maxSize (w-r)))

116 let !t = unstream (Stream next r (maxSize (w-r)))

117+#else

118+ let !t = unstream (Stream next r)

119+#endif

112 w' = w - 1

120 w' = w - 1

113 return $ if ix w' == '\r'

121 return $ if ix w' == '\r'

114 then (t,w')

122 then (t,w')

Data/Text/Internal/Lazy.hs+20−1

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}

1+{-# LANGUAGE BangPatterns, DeriveDataTypeable, CPP #-}

2{-# OPTIONS_HADDOCK not-home #-}

4-- |

@@ -44,6 +44,10 @@ 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+

47data Text = Empty

51data Text = Empty

48 | Chunk {-# UNPACK #-} !T.Text Text

52 | Chunk {-# UNPACK #-} !T.Text Text

49 deriving (Typeable)

53 deriving (Typeable)

@@ -57,16 +61,26 @@ data Text = Empty

57-- | Check the invariant strictly.

61-- | Check the invariant strictly.

58strictInvariant :: Text -> Bool

62strictInvariant :: Text -> Bool

59strictInvariant Empty = True

63strictInvariant Empty = True

64+#ifndef __GHCJS__

60strictInvariant x@(Chunk (T.Text _ _ len) cs)

65strictInvariant x@(Chunk (T.Text _ _ len) cs)

61 | len > 0 = strictInvariant cs

66 | len > 0 = strictInvariant cs

67+#else

68+strictInvariant x@(Chunk t cs)

69+ | TT.length t > 0 = strictInvariant cs

70+#endif

62 | otherwise = error $ "Data.Text.Lazy: invariant violation: "

71 | otherwise = error $ "Data.Text.Lazy: invariant violation: "

63 ++ showStructure x

72 ++ showStructure x

65-- | Check the invariant lazily.

74-- | Check the invariant lazily.

66lazyInvariant :: Text -> Text

75lazyInvariant :: Text -> Text

67lazyInvariant Empty = Empty

76lazyInvariant Empty = Empty

77+#ifndef __GHCJS__

68lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)

78lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)

69 | len > 0 = Chunk c (lazyInvariant cs)

79 | len > 0 = Chunk c (lazyInvariant cs)

80+#else

81+lazyInvariant x@(Chunk c cs)

82+ | TT.length c > 0 = Chunk c (lazyInvariant cs)

83+#endif

70 | otherwise = error $ "Data.Text.Lazy: invariant violation: "

84 | otherwise = error $ "Data.Text.Lazy: invariant violation: "

71 ++ showStructure x

85 ++ showStructure x

@@ -80,8 +94,13 @@ showStructure (Chunk t ts) =

80-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.

94-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.

81chunk :: T.Text -> Text -> Text

95chunk :: T.Text -> Text -> Text

82{-# INLINE chunk #-}

96{-# INLINE chunk #-}

97+#ifndef __GHCJS__

83chunk t@(T.Text _ _ len) ts | len == 0 = ts

98chunk t@(T.Text _ _ len) ts | len == 0 = ts

84 | otherwise = Chunk t ts

99 | otherwise = Chunk t ts

100+#else

101+chunk t ts | TT.null t = ts

102+ | otherwise = Chunk t ts

103+#endif

104

86-- | Smart constructor for 'Empty'.

105-- | Smart constructor for 'Empty'.

87empty :: Text

106empty :: Text

Data/Text/Internal/Lazy/Encoding/Fusion.hs+26

@@ -38,7 +38,9 @@ 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__

41import Data.Text.Internal.Fusion.Size

42import Data.Text.Internal.Fusion.Size

43+#endif

42import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)

44import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)

43import Data.Text.Internal.Unsafe.Shift (shiftL)

45import Data.Text.Internal.Unsafe.Shift (shiftL)

44import Data.Word (Word8, Word16, Word32)

46import Data.Word (Word8, Word16, Word32)

@@ -65,7 +67,11 @@ data T = T !ByteString !S {-# UNPACK #-} !Int

65-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using

67-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using

66-- UTF-8 encoding.

68-- UTF-8 encoding.

67streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

69streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

70+#ifndef __GHCJS__

68streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize

71streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize

72+#else

73+streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

74+#endif

69 where

75 where

70 next (T bs@(Chunk ps _) S0 i)

76 next (T bs@(Chunk ps _) S0 i)

71 | i < len && U8.validate1 a =

77 | i < len && U8.validate1 a =

@@ -107,7 +113,11 @@ streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize

107-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

113-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

108-- endian UTF-16 encoding.

114-- endian UTF-16 encoding.

109streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char

115streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char

116+#ifndef __GHCJS__

110streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

117streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

118+#else

119+streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

120+#endif

111 where

121 where

112 next (T bs@(Chunk ps _) S0 i)

122 next (T bs@(Chunk ps _) S0 i)

113 | i + 1 < len && U16.validate1 x1 =

123 | i + 1 < len && U16.validate1 x1 =

@@ -147,7 +157,11 @@ streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

157-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

148-- endian UTF-16 encoding.

158-- endian UTF-16 encoding.

149streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char

159streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char

160+#ifndef __GHCJS__

150streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

161streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

162+#else

163+streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

164+#endif

151 where

165 where

152 next (T bs@(Chunk ps _) S0 i)

166 next (T bs@(Chunk ps _) S0 i)

153 | i + 1 < len && U16.validate1 x1 =

167 | i + 1 < len && U16.validate1 x1 =

@@ -187,7 +201,11 @@ streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

187-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

201-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

188-- endian UTF-32 encoding.

202-- endian UTF-32 encoding.

189streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char

203streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char

204+#ifndef __GHCJS__

190streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

205streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

206+#else

207+streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

208+#endif

191 where

209 where

192 next (T bs@(Chunk ps _) S0 i)

210 next (T bs@(Chunk ps _) S0 i)

193 | i + 3 < len && U32.validate x =

211 | i + 3 < len && U32.validate x =

@@ -231,7 +249,11 @@ streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

231-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

249-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

232-- endian UTF-32 encoding.

250-- endian UTF-32 encoding.

233streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char

251streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char

252+#ifndef __GHCJS__

234streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

253streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

254+#else

255+streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize

256+#endif

235 where

257 where

236 next (T bs@(Chunk ps _) S0 i)

258 next (T bs@(Chunk ps _) S0 i)

237 | i + 3 < len && U32.validate x =

259 | i + 3 < len && U32.validate x =

@@ -274,7 +296,11 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

274

296

275-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

297-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

276unstreamChunks :: Int -> Stream Word8 -> ByteString

298unstreamChunks :: Int -> Stream Word8 -> ByteString

299+#ifndef __GHCJS__

277unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)

300unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)

301+#else

302+unstreamChunks chunkSize (Stream next s0) = chunk s0 4

303+#endif

278 where chunk s1 len1 = unsafeDupablePerformIO $ do

304 where chunk s1 len1 = unsafeDupablePerformIO $ do

279 let len = max 4 (min len1 chunkSize)

305 let len = max 4 (min len1 chunkSize)

280 mallocByteString len >>= loop len 0 s1

306 mallocByteString len >>= loop len 0 s1

Data/Text/Internal/Lazy/Fusion.hs+62

@@ -1,4 +1,10 @@

1{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE CPP #-}

3+#ifdef __GHCJS__

4+{-# LANGUAGE ForeignFunctionInterface #-}

5+{-# LANGUAGE MagicHash #-}

6+{-# LANGUAGE UnliftedFFITypes #-}

7+#endif

2-- |

8-- |

3-- Module : Data.Text.Lazy.Fusion

9-- Module : Data.Text.Lazy.Fusion

@@ -29,7 +35,14 @@ import Prelude hiding (length)

29import qualified Data.Text.Internal.Fusion.Common as S

35import qualified Data.Text.Internal.Fusion.Common as S

30import Control.Monad.ST (runST)

36import Control.Monad.ST (runST)

31import Data.Text.Internal.Fusion.Types

37import Data.Text.Internal.Fusion.Types

38+#ifndef __GHCJS__

32import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)

39import 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

33import Data.Text.Internal.Lazy

46import Data.Text.Internal.Lazy

34import qualified Data.Text.Internal as I

47import qualified Data.Text.Internal as I

35import qualified Data.Text.Array as A

48import qualified Data.Text.Array as A

@@ -42,6 +55,7 @@ default(Int64)

43-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

56-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

44stream :: Text -> Stream Char

57stream :: Text -> Stream Char

58+#ifndef __GHCJS__

45stream text = Stream next (text :*: 0) unknownSize

59stream text = Stream next (text :*: 0) unknownSize

46 where

60 where

47 next (Empty :*: _) = Done

61 next (Empty :*: _) = Done

@@ -49,11 +63,22 @@ stream text = Stream next (text :*: 0) unknownSize

49 | i >= len = next (ts :*: 0)

63 | i >= len = next (ts :*: 0)

50 | otherwise = Yield c (txt :*: i+d)

64 | otherwise = Yield c (txt :*: i+d)

51 where Iter c d = iter t i

65 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

52{-# INLINE [0] stream #-}

75{-# INLINE [0] stream #-}

77+-- TODO

54-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

78-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

55-- chunk size.

79-- chunk size.

56unstreamChunks :: Int -> Stream Char -> Text

80unstreamChunks :: Int -> Stream Char -> Text

81+#ifndef __GHCJS__

57unstreamChunks !chunkSize (Stream next s0 len0)

82unstreamChunks !chunkSize (Stream next s0 len0)

58 | isEmpty len0 = Empty

83 | isEmpty len0 = Empty

59 | otherwise = outer s0

84 | otherwise = outer s0

@@ -84,6 +109,36 @@ unstreamChunks !chunkSize (Stream next s0 len0)

84 finish marr len s' = do

109 finish marr len s' = do

85 arr <- A.unsafeFreeze marr

110 arr <- A.unsafeFreeze marr

86 return (I.Text arr 0 len `Chunk` outer s')

111 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

87{-# INLINE [0] unstreamChunks #-}

142{-# INLINE [0] unstreamChunks #-}

143

89-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using

144-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using

@@ -118,3 +173,10 @@ index = S.indexI

118countChar :: Char -> Stream Char -> Int64

173countChar :: Char -> Stream Char -> Int64

119countChar = S.countCharI

174countChar = S.countCharI

120{-# INLINE [0] countChar #-}

175{-# 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+55−11

@@ -1,4 +1,7 @@

1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}

2+{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, JavaScriptFFI,

3+ UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,

4+ MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}

3-- |

6-- |

4-- Module : Data.Text.Lazy.Search

7-- Module : Data.Text.Lazy.Search

@@ -31,6 +34,17 @@ import Data.Text.Internal.Lazy (Text(..), foldlChunks)

31import Data.Bits ((.|.), (.&.))

34import Data.Bits ((.|.), (.&.))

32import Data.Text.Internal.Unsafe.Shift (shiftL)

35import 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+

34-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

48-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

35-- @needle@ within @haystack@.

49-- @needle@ within @haystack@.

36--

50--

@@ -47,8 +61,10 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

47 | nlen == 1 = indicesOne (nindex 0) 0 k ks

61 | nlen == 1 = indicesOne (nindex 0) 0 k ks

48 | otherwise = advance k ks 0 0

62 | otherwise = advance k ks 0 0

49 where

63 where

50− advance x@(T.Text _ _ l) xs = scan

64+ -- advance x@(T.Text _ _ l) xs = scan

65+ advance x xs = scan

51 where

66 where

67+ l = TT.length x

52 scan !g !i

68 scan !g !i

53 | i >= m = case xs of

69 | i >= m = case xs of

54 Empty -> []

70 Empty -> []

@@ -72,11 +88,23 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

72 nlast = nlen - 1

88 nlast = nlen - 1

73 nindex = index n ns

89 nindex = index n ns

74 z = foldlChunks fin 0 needle

90 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)

75− where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)

98+ in A.unsafeIndex farr (foff+flen-1)

76 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)

99 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)

77 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)

100 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)

78− buildTable (T.Text xarr xoff xlen) xs = go

101+ -- buildTable (T.Text xarr xoff xlen) xs = go

102+ buildTable t xs = go

79 where

103 where

104+ xoff = 0

105+ (xarr, xlen) =

106+ let (# ba, len #) = fromString t

107+ in (A.Array ba, I# len)

80 go !(g::Int64) !i !msk !skp

108 go !(g::Int64) !i !msk !skp

81 | i >= xlast = case xs of

109 | i >= xlast = case xs of

82 Empty -> (msk .|. swizzle z) :*: skp

110 Empty -> (msk .|. swizzle z) :*: skp

@@ -91,17 +119,22 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

91 -- given offset would fail.

119 -- given offset would fail.

92 lackingHay q = go 0

120 lackingHay q = go 0

93 where

121 where

94− go p (T.Text _ _ l) ps = p' < q && case ps of

122+ -- go p (T.Text _ _ l) ps = p' < q && case ps of

123+ go p t ps = p' < q && case ps of

95− Empty -> True

124+ Empty -> True

96− Chunk r rs -> go p' r rs

125+ Chunk r rs -> go p' r rs

126+ where

127+ l = TT.length t

97− where p' = p + fromIntegral l

128+ p' = p + fromIntegral l

129+

98indices _ _ = []

130indices _ _ = []

131

100-- | Fast index into a partly unpacked 'Text'. We take into account

132-- | Fast index into a partly unpacked 'Text'. We take into account

101-- the possibility that the caller might try to access one element

133-- the possibility that the caller might try to access one element

102-- past the end.

134-- past the end.

103index :: T.Text -> Text -> Int64 -> Word16

135index :: T.Text -> Text -> Int64 -> Word16

104−index (T.Text arr off len) xs !i

136+-- index (T.Text arr off len) xs !i

137+index t xs !i

105 | j < len = A.unsafeIndex arr (off+j)

138 | j < len = A.unsafeIndex arr (off+j)

106 | otherwise = case xs of

139 | otherwise = case xs of

107 Empty

140 Empty

@@ -110,14 +143,24 @@ index (T.Text arr off len) xs !i

110 -- should never happen, due to lackingHay above

143 -- should never happen, due to lackingHay above

111 | otherwise -> emptyError "index"

144 | otherwise -> emptyError "index"

112 Chunk c cs -> index c cs (i-fromIntegral len)

145 Chunk c cs -> index c cs (i-fromIntegral len)

146+ where

113− where j = fromIntegral i

147+ j = fromIntegral i

148+ off = 0

149+ (arr, len) =

150+ let (# ba, len' #) = fromString t

151+ in (A.Array ba, I# len')

114

152

115-- | A variant of 'indices' that scans linearly for a single 'Word16'.

153-- | A variant of 'indices' that scans linearly for a single 'Word16'.

116indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]

154indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]

117indicesOne c = chunk

155indicesOne c = chunk

118 where

156 where

119− chunk !i (T.Text oarr ooff olen) os = go 0

157+ -- chunk !i (T.Text oarr ooff olen) os = go 0

158+ chunk !i t os = go 0

120 where

159 where

160+ ooff = 0

161+ (oarr, olen) =

162+ let (# ba, len #) = fromString t

163+ in (A.Array ba, I# len)

121 go h | h >= olen = case os of

164 go h | h >= olen = case os of

122 Empty -> []

165 Empty -> []

123 Chunk y ys -> chunk (i+fromIntegral olen) y ys

166 Chunk y ys -> chunk (i+fromIntegral olen) y ys

@@ -128,7 +171,8 @@ indicesOne c = chunk

128-- | The number of 'Word16' values in a 'Text'.

171-- | The number of 'Word16' values in a 'Text'.

129wordLength :: Text -> Int64

172wordLength :: Text -> Int64

130wordLength = foldlChunks sumLength 0

173wordLength = foldlChunks sumLength 0

174+ where sumLength i t = i + fromIntegral (TT.length t)

131− where sumLength i (T.Text _ _ l) = i + fromIntegral l

175+ -- where sumLength i (T.Text _ _ l) = i + fromIntegral l

132

176

133emptyError :: String -> a

177emptyError :: String -> a

134emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")

178emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")

Data/Text/Internal/Private.hs+8−1

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}

1+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples, CPP #-}

3-- |

4-- Module : Data.Text.Internal.Private

@@ -19,8 +19,12 @@ 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

23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)

26span_ :: (Char -> Bool) -> Text -> (# Text, Text #)

27+#ifndef __GHCJS__

24span_ p t@(Text arr off len) = (# hd,tl #)

28span_ p t@(Text arr off len) = (# hd,tl #)

25 where hd = text arr off k

29 where hd = text arr off k

26 tl = text arr (off+k) (len-k)

30 tl = text arr (off+k) (len-k)

@@ -28,6 +32,9 @@ span_ p t@(Text arr off len) = (# hd,tl #)

28 loop !i | i < len && p c = loop (i+d)

32 loop !i | i < len && p c = loop (i+d)

29 | otherwise = i

33 | otherwise = i

30 where Iter c d = iter t i

34 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

31{-# INLINE span_ #-}

38{-# INLINE span_ #-}

33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text

40runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text

Data/Text/Internal/Search.hs+40−37

@@ -37,6 +37,8 @@ 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+

40data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int

42data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int

42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

44-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

@@ -49,41 +51,42 @@ data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int

49indices :: Text -- ^ Substring to search for (@needle@)

51indices :: Text -- ^ Substring to search for (@needle@)

50 -> Text -- ^ Text to search in (@haystack@)

52 -> Text -- ^ Text to search in (@haystack@)

51 -> [Int]

53 -> [Int]

54+indices = coerce JSS.indices

52−indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

55+-- indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

53− | nlen == 1 = scanOne (nindex 0)

56+-- | nlen == 1 = scanOne (nindex 0)

54− | nlen <= 0 || ldiff < 0 = []

57+-- | nlen <= 0 || ldiff < 0 = []

55− | otherwise = scan 0

58+-- | otherwise = scan 0

56− where

59+-- where

57− ldiff = hlen - nlen

60+-- ldiff = hlen - nlen

58− nlast = nlen - 1

61+-- nlast = nlen - 1

59− z = nindex nlast

62+-- z = nindex nlast

60− nindex k = A.unsafeIndex narr (noff+k)

63+-- nindex k = A.unsafeIndex narr (noff+k)

61− hindex k = A.unsafeIndex harr (hoff+k)

64+-- hindex k = A.unsafeIndex harr (hoff+k)

62− hindex' k | k == hlen = 0

65+-- hindex' k | k == hlen = 0

63− | otherwise = A.unsafeIndex harr (hoff+k)

66+-- | otherwise = A.unsafeIndex harr (hoff+k)

64− buildTable !i !msk !skp

67+-- buildTable !i !msk !skp

65− | i >= nlast = (msk .|. swizzle z) :* skp

68+-- | i >= nlast = (msk .|. swizzle z) :* skp

66− | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'

69+-- | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'

67− where c = nindex i

70+-- where c = nindex i

68− skp' | c == z = nlen - i - 2

71+-- skp' | c == z = nlen - i - 2

69− | otherwise = skp

72+-- | otherwise = skp

70− swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)

73+-- swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)

71− scan !i

74+-- scan !i

72− | i > ldiff = []

75+-- | i > ldiff = []

73− | c == z && candidateMatch 0 = i : scan (i + nlen)

76+-- | c == z && candidateMatch 0 = i : scan (i + nlen)

74− | otherwise = scan (i + delta)

77+-- | otherwise = scan (i + delta)

75− where c = hindex (i + nlast)

78+-- where c = hindex (i + nlast)

76− candidateMatch !j

79+-- candidateMatch !j

77− | j >= nlast = True

80+-- | j >= nlast = True

78− | hindex (i+j) /= nindex j = False

81+-- | hindex (i+j) /= nindex j = False

79− | otherwise = candidateMatch (j+1)

82+-- | otherwise = candidateMatch (j+1)

80− delta | nextInPattern = nlen + 1

83+-- delta | nextInPattern = nlen + 1

81− | c == z = skip + 1

84+-- | c == z = skip + 1

82− | otherwise = 1

85+-- | otherwise = 1

83− where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0

86+-- where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0

84− !(mask :* skip) = buildTable 0 0 (nlen-2)

87+-- !(mask :* skip) = buildTable 0 0 (nlen-2)

85− scanOne c = loop 0

88+-- scanOne c = loop 0

86− where loop !i | i >= hlen = []

89+-- where loop !i | i >= hlen = []

87− | hindex i == c = i : loop (i+1)

90+-- | hindex i == c = i : loop (i+1)

88− | otherwise = loop (i+1)

91+-- | otherwise = loop (i+1)

89{-# INLINE indices #-}

92{-# INLINE indices #-}

Data/Text/Lazy.hs+49−1

@@ -6,7 +6,9 @@

6#if __GLASGOW_HASKELL__ >= 708

7{-# LANGUAGE TypeFamilies #-}

8#endif

9−

9+#ifdef __GHCJS__

10+{-# LANGUAGE ForeignFunctionInterface #-}

11+#endif

10-- |

12-- |

11-- Module : Data.Text.Lazy

13-- Module : Data.Text.Lazy

@@ -244,6 +246,9 @@ import GHC.Prim (Addr#)

244#if MIN_VERSION_base(4,7,0)

246#if MIN_VERSION_base(4,7,0)

245import Text.Printf (PrintfArg, formatArg, formatString)

247import Text.Printf (PrintfArg, formatArg, formatString)

246#endif

248#endif

249+#ifdef __GHCJS__

250+import Data.JSString (JSString)

251+#endif

247

252

248-- $fusion

253-- $fusion

249--

254--

@@ -324,6 +329,7 @@ compareText Empty _ = LT

324compareText _ Empty = GT

329compareText _ Empty = GT

325compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0

330compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0

326 where

331 where

332+#ifndef __GHCJS__

327 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0

333 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0

328 where

334 where

329 go !i !j

335 go !i !j

@@ -334,6 +340,20 @@ compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0

334 | otherwise = go (i+di) (j+dj)

340 | otherwise = go (i+di) (j+dj)

335 where T.Iter a di = T.iter ta i

341 where T.Iter a di = T.iter ta i

336 T.Iter b dj = T.iter tb j

342 T.Iter b dj = T.iter tb j

343+#else

344+ outer ta@(T.Text jsa) tb@(T.Text jsb) = go 0 0

345+ where

346+ go !i !j

347+ | i >= lenA = compareText as (chunk (T.Text (js_substr1 j jsb)) bs)

348+ | j >= lenB = compareText (chunk (T.Text (js_substr1 i jsa)) as) bs

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

337

357

338instance Show Text where

358instance Show Text where

339 showsPrec p ps r = showsPrec p (unpack ps) r

359 showsPrec p ps r = showsPrec p (unpack ps) r

@@ -1119,11 +1139,20 @@ dropWords i t0

1119 | otherwise = drop' i t0

1139 | otherwise = drop' i t0

1120 where drop' 0 ts = ts

1140 where drop' 0 ts = ts

1121 drop' _ Empty = Empty

1141 drop' _ Empty = Empty

1142+#ifndef __GHCJS__

1122 drop' n (Chunk (T.Text arr off len) ts)

1143 drop' n (Chunk (T.Text arr off len) ts)

1123 | n < len' = chunk (text arr (off+n') (len-n')) ts

1144 | n < len' = chunk (text arr (off+n') (len-n')) ts

1124 | otherwise = drop' (n - len') ts

1145 | otherwise = drop' (n - len') ts

1125 where len' = fromIntegral len

1146 where len' = fromIntegral len

1126 n' = fromIntegral n

1147 n' = fromIntegral n

1148+#else

1149+ drop' n (Chunk t@(T.Text jst) ts)

1150+ | n < len' = chunk (T.Text $ js_substr1 n' jst) ts

1151+ | otherwise = drop' (n - len') ts

1152+ where len' = fromIntegral len

1153+ len = T.length t

1154+ n' = fromIntegral n

1155+#endif

1127

1156

1128-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',

1157-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',

1129-- returns the longest prefix (possibly empty) of elements that

1158-- returns the longest prefix (possibly empty) of elements that

@@ -1244,12 +1273,22 @@ splitAt = loop

1244-- values, and whose second is the remainder of the string.

1273-- values, and whose second is the remainder of the string.

1245splitAtWord :: Int64 -> Text -> PairS Text Text

1274splitAtWord :: Int64 -> Text -> PairS Text Text

1246splitAtWord _ Empty = empty :*: empty

1275splitAtWord _ Empty = empty :*: empty

1276+#ifndef __GHCJS__

1247splitAtWord x (Chunk c@(T.Text arr off len) cs)

1277splitAtWord x (Chunk c@(T.Text arr off len) cs)

1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

1278 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

1249 in Chunk c h :*: t

1279 in Chunk c h :*: t

1250 | otherwise = chunk (text arr off y) empty :*:

1280 | otherwise = chunk (text arr off y) empty :*:

1251 chunk (text arr (off+y) (len-y)) cs

1281 chunk (text arr (off+y) (len-y)) cs

1252 where y = fromIntegral x

1282 where y = fromIntegral x

1283+#else

1284+splitAtWord x (Chunk c@(T.Text jst) cs)

1285+ | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

1286+ in Chunk c h :*: t

1287+ | otherwise = chunk (T.Text (js_substr 0 (y-1) jst)) empty :*:

1288+ chunk (T.Text (js_substr1 y jst)) cs

1289+ where y = fromIntegral x

1290+ len = T.length c

1291+#endif

1253

1292

1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be

1293-- | /O(n+m)/ Find the first instance of @needle@ (which must be

1255-- non-'null') in @haystack@. The first element of the returned tuple

1294-- non-'null') in @haystack@. The first element of the returned tuple

@@ -1429,7 +1468,11 @@ splitOn pat src

1429 go _ [] cs = [cs]

1468 go _ [] cs = [cs]

1430 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs

1469 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs

1431 in h : go (x+l) xs (dropWords l t)

1470 in h : go (x+l) xs (dropWords l t)

1471+#ifndef __GHCJS__

1432 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat

1472 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat

1473+#else

1474+ l = foldlChunks (\a t -> a + fromIntegral (T.length t)) 0 pat

1475+#endif

1433{-# INLINE [1] splitOn #-}

1476{-# INLINE [1] splitOn #-}

1434

1477

1435{-# RULES

1478{-# RULES

@@ -1693,3 +1736,8 @@ emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")

1693

1736

1694impossibleError :: String -> a

1737impossibleError :: String -> a

1695impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")

1738impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")

1739+

1740+#ifdef __GHCJS__

1741+foreign import javascript unsafe "$2.substr($1)" js_substr1 :: Exts.Int -> JSString -> JSString

1742+foreign import javascript unsafe "$3.substr($1,$2)" js_substr :: Exts.Int -> Exts.Int -> JSString -> JSString

1743+#endif

Data/Text/Lazy/Builder/Int.hs+9−259

@@ -1,262 +1,12 @@

1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,

1+module Data.Text.Lazy.Builder.Int where

2− UnboxedTuples #-}

3−#if __GLASGOW_HASKELL__ >= 702

4−{-# LANGUAGE Trustworthy #-}

5−#endif

7−-- Module: Data.Text.Lazy.Builder.Int

3+import Data.Text.Lazy (Text)

4+import qualified Data.Text.Lazy as L

5+import qualified Data.Text as T

10−-- License: BSD-style

6+import qualified Data.JSString.Int as JSS

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

7+import Data.Text.Lazy.Builder

18− (

19− decimal

20− , hexadecimal

21− ) where

22−

23−import Data.Int (Int8, Int16, Int32, Int64)

24−import Data.Monoid (mempty)

8+import Data.Monoid

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

52decimal :: Integral a => a -> Builder

10decimal :: Integral a => a -> Builder

53−{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}

11+-- decimal n = L.fromChunks [T.Text $ JSS.decimal n]

54−{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}

12+decimal _ = mempty

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+2−233

@@ -1,29 +1,4 @@

1−{-# LANGUAGE CPP, OverloadedStrings #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

5−

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−

13−module Data.Text.Lazy.Builder.RealFloat

1+module Data.Text.Lazy.Builder.RealFloat (FPFormat(..)) where

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

28-- | Control the rendering of floating point numbers.

3-- | Control the rendering of floating point numbers.

29data FPFormat = Exponent

4data FPFormat = Exponent

@@ -33,210 +8,4 @@ data FPFormat = Exponent

33 | Generic

8 | Generic

34 -- ^ Use decimal notation for values between @0.1@ and

9 -- ^ Use decimal notation for values between @0.1@ and

35 -- @9,999,999@, and scientific notation otherwise.

10 -- @9,999,999@, and scientific notation otherwise.

36− deriving (Enum, Read, Show)

11+ 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,4 +1,7 @@

1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}

2+#ifdef __GHCJS__

3+{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes #-}

4+#endif

2-- |

5-- |

3-- Module : Data.Text.Unsafe

6-- Module : Data.Text.Unsafe

@@ -32,31 +35,47 @@ import Control.Exception (assert)

32import Data.Text.Internal.Encoding.Utf16 (chr2)

35import Data.Text.Internal.Encoding.Utf16 (chr2)

33import Data.Text.Internal (Text(..))

36import Data.Text.Internal (Text(..))

34import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)

37import 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

35import Data.Text.Internal.Unsafe.Char (unsafeChr)

45import Data.Text.Internal.Unsafe.Char (unsafeChr)

36import qualified Data.Text.Array as A

46import qualified Data.Text.Array as A

47+#endif

37import GHC.IO (unsafeDupablePerformIO)

48import GHC.IO (unsafeDupablePerformIO)

39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

50-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

40-- 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

41-- 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.

42unsafeHead :: Text -> Char

53unsafeHead :: Text -> Char

54+#ifndef __GHCJS__

43unsafeHead (Text arr off _len)

55unsafeHead (Text arr off _len)

44 | m < 0xD800 || m > 0xDBFF = unsafeChr m

56 | m < 0xD800 || m > 0xDBFF = unsafeChr m

45 | otherwise = chr2 m n

57 | otherwise = chr2 m n

46 where m = A.unsafeIndex arr off

58 where m = A.unsafeIndex arr off

47 n = A.unsafeIndex arr (off+1)

59 n = A.unsafeIndex arr (off+1)

60+#else

61+unsafeHead = coerce JSS.rawHead

62+#endif

48{-# INLINE unsafeHead #-}

63{-# INLINE unsafeHead #-}

50-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'

65-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'

51-- omits the check for the empty case, so there is an obligation on

66-- 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.

67-- the programmer to provide a proof that the 'Text' is non-empty.

53unsafeTail :: Text -> Text

68unsafeTail :: Text -> Text

69+#ifndef __GHCJS__

54unsafeTail t@(Text arr off len) =

70unsafeTail t@(Text arr off len) =

55#if defined(ASSERTS)

71#if defined(ASSERTS)

56 assert (d <= len) $

72 assert (d <= len) $

57#endif

73#endif

58 Text arr (off+d) (len-d)

74 Text arr (off+d) (len-d)

59 where d = iter_ t 0

75 where d = iter_ t 0

76+#else

77+unsafeTail = coerce JSS.rawTail

78+#endif

60{-# INLINE unsafeTail #-}

79{-# INLINE unsafeTail #-}

62data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int

81data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int

@@ -65,6 +84,7 @@ data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int

65-- array, returning the current character and the delta to add to give

84-- array, returning the current character and the delta to add to give

66-- the next offset to iterate at.

85-- the next offset to iterate at.

67iter :: Text -> Int -> Iter

86iter :: Text -> Int -> Iter

87+#ifndef __GHCJS__

68iter (Text arr off _len) i

88iter (Text arr off _len) i

69 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1

89 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1

70 | otherwise = Iter (chr2 m n) 2

90 | otherwise = Iter (chr2 m n) 2

@@ -72,20 +92,40 @@ iter (Text arr off _len) i

72 n = A.unsafeIndex arr k

92 n = A.unsafeIndex arr k

73 j = off + i

93 j = off + i

74 k = j + 1

94 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

75{-# INLINE iter #-}

107{-# INLINE iter #-}

108

77-- | /O(1)/ Iterate one step through a UTF-16 array, returning the

109-- | /O(1)/ Iterate one step through a UTF-16 array, returning the

78-- delta to add to give the next offset to iterate at.

110-- delta to add to give the next offset to iterate at.

79iter_ :: Text -> Int -> Int

111iter_ :: Text -> Int -> Int

112+#ifndef __GHCJS__

80iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1

113iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1

81 | otherwise = 2

114 | otherwise = 2

82 where m = A.unsafeIndex arr (off+i)

115 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

83{-# INLINE iter_ #-}

122{-# INLINE iter_ #-}

123

85-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

124-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

86-- returning the current character and the delta to add (i.e. a

125-- returning the current character and the delta to add (i.e. a

87-- negative number) to give the next offset to iterate at.

126-- negative number) to give the next offset to iterate at.

88reverseIter :: Text -> Int -> (Char,Int)

127reverseIter :: Text -> Int -> (Char,Int)

128+#ifndef __GHCJS__

89reverseIter (Text arr off _len) i

129reverseIter (Text arr off _len) i

90 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)

130 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)

91 | otherwise = (chr2 n m, -2)

131 | otherwise = (chr2 n m, -2)

@@ -93,31 +133,78 @@ reverseIter (Text arr off _len) i

93 n = A.unsafeIndex arr k

133 n = A.unsafeIndex arr k

94 j = off + i

134 j = off + i

95 k = j - 1

135 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

96{-# INLINE reverseIter #-}

148{-# INLINE reverseIter #-}

149

98-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

150-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

99-- returning the delta to add (i.e. a negative number) to give the

151-- returning the delta to add (i.e. a negative number) to give the

100-- next offset to iterate at.

152-- next offset to iterate at.

101reverseIter_ :: Text -> Int -> Int

153reverseIter_ :: Text -> Int -> Int

154+#ifndef __GHCJS__

102reverseIter_ (Text arr off _len) i

155reverseIter_ (Text arr off _len) i

103 | m < 0xDC00 || m > 0xDFFF = -1

156 | m < 0xDC00 || m > 0xDFFF = -1

104 | otherwise = -2

157 | otherwise = -2

105 where m = A.unsafeIndex arr (off+i)

158 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

106{-# INLINE reverseIter_ #-}

167{-# INLINE reverseIter_ #-}

107

168

108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

169-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

109-- is useful for sizing a target array appropriately before using

170-- is useful for sizing a target array appropriately before using

110-- 'unsafeCopyToPtr'.

171-- 'unsafeCopyToPtr'.

111lengthWord16 :: Text -> Int

172lengthWord16 :: Text -> Int

173+#ifndef __GHCJS__

112lengthWord16 (Text _arr _off len) = len

174lengthWord16 (Text _arr _off len) = len

175+#else

176+lengthWord16 (Text t) = js_length t

177+#endif

113{-# INLINE lengthWord16 #-}

178{-# INLINE lengthWord16 #-}

114

179

115-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.

180-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.

116takeWord16 :: Int -> Text -> Text

181takeWord16 :: Int -> Text -> Text

182+#ifndef __GHCJS__

117takeWord16 k (Text arr off _len) = Text arr off k

183takeWord16 k (Text arr off _len) = Text arr off k

184+#else

185+takeWord16 k (Text txt) = Text $ js_take k txt

186+#endif

118{-# INLINE takeWord16 #-}

187{-# INLINE takeWord16 #-}

119

188

120-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.

189-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.

121dropWord16 :: Int -> Text -> Text

190dropWord16 :: Int -> Text -> Text

191+#ifndef __GHCJS__

122dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)

192dropWord16 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

123{-# INLINE dropWord16 #-}

196{-# 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+64−59

@@ -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,18 +124,23 @@ 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

131− other-modules:

134+ -- other-modules:

132− Data.Text.Show

135+ -- Data.Text.Show

133

136

134 build-depends:

137 build-depends:

135− array >= 0.3,

138+ -- array >= 0.3,

136 base >= 4.2 && < 5,

139 base >= 4.2 && < 5,

137 binary,

140 binary,

138 deepseq >= 1.1.0.0,

141 deepseq >= 1.1.0.0,

142+ ghcjs-base,

143+ ghcjs-prim,

139 ghc-prim >= 0.2

144 ghc-prim >= 0.2

140

145

141 if flag(bytestring-builder)

146 if flag(bytestring-builder)

@@ -158,51 +163,51 @@ library

158 cpp-options: -DINTEGER_GMP

163 cpp-options: -DINTEGER_GMP

159 build-depends: integer-gmp >= 0.2

164 build-depends: integer-gmp >= 0.2

160

165

161−test-suite tests

166+-- test-suite tests

162− type: exitcode-stdio-1.0

167+-- type: exitcode-stdio-1.0

163− hs-source-dirs: tests .

168+-- hs-source-dirs: tests .

164− main-is: Tests.hs

169+-- main-is: Tests.hs

165− c-sources: cbits/cbits.c

170+-- c-sources: cbits/cbits.c

166− include-dirs: include

171+-- include-dirs: include

167−

172+

168− ghc-options:

173+-- ghc-options:

169− -Wall -threaded -O0 -rtsopts

174+-- -Wall -threaded -O0 -rtsopts

170−

175+

171− cpp-options:

176+-- cpp-options:

172− -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE

177+-- -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE

173−

178+

174− build-depends:

179+-- build-depends:

175− HUnit >= 1.2,

180+-- HUnit >= 1.2,

176− QuickCheck >= 2.7,

181+-- QuickCheck >= 2.7,

177− array,

182+-- array,

178− base,

183+-- base,

179− binary,

184+-- binary,

180− deepseq,

185+-- deepseq,

181− directory,

186+-- directory,

182− ghc-prim,

187+-- ghc-prim,

183− quickcheck-unicode,

188+-- quickcheck-unicode,

184− random,

189+-- random,

185− test-framework >= 0.4,

190+-- test-framework >= 0.4,

186− test-framework-hunit >= 0.2,

191+-- test-framework-hunit >= 0.2,

187− test-framework-quickcheck2 >= 0.2

192+-- test-framework-quickcheck2 >= 0.2

188−

193+

189− if flag(bytestring-builder)

194+-- if flag(bytestring-builder)

190− build-depends: bytestring >= 0.9 && < 0.10.4,

195+-- build-depends: bytestring >= 0.9 && < 0.10.4,

191− bytestring-builder >= 0.10.4

196+-- bytestring-builder >= 0.10.4

192− else

197+-- else

193− build-depends: bytestring >= 0.10.4

198+-- build-depends: bytestring >= 0.10.4

194−

199+

195− if flag(integer-simple)

200+-- if flag(integer-simple)

196− cpp-options: -DINTEGER_SIMPLE

201+-- cpp-options: -DINTEGER_SIMPLE

197− build-depends: integer-simple >= 0.1 && < 0.5

202+-- build-depends: integer-simple >= 0.1 && < 0.5

198− else

203+-- else

199− cpp-options: -DINTEGER_GMP

204+-- cpp-options: -DINTEGER_GMP

200− build-depends: integer-gmp >= 0.2

205+-- build-depends: integer-gmp >= 0.2

201−

206+

202−source-repository head

207+-- source-repository head

203− type: git

208+-- type: git

204− location: https://github.com/bos/text

209+-- location: https://github.com/bos/text

205−

210+

206−source-repository head

211+-- source-repository head

207− type: mercurial

212+-- type: mercurial

208− location: https://bitbucket.org/bos/text

213+-- location: https://bitbucket.org/bos/text