1 {-# LANGUAGE BangPatterns, ExistentialQuantification #-}
    2 -- |
    3 -- Module      : Data.Text.Fusion.Internal
    4 -- Copyright   : (c) Tom Harper 2008-2009,
    5 --               (c) Bryan O'Sullivan 2009,
    6 --               (c) Duncan Coutts 2009
    7 --
    8 -- License     : BSD-style
    9 -- Maintainer  : bos@serpentine.com, rtomharper@googlemail.com,
   10 --               duncan@haskell.org
   11 -- Stability   : experimental
   12 -- Portability : GHC
   13 --
   14 -- Core stream fusion functionality for text.
   15 
   16 module Data.Text.Fusion.Internal
   17     (
   18       CC(..)
   19     , M(..)
   20     , M8
   21     , PairS(..)
   22     , S(..)
   23     , Step(..)
   24     , Stream(..)
   25     , Switch(..)
   26     , empty
   27     ) where
   28 
   29 import Data.Text.Fusion.Size
   30 import Data.Word (Word8)
   31 
   32 -- | Specialised tuple for case conversion.
   33 data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
   34 
   35 -- | Specialised, strict Maybe-like type.
   36 data M a = N
   37          | J !a
   38 
   39 type M8 = M Word8
   40 
   41 -- Restreaming state.
   42 data S s = S !s {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8
   43 
   44 infixl 2 :*:
   45 data PairS a b = !a :*: !b
   46                  deriving (-- never entered-- never enteredEq, -- never enteredOrd, -- never entered-- never enteredShow)
   47 
   48 -- | Allow a function over a stream to switch between two states.
   49 data Switch = S1 | S2
   50 
   51 data Step s a = Done
   52               | Skip !s
   53               | Yield !a !s
   54 
   55 instance (Show a) => Show (Step s a)
   56     where -- never enteredshow Done        = "Done"
   57           show (Skip _)    = "Skip"
   58           show (Yield x _) = "Yield " ++ show x
   59 
   60 instance (Eq a) => Eq (Stream a) where
   61     -- entered 12,460 times(==) = eq
   62 
   63 instance (Ord a) => Ord (Stream a) where
   64     -- entered 400 timescompare = cmp
   65 
   66 -- The length hint in a Stream has two roles.  If its value is zero,
   67 -- we trust it, and treat the stream as empty.  Otherwise, we treat it
   68 -- as a hint: it should usually be accurate, so we use it when
   69 -- unstreaming to decide what size array to allocate.  However, the
   70 -- unstreaming functions must be able to cope with the hint being too
   71 -- small or too large.
   72 --
   73 -- The size hint tries to track the UTF-16 code points in a stream,
   74 -- but often counts the number of characters instead.  It can easily
   75 -- undercount if, for instance, a transformed stream contains astral
   76 -- plane characters (those above 0x10000).
   77 
   78 data Stream a =
   79     forall s. Stream
   80     (s -> Step s a)             -- stepper function
   81     !s                          -- current state
   82     {-# UNPACK #-} !Size        -- size hint
   83 
   84 -- | /O(n)/ Determines if two streams are equal.
   85 eq :: (Eq a) => Stream a -> Stream a -> Bool
   86 -- entered 12,460 timeseq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
   87     where
   88       loop Done Done                     = True
   89       loop (Skip s1')     (Skip s2')     = loop (next1 s1') (next2 s2')
   90       loop (Skip s1')     x2             = loop (next1 s1') x2
   91       loop x1             (Skip s2')     = loop x1          (next2 s2')
   92       loop Done _                        = False
   93       loop _    Done                     = False
   94       loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
   95                                            loop (next1 s1') (next2 s2')
   96 {-# INLINE [0] eq #-}
   97 {-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}
   98 
   99 cmp :: (Ord a) => Stream a -> Stream a -> Ordering
  100 -- entered 400 timescmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
  101     where
  102       loop Done Done                     = EQ
  103       loop (Skip s1')     (Skip s2')     = loop (next1 s1') (next2 s2')
  104       loop (Skip s1')     x2             = loop (next1 s1') x2
  105       loop x1             (Skip s2')     = loop x1          (next2 s2')
  106       loop Done _                        = LT
  107       loop _    Done                     = GT
  108       loop (Yield x1 s1') (Yield x2 s2') =
  109           case compare x1 x2 of
  110             EQ    -> loop (next1 s1') (next2 s2')
  111             other -> other
  112 {-# INLINE [0] cmp #-}
  113 {-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}
  114 
  115 -- | The empty stream.
  116 empty :: Stream a
  117 -- entered onceempty = Stream next () 0
  118     where next _ = Done
  119 {-# INLINE [0] empty #-}