84cddd0 · text · git.iko.soy

git.iko.soy/text

on master help sign in

Fix tests build

84cddd0Luigy Leon8 years ago

Data/Text/Encoding.hs+7−1

compare with master

unifiedsplit

@@ -401,7 +401,13 @@ encodeUtf8BuilderEscaped be =

401#ifdef __GHCJS__

402 off = 0

403 (arr, len) = let (# ba, len' #) = js_fromString t

404+#if defined(ASSERTS)

405+ in ( A.Array ba (I# len')

406+#else

404− in (A.Array ba, I# len')

407+ in ( A.Array ba

408+#endif

409+ , I# len'

410+ )

405#endif

411#endif

406 iend = off + len

412 iend = off + len

407

413

Data/Text/Foreign.hs+87−1

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

1{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}

2+{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes, MagicHash #-}

2-- |

3-- |

3-- Module : Data.Text.Foreign

4-- Module : Data.Text.Foreign

@@ -50,6 +51,13 @@ import Foreign.Marshal.Alloc (allocaBytes)

50import Foreign.Ptr (Ptr, castPtr, plusPtr)

51import Foreign.Ptr (Ptr, castPtr, plusPtr)

51import Foreign.Storable (peek, poke)

52import Foreign.Storable (peek, poke)

52import qualified Data.Text.Array as A

53import qualified Data.Text.Array as A

54+#ifdef __GHCJS__

55+import Data.JSString (JSString)

56+import GHC.Exts (ByteArray#, Int#)

57+import GHC.Prim (int2Word#)

58+import GHC.Int (Int(..))

59+import GHC.Word (Word16(..))

60+#endif

54-- $interop

62-- $interop

55--

63--

@@ -74,11 +82,15 @@ fromPtr :: Ptr Word16 -- ^ source array

74 -> I16 -- ^ length of source array (in 'Word16' units)

82 -> I16 -- ^ length of source array (in 'Word16' units)

75 -> IO Text

83 -> IO Text

76fromPtr _ (I16 0) = return empty

84fromPtr _ (I16 0) = return empty

77−fromPtr ptr (I16 len) =

85+fromPtr ptr (I16 (len@(I# len#))) =

78#if defined(ASSERTS)

86#if defined(ASSERTS)

79 assert (len > 0) $

87 assert (len > 0) $

80#endif

88#endif

89+#if defined(__GHCJS__)

90+ return $! Text (js_toString (A.aBA arr) 0# len#)

91+#else

81 return $! Text arr 0 len

92 return $! Text arr 0 len

93+#endif

82 where

94 where

83 arr = A.run (A.new len >>= copy)

95 arr = A.run (A.new len >>= copy)

84 copy marr = loop ptr 0

96 copy marr = loop ptr 0

@@ -102,14 +114,30 @@ fromPtr ptr (I16 len) =

102-- end of the prefix will be advanced by one additional 'Word16' unit

114-- end of the prefix will be advanced by one additional 'Word16' unit

103-- to maintain its validity.

115-- to maintain its validity.

104takeWord16 :: I16 -> Text -> Text

116takeWord16 :: I16 -> Text -> Text

117+#ifdef __GHCJS__

118+takeWord16 (I16 n@(I# n#)) t@(Text jss)

119+ | n <= 0 = empty

120+ | n >= len || m >= len = t

121+ | otherwise = Text (js_substr 0# n# jss)

122+#else

105takeWord16 (I16 n) t@(Text arr off len)

123takeWord16 (I16 n) t@(Text arr off len)

106 | n <= 0 = empty

124 | n <= 0 = empty

107 | n >= len || m >= len = t

125 | n >= len || m >= len = t

108 | otherwise = Text arr off m

126 | otherwise = Text arr off m

127+#endif

109 where

128 where

129+#ifdef __GHCJS__

130+ len = js_length jss

131+ arr = js_length jss

132+ m@(I# m#) | w < 0xD800 || w > 0xDBFF = n

133+ | otherwise = n+1

134+ w = I# w#

135+ w# = js_charCodeAt (n-1) jss

136+#else

110 m | w < 0xD800 || w > 0xDBFF = n

137 m | w < 0xD800 || w > 0xDBFF = n

111 | otherwise = n+1

138 | otherwise = n+1

112 w = A.unsafeIndex arr (off+n-1)

139 w = A.unsafeIndex arr (off+n-1)

140+#endif

113

141

114-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units

142-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units

115-- dropped from its beginning.

143-- dropped from its beginning.

@@ -118,18 +146,45 @@ takeWord16 (I16 n) t@(Text arr off len)

118-- beginning of the suffix will be advanced by one additional 'Word16'

146-- beginning of the suffix will be advanced by one additional 'Word16'

119-- unit to maintain its validity.

147-- unit to maintain its validity.

120dropWord16 :: I16 -> Text -> Text

148dropWord16 :: I16 -> Text -> Text

149+#ifdef __GHCJS__

150+dropWord16 (I16 n@(I# n#)) t@(Text jss)

151+ | n <= 0 = t

152+ | n >= len || m >= len = empty

153+ | otherwise = Text (js_substr1 n# jss)

154+#else

121dropWord16 (I16 n) t@(Text arr off len)

155dropWord16 (I16 n) t@(Text arr off len)

122 | n <= 0 = t

156 | n <= 0 = t

123 | n >= len || m >= len = empty

157 | n >= len || m >= len = empty

124 | otherwise = Text arr (off+m) (len-m)

158 | otherwise = Text arr (off+m) (len-m)

159+#endif

125 where

160 where

161+#ifdef __GHCJS__

162+ len = js_length jss

163+ arr = js_length jss

164+ m@(I# m#) | w < 0xD800 || w > 0xDBFF = n

165+ | otherwise = n+1

166+ w = I# w#

167+ w# = js_charCodeAt (n-1) jss

168+#else

126 m | w < 0xD800 || w > 0xDBFF = n

169 m | w < 0xD800 || w > 0xDBFF = n

127 | otherwise = n+1

170 | otherwise = n+1

128 w = A.unsafeIndex arr (off+n-1)

171 w = A.unsafeIndex arr (off+n-1)

172+#endif

129

173

130-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big

174-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big

131-- enough to hold the contents of the entire 'Text'.

175-- enough to hold the contents of the entire 'Text'.

132unsafeCopyToPtr :: Text -> Ptr Word16 -> IO ()

176unsafeCopyToPtr :: Text -> Ptr Word16 -> IO ()

177+#ifdef __GHCJS__

178+unsafeCopyToPtr (Text jst) ptr = loop ptr off

179+ where

180+ end = off + len

181+ loop !p !i | i == end = return ()

182+ | otherwise = do

183+ poke p (W16# (int2Word# (js_charCodeAt i jst)))

184+ loop (p `plusPtr` 2) (i + 1)

185+ off = 0

186+ len = js_length jst

187+#else

133unsafeCopyToPtr (Text arr off len) ptr = loop ptr off

188unsafeCopyToPtr (Text arr off len) ptr = loop ptr off

134 where

189 where

135 end = off + len

190 end = off + len

@@ -137,21 +192,38 @@ unsafeCopyToPtr (Text arr off len) ptr = loop ptr off

137 | otherwise = do

192 | otherwise = do

138 poke p (A.unsafeIndex arr i)

193 poke p (A.unsafeIndex arr i)

139 loop (p `plusPtr` 2) (i + 1)

194 loop (p `plusPtr` 2) (i + 1)

195+#endif

140

196

141-- | /O(n)/ Perform an action on a temporary, mutable copy of a

197-- | /O(n)/ Perform an action on a temporary, mutable copy of a

142-- 'Text'. The copy is freed as soon as the action returns.

198-- 'Text'. The copy is freed as soon as the action returns.

143useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a

199useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a

200+#ifdef __GHCJS__

201+useAsPtr t@(Text jst) action =

202+ allocaBytes (len * 2) $ \buf -> do

203+ unsafeCopyToPtr t buf

204+ action (castPtr buf) (fromIntegral len)

205+ where len = js_length jst

206+#else

144useAsPtr t@(Text _arr _off len) action =

207useAsPtr t@(Text _arr _off len) action =

145 allocaBytes (len * 2) $ \buf -> do

208 allocaBytes (len * 2) $ \buf -> do

146 unsafeCopyToPtr t buf

209 unsafeCopyToPtr t buf

147 action (castPtr buf) (fromIntegral len)

210 action (castPtr buf) (fromIntegral len)

211+#endif

148

212

149-- | /O(n)/ Make a mutable copy of a 'Text'.

213-- | /O(n)/ Make a mutable copy of a 'Text'.

150asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)

214asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)

215+#ifdef __GHCJS__

216+asForeignPtr t@(Text jst) = do

217+ fp <- mallocForeignPtrArray len

218+ withForeignPtr fp $ unsafeCopyToPtr t

219+ return (fp, I16 len)

220+ where len = js_length jst

221+#else

151asForeignPtr t@(Text _arr _off len) = do

222asForeignPtr t@(Text _arr _off len) = do

152 fp <- mallocForeignPtrArray len

223 fp <- mallocForeignPtrArray len

153 withForeignPtr fp $ unsafeCopyToPtr t

224 withForeignPtr fp $ unsafeCopyToPtr t

154 return (fp, I16 len)

225 return (fp, I16 len)

226+#endif

155

227

156-- | /O(n)/ Decode a C string with explicit length, which is assumed

228-- | /O(n)/ Decode a C string with explicit length, which is assumed

157-- to have been encoded as UTF-8. If decoding fails, a

229-- to have been encoded as UTF-8. If decoding fails, a

@@ -174,3 +246,17 @@ peekCStringLen cs = do

174-- @since 1.0.0.0

246-- @since 1.0.0.0

175withCStringLen :: Text -> (CStringLen -> IO a) -> IO a

247withCStringLen :: Text -> (CStringLen -> IO a) -> IO a

176withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act

248withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act

249+

250+#ifdef __GHCJS__

251+foreign import javascript unsafe

252+ "h$textToString($1,$2,$3)"

253+ js_toString :: ByteArray# -> Int# -> Int# -> JSString

254+foreign import javascript unsafe

255+ "$3.substr($1,$2)" js_substr :: Int# -> Int# -> JSString -> JSString

256+foreign import javascript unsafe

257+ "$2.substr($1)" js_substr1 :: Int# -> JSString -> JSString

258+foreign import javascript unsafe

259+ "$1.length" js_length :: JSString -> Int

260+foreign import javascript unsafe

261+ "$2.charCodeAt($1)" js_charCodeAt :: Int -> JSString -> Int#

262+#endif

Data/Text/Internal.hs+5

@@ -60,8 +60,13 @@ foreign import javascript unsafe

60text :: A.Array -> Int -> Int -> Text

61-- text arr off len | len == 0 = empty

62-- | otherwise = text_ arr off len

63+#if defined(ASSERTS)

64+text (A.Array ba _) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty

65+ | otherwise = Text $ js_textToString ba off# len#

66+#else

63text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty

67text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty

64 | otherwise = Text $ js_textToString ba off# len#

68 | otherwise = Text $ js_textToString ba off# len#

69+#endif

66-- | Checked multiplication. Calls 'error' if the result would

71-- | Checked multiplication. Calls 'error' if the result would

67-- overflow.

72-- overflow.

Data/Text/Internal/Builder.hs+4

@@ -174,7 +174,11 @@ fromText t@(Text t')

174 | otherwise = flush `append` mapBuilder (t :)

175 where

176 (# ba, len #) = js_fromString t'

177+#if defined(ASSERTS)

178+ (arr, off, l) = (A.Array ba (I# len), 0, I# len)

179+#else

177 (arr, off, l) = (A.Array ba, 0, I# len)

180 (arr, off, l) = (A.Array ba, 0, I# len)

181+#endif

178-- fromText t@(Text arr off l)

182-- fromText t@(Text arr off l)

179-- | S.null t = empty

183-- | S.null t = empty

180-- | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

184-- | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

Data/Text/Internal/Lazy/Search.hs+16

@@ -94,7 +94,11 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

94 let foff = 0

95 (farr, flen) =

96 let (# ba, len #) = fromString t

97+#if defined(ASSERTS)

98+ in (A.Array ba (I# len), I# len)

99+#else

97 in (A.Array ba, I# len)

100 in (A.Array ba, I# len)

101+#endif

98 in A.unsafeIndex farr (foff+flen-1)

102 in A.unsafeIndex farr (foff+flen-1)

99 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)

103 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)

100 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)

104 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)

@@ -104,7 +108,11 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

104 xoff = 0

108 xoff = 0

105 (xarr, xlen) =

109 (xarr, xlen) =

106 let (# ba, len #) = fromString t

110 let (# ba, len #) = fromString t

111+#if defined(ASSERTS)

112+ in (A.Array ba (I# len), I# len)

113+#else

107 in (A.Array ba, I# len)

114 in (A.Array ba, I# len)

115+#endif

108 go !(g::Int64) !i !msk !skp

116 go !(g::Int64) !i !msk !skp

109 | i >= xlast = case xs of

117 | i >= xlast = case xs of

110 Empty -> (msk .|. swizzle z) :*: skp

118 Empty -> (msk .|. swizzle z) :*: skp

@@ -148,7 +156,11 @@ index t xs !i

148 off = 0

156 off = 0

149 (arr, len) =

157 (arr, len) =

150 let (# ba, len' #) = fromString t

158 let (# ba, len' #) = fromString t

159+#if defined(ASSERTS)

160+ in (A.Array ba (I# len'), I# len')

161+#else

151 in (A.Array ba, I# len')

162 in (A.Array ba, I# len')

163+#endif

152

164

153-- | A variant of 'indices' that scans linearly for a single 'Word16'.

165-- | A variant of 'indices' that scans linearly for a single 'Word16'.

154indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]

166indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]

@@ -160,7 +172,11 @@ indicesOne c = chunk

160 ooff = 0

172 ooff = 0

161 (oarr, olen) =

173 (oarr, olen) =

162 let (# ba, len #) = fromString t

174 let (# ba, len #) = fromString t

175+#if defined(ASSERTS)

176+ in (A.Array ba (I# len), I# len)

177+#else

163 in (A.Array ba, I# len)

178 in (A.Array ba, I# len)

179+#endif

164 go h | h >= olen = case os of

180 go h | h >= olen = case os of

165 Empty -> []

181 Empty -> []

166 Chunk y ys -> chunk (i+fromIntegral olen) y ys

182 Chunk y ys -> chunk (i+fromIntegral olen) y ys

Data/Text/Internal/Search.hs+1

@@ -31,6 +31,7 @@ module Data.Text.Internal.Search

31 indices

32 ) where

34+import Data.Coerce

34import qualified Data.Text.Array as A

35import qualified Data.Text.Array as A

35import Data.Word (Word64)

36import Data.Word (Word64)

36import Data.Text.Internal (Text(..))

37import Data.Text.Internal (Text(..))

tests/Tests/Properties.hs+6

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

3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

4 ScopedTypeVariables, TypeSynonymInstances #-}

5+{-# LANGUAGE CPP #-}

5{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}

6{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}

6module Tests.Properties

7module Tests.Properties

7 (

8 (

@@ -940,8 +941,13 @@ s_filter_eq s = S.filter p t == S.streamList (filter p s)

940-- functions that consume inaccurately sized streams behave

941-- functions that consume inaccurately sized streams behave

941-- themselves.

942-- themselves.

942shorten :: Int -> S.Stream a -> S.Stream a

943shorten :: Int -> S.Stream a -> S.Stream a

944+#ifdef __GHCJS__

945+shorten n t@(S.Stream arr off)

946+ | n > 0 = S.Stream arr off -- TODO

947+#else

943shorten n t@(S.Stream arr off len)

948shorten n t@(S.Stream arr off len)

944 | n > 0 = S.Stream arr off (smaller (exactSize n) len)

949 | n > 0 = S.Stream arr off (smaller (exactSize n) len)

950+#endif

945 | otherwise = t

951 | otherwise = t

946

952

947tests :: Test

953tests :: Test

tests/Tests/QuickCheckUtils.hs+3−3

@@ -157,9 +157,9 @@ shrinkNotEmpty isNull (NotEmpty xs) =

157 [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]

158

159data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7

160− | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15

160+-- | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15

161− | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23

161+-- | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23

162− | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31

162+-- | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31

163 deriving (Eq, Ord, Enum, Bounded)

164

165small :: Integral a => Small -> a

tests/Tests/SlowFunctions.hs+22

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

1{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE CPP #-}

3+{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes, MagicHash #-}

2module Tests.SlowFunctions

4module Tests.SlowFunctions

3 (

5 (

4 indices

6 indices

@@ -8,18 +10,31 @@ module Tests.SlowFunctions

8import qualified Data.Text as T

10import qualified Data.Text as T

9import Data.Text.Internal (Text(..))

11import Data.Text.Internal (Text(..))

10import Data.Text.Unsafe (iter_, unsafeHead, unsafeTail)

12import Data.Text.Unsafe (iter_, unsafeHead, unsafeTail)

13+#ifdef __GHCJS__

14+import Data.JSString (JSString)

15+#endif

12indices :: T.Text -- ^ Substring to search for (@needle@)

17indices :: T.Text -- ^ Substring to search for (@needle@)

13 -> T.Text -- ^ Text to search in (@haystack@)

18 -> T.Text -- ^ Text to search in (@haystack@)

14 -> [Int]

19 -> [Int]

20+#ifdef __GHCJS__

21+indices needle@(Text njst) haystack@(Text hjst)

22+#else

15indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)

23indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)

24+#endif

16 | T.null needle = []

25 | T.null needle = []

17 | otherwise = scan 0

26 | otherwise = scan 0

18 where

27 where

19 scan i | i >= hlen = []

28 scan i | i >= hlen = []

20 | needle `T.isPrefixOf` t = i : scan (i+nlen)

29 | needle `T.isPrefixOf` t = i : scan (i+nlen)

21 | otherwise = scan (i+d)

30 | otherwise = scan (i+d)

31+#ifdef __GHCJS__

32+ where t = Text $ js_substr1 i hjst

33+ hlen = js_length hjst

34+ nlen = js_length njst

35+#else

22 where t = Text harr (hoff+i) (hlen-i)

36 where t = Text harr (hoff+i) (hlen-i)

37+#endif

23 d = iter_ haystack i

38 d = iter_ haystack i

25splitOn :: T.Text -- ^ Text to split on

40splitOn :: T.Text -- ^ Text to split on

@@ -37,3 +52,10 @@ splitOn pat src0

37 | T.null s = [src] -- not found

52 | T.null s = [src] -- not found

38 | pat `T.isPrefixOf` s = T.take n src : go (T.drop l s)

53 | pat `T.isPrefixOf` s = T.take n src : go (T.drop l s)

39 | otherwise = search (n+1) (unsafeTail s)

54 | otherwise = search (n+1) (unsafeTail s)

55+

56+#ifdef __GHCJS__

57+foreign import javascript unsafe

58+ "$2.substr($1)" js_substr1 :: Int -> JSString -> JSString

59+foreign import javascript unsafe

60+ "$1.length" js_length :: JSString -> Int

61+#endif

text.cabal+3−1

@@ -250,13 +250,15 @@ test-suite tests

250

251 build-depends:

252 HUnit >= 1.2,

253− QuickCheck >= 2.7 && < 2.10,

253+ QuickCheck >= 2.7 && < 2.12,

254 array,

255 base,

256 binary,

257 deepseq,

258 directory,

259 ghc-prim,

260+ ghcjs-prim,

261+ ghcjs-base,

260 quickcheck-unicode >= 1.0.1.0,

262 quickcheck-unicode >= 1.0.1.0,

261 random,

263 random,

262 test-framework >= 0.4,

264 test-framework >= 0.4,