1{-# LANGUAGE BangPatterns, ExistentialQuantification #-} 2-- | 3-- Module : Data.Text.Internal.Fusion.Types 4-- Copyright : (c) Tom Harper 2008-2009, 5-- (c) Bryan O'Sullivan 2009, 6-- (c) Duncan Coutts 2009, 7-- (c) Jasper Van der Jeugt 2011 8-- 9-- License : BSD-style 10-- Maintainer : bos@serpentine.com 11-- Stability : experimental 12-- Portability : GHC 13-- 14-- /Warning/: this is an internal module, and does not have a stable 15-- API or name. Functions in this module may not check or enforce 16-- preconditions expected by public modules. Use at your own risk! 17-- 18-- Core stream fusion functionality for text. 19 20module Data.Text.Internal.Fusion.Types 21 ( 22 CC(..) 23 , PairS(..) 24 , Scan(..) 25 , RS(..) 26 , Step(..) 27 , Stream(..) 28 , empty 29 ) where 30 31import Data.Text.Internal.Fusion.Size 32import Data.Word (Word8) 33 34-- | Specialised tuple for case conversion. 35data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char 36 37-- | Restreaming state. 38data RS s 39 = RS0 !s 40 | RS1 !s {-# UNPACK #-} !Word8 41 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 42 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 43 44-- | Strict pair. 45data PairS a b = !a :*: !b 46 -- deriving (Eq, Ord, Show) 47infixl 2 :*: 48 49-- | An intermediate result in a scan. 50data Scan s = Scan1 {-# UNPACK #-} !Char !s 51 | Scan2 {-# UNPACK #-} !Char !s 52 53-- | Intermediate result in a processing pipeline. 54data Step s a = Done 55 | Skip !s 56 | Yield !a !s 57 58{- 59instance (Show a) => Show (Step s a) 60 where show Done = "Done" 61 show (Skip _) = "Skip" 62 show (Yield x _) = "Yield " ++ show x 63-} 64 65instance (Eq a) => Eq (Stream a) where 66 (==) = eq 67 68instance (Ord a) => Ord (Stream a) where 69 compare = cmp 70 71-- 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 73-- as a hint: it should usually be accurate, so we use it when 74-- unstreaming to decide what size array to allocate. However, the 75-- unstreaming functions must be able to cope with the hint being too 76-- small or too large. 77-- 78-- The size hint tries to track the UTF-16 code units in a stream, 79-- but often counts the number of code points instead. It can easily 80-- undercount if, for instance, a transformed stream contains astral 81-- plane code points (those above 0x10000). 82 83data Stream a = 84 forall s. Stream 85 (s -> Step s a) -- stepper function 86 !s -- current state 87 !Size -- size hint in code units 88 89-- | /O(n)/ Determines if two streams are equal. 90eq :: (Eq a) => Stream a -> Stream a -> Bool 91eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2) 92 where 93 loop Done Done = True 94 loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2') 95 loop (Skip s1') x2 = loop (next1 s1') x2 96 loop x1 (Skip s2') = loop x1 (next2 s2') 97 loop Done _ = False 98 loop _ Done = False 99 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 && 100 loop (next1 s1') (next2 s2') 101{-# INLINE [0] eq #-} 102 103cmp :: (Ord a) => Stream a -> Stream a -> Ordering 104cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2) 105 where 106 loop Done Done = EQ 107 loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2') 108 loop (Skip s1') x2 = loop (next1 s1') x2 109 loop x1 (Skip s2') = loop x1 (next2 s2') 110 loop Done _ = LT 111 loop _ Done = GT 112 loop (Yield x1 s1') (Yield x2 s2') = 113 case compare x1 x2 of 114 EQ -> loop (next1 s1') (next2 s2') 115 other -> other 116{-# INLINE [0] cmp #-} 117 118-- | The empty stream. 119empty :: Stream a 120empty = Stream next () 0 121 where next _ = Done 122{-# INLINE [0] empty #-} 123