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