Skip to content

Instantly share code, notes, and snippets.

@bos

bos/unbox.patch

Created August 15, 2010 19:47
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save bos/525884 to your computer and use it in GitHub Desktop.
Save bos/525884 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
unbox.patch
diff -rN -u old-text/Data/Text/Encoding/Fusion/Common.hs new-text/Data/Text/Encoding/Fusion/Common.hs
--- old-text/Data/Text/Encoding/Fusion/Common.hs 2010-08-15 12:44:14.251803996 -0700
+++ new-text/Data/Text/Encoding/Fusion/Common.hs 2010-08-15 12:44:14.274804276 -0700
@@ -45,19 +45,19 @@
Done -> Done
Skip s' -> Skip (S s' N N N)
Yield x xs
- | n <= 0x7F -> Yield c (S xs N N N)
- | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)
- | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)
- | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))
+ | n <= 0x7F -> WYield c (S xs N N N)
+ | n <= 0x07FF -> WYield a2 (S xs (J b2) N N)
+ | n <= 0xFFFF -> WYield a3 (S xs (J b3) (J c3) N)
+ | otherwise -> WYield a4 (S xs (J b4) (J c4) (J d4))
where
n = ord x
c = fromIntegral n
(a2,b2) = U8.ord2 x
(a3,b3,c3) = U8.ord3 x
(a4,b4,c4,d4) = U8.ord4 x
- next (S s (J x2) N N) = Yield x2 (S s N N N)
- next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
- next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
+ next (S s (J x2) N N) = WYield x2 (S s N N N)
+ next (S s (J x2) x3 N) = WYield x2 (S s x3 N N)
+ next (S s (J x2) x3 x4) = WYield x2 (S s x3 x4 N)
next _ = internalError "restreamUtf8"
{-# INLINE restreamUtf8 #-}
@@ -70,9 +70,9 @@
Done -> Done
Skip s' -> Skip (S s' N N N)
Yield x xs
- | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $
+ | n < 0x10000 -> WYield (fromIntegral $ n `shiftR` 8) $
S xs (J $ fromIntegral n) N N
- | otherwise -> Yield c1 $
+ | otherwise -> WYield c1 $
S xs (J c2) (J c3) (J c4)
where
n = ord x
@@ -82,9 +82,9 @@
n2 = n1 .&. 0x3FF
c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)
c4 = fromIntegral n2
- next (S s (J x2) N N) = Yield x2 (S s N N N)
- next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
- next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
+ next (S s (J x2) N N) = WYield x2 (S s N N N)
+ next (S s (J x2) x3 N) = WYield x2 (S s x3 N N)
+ next (S s (J x2) x3 x4) = WYield x2 (S s x3 x4 N)
next _ = internalError "restreamUtf16BE"
{-# INLINE restreamUtf16BE #-}
@@ -97,9 +97,9 @@
Done -> Done
Skip s' -> Skip (S s' N N N)
Yield x xs
- | n < 0x10000 -> Yield (fromIntegral n) $
+ | n < 0x10000 -> WYield (fromIntegral n) $
S xs (J (fromIntegral $ shiftR n 8)) N N
- | otherwise -> Yield c1 $
+ | otherwise -> WYield c1 $
S xs (J c2) (J c3) (J c4)
where
n = ord x
@@ -109,9 +109,9 @@
n2 = n1 .&. 0x3FF
c4 = fromIntegral (shiftR n2 8 + 0xDC)
c3 = fromIntegral n2
- next (S s (J x2) N N) = Yield x2 (S s N N N)
- next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
- next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
+ next (S s (J x2) N N) = WYield x2 (S s N N N)
+ next (S s (J x2) x3 N) = WYield x2 (S s x3 N N)
+ next (S s (J x2) x3 x4) = WYield x2 (S s x3 x4 N)
next _ = internalError "restreamUtf16LE"
{-# INLINE restreamUtf16LE #-}
@@ -123,16 +123,16 @@
next (S s N N N) = case next0 s of
Done -> Done
Skip s' -> Skip (S s' N N N)
- Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
+ Yield x xs -> WYield c1 (S xs (J c2) (J c3) (J c4))
where
n = ord x
c1 = fromIntegral $ shiftR n 24
c2 = fromIntegral $ shiftR n 16
c3 = fromIntegral $ shiftR n 8
c4 = fromIntegral n
- next (S s (J x2) N N) = Yield x2 (S s N N N)
- next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
- next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
+ next (S s (J x2) N N) = WYield x2 (S s N N N)
+ next (S s (J x2) x3 N) = WYield x2 (S s x3 N N)
+ next (S s (J x2) x3 x4) = WYield x2 (S s x3 x4 N)
next _ = internalError "restreamUtf32BE"
{-# INLINE restreamUtf32BE #-}
@@ -144,16 +144,16 @@
next (S s N N N) = case next0 s of
Done -> Done
Skip s' -> Skip (S s' N N N)
- Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))
+ Yield x xs -> WYield c1 (S xs (J c2) (J c3) (J c4))
where
n = ord x
c4 = fromIntegral $ shiftR n 24
c3 = fromIntegral $ shiftR n 16
c2 = fromIntegral $ shiftR n 8
c1 = fromIntegral n
- next (S s (J x2) N N) = Yield x2 (S s N N N)
- next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)
- next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)
+ next (S s (J x2) N N) = WYield x2 (S s N N N)
+ next (S s (J x2) x3 N) = WYield x2 (S s x3 N N)
+ next (S s (J x2) x3 x4) = WYield x2 (S s x3 x4 N)
next _ = internalError "restreamUtf32LE"
{-# INLINE restreamUtf32LE #-}
diff -rN -u old-text/Data/Text/Fusion/Common.hs new-text/Data/Text/Fusion/Common.hs
--- old-text/Data/Text/Fusion/Common.hs 2010-08-15 12:44:14.254804625 -0700
+++ new-text/Data/Text/Fusion/Common.hs 2010-08-15 12:44:14.275803927 -0700
@@ -15,8 +15,11 @@
(
-- * Creation and elimination
singleton
- , streamList
+ , streamChars
+ , streamWords
+ , unstreamChars
, unstreamList
+ , unstreamWords
-- * Basic interface
, cons
@@ -107,6 +110,7 @@
import Data.Text.Fusion.Internal
import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)
import Data.Text.Fusion.Size
+import Data.Word (Word8)
singleton :: Char -> Stream Char
singleton c = Stream next False 1
@@ -114,21 +118,44 @@
next True = Done
{-# INLINE singleton #-}
-streamList :: [a] -> Stream a
-{-# INLINE [0] streamList #-}
-streamList s = Stream next s unknownSize
+streamChars :: [Char] -> Stream Char
+{-# INLINE [0] streamChars #-}
+streamChars s = Stream next s unknownSize
where next [] = Done
next (x:xs) = Yield x xs
+streamWords :: [Word8] -> Stream Word8
+{-# INLINE [0] streamWords #-}
+streamWords s = Stream next s unknownSize
+ where next [] = Done
+ next (x:xs) = WYield x xs
+
+unstreamChars :: Stream Char -> [Char]
+unstreamChars (Stream next s0 _len) = unfold s0
+ where unfold !s = case next s of
+ Done -> []
+ Skip s' -> unfold s'
+ Yield x s' -> x : unfold s'
+{-# INLINE [0] unstreamChars #-}
+
unstreamList :: Stream a -> [a]
unstreamList (Stream next s0 _len) = unfold s0
where unfold !s = case next s of
Done -> []
Skip s' -> unfold s'
- Yield x s' -> x : unfold s'
+ GYield x s' -> x : unfold s'
{-# INLINE [0] unstreamList #-}
-{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
+unstreamWords :: Stream Word8 -> [Word8]
+unstreamWords (Stream next s0 _len) = unfold s0
+ where unfold !s = case next s of
+ Done -> []
+ Skip s' -> unfold s'
+ WYield x s' -> x : unfold s'
+{-# INLINE [0] unstreamWords #-}
+
+{-# RULES "STREAM streamChars/unstreamChars fusion" forall s. streamChars (unstreamChars s) = s #-}
+{-# RULES "STREAM streamWords/unstreamWords fusion" forall s. streamWords (unstreamWords s) = s #-}
-- ----------------------------------------------------------------------------
-- * Basic stream functions
@@ -824,12 +851,12 @@
next (sa :*: sb :*: N) = case next0 sa of
Done -> Done
Skip sa' -> Skip (sa' :*: sb :*: N)
- Yield a sa' -> Skip (sa' :*: sb :*: J a)
+ GYield a sa' -> Skip (sa' :*: sb :*: J a)
next (sa' :*: sb :*: J a) = case next1 sb of
Done -> Done
Skip sb' -> Skip (sa' :*: sb' :*: J a)
- Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)
+ GYield b sb' -> GYield (f a b) (sa' :*: sb' :*: N)
{-# INLINE [0] zipWith #-}
-- | /O(n)/ The 'countCharI' function returns the number of times the
diff -rN -u old-text/Data/Text/Fusion/Internal.hs new-text/Data/Text/Fusion/Internal.hs
--- old-text/Data/Text/Fusion/Internal.hs 2010-08-15 12:44:14.255804206 -0700
+++ new-text/Data/Text/Fusion/Internal.hs 2010-08-15 12:44:14.275803927 -0700
@@ -51,12 +51,15 @@
data Step s a = Done
| Skip !s
- | Yield !a !s
+ | Yield {-# UNPACK #-} !Char !s
+ | WYield {-# UNPACK #-} !Word8 !s
+ | GYield !a !s
instance (Show a) => Show (Step s a)
where show Done = "Done"
show (Skip _) = "Skip"
- show (Yield x _) = "Yield " ++ show x
+ show (Yield x _) = "CYield " ++ show x
+ show (WYield x _) = "WYield " ++ show x
instance (Eq a) => Eq (Stream a) where
(==) = eq
@@ -94,6 +97,8 @@
loop _ Done = False
loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
loop (next1 s1') (next2 s2')
+ loop (WYield x1 s1') (WYield x2 s2') = x1 == x2 &&
+ loop (next1 s1') (next2 s2')
{-# INLINE [0] eq #-}
{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}
@@ -110,8 +115,11 @@
case compare x1 x2 of
EQ -> loop (next1 s1') (next2 s2')
other -> other
+ loop (WYield x1 s1') (WYield x2 s2') =
+ case compare x1 x2 of
+ EQ -> loop (next1 s1') (next2 s2')
+ other -> other
{-# INLINE [0] cmp #-}
-{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}
-- | The empty stream.
empty :: Stream a
diff -rN -u old-text/Data/Text/Lazy.hs new-text/Data/Text/Lazy.hs
--- old-text/Data/Text/Lazy.hs 2010-08-15 12:44:14.261804695 -0700
+++ new-text/Data/Text/Lazy.hs 2010-08-15 12:44:14.278804346 -0700
@@ -240,13 +240,13 @@
--
-- This function is subject to array fusion.
pack :: String -> Text
-pack s = unstream (S.streamList s)
+pack s = unstream (S.streamChars s)
{-# INLINE [1] pack #-}
-- | /O(n)/ Convert a 'Text' into a 'String'.
-- Subject to array fusion.
unpack :: Text -> String
-unpack t = S.unstreamList (stream t)
+unpack t = S.unstreamChars (stream t)
{-# INLINE [1] unpack #-}
singleton :: Char -> Text
diff -rN -u old-text/Data/Text.hs new-text/Data/Text.hs
--- old-text/Data/Text.hs 2010-08-15 12:44:14.263804276 -0700
+++ new-text/Data/Text.hs 2010-08-15 12:44:14.278804346 -0700
@@ -259,12 +259,12 @@
-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to fusion.
pack :: String -> Text
-pack = unstream . S.streamList
+pack = unstream . S.streamChars
{-# INLINE [1] pack #-}
-- | /O(n)/ Convert a Text into a String. Subject to fusion.
unpack :: Text -> String
-unpack = S.unstreamList . stream
+unpack = S.unstreamChars . stream
{-# INLINE [1] unpack #-}
-- | /O(1)/ Convert a character into a Text.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment