@@ -0,0 +1,90 @@
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 : rtharper@aftereternity.co.uk, bos@serpentine.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+ PairS(..)
19+ , Switch(..)
20+ , Step(..)
21+ , Stream(..)
22+ , empty
23+ , streamList
24+ , unstreamList
25+ , eq
26+ ) where
27+
28+infixl 2 :!:
29+data PairS a b = !a :!: !b
30+
31+-- | Allow a function over a stream to switch between two states.
32+data Switch = S1 | S2
33+
34+data Step s a = Done
35+ | Skip !s
36+ | Yield !a !s
37+
38+-- The length hint in a Stream has two roles. If its value is zero,
39+-- we trust it, and treat the stream as empty. Otherwise, we treat it
40+-- as a hint: it should usually be accurate, so we use it when
41+-- unstreaming to decide what size array to allocate. However, the
42+-- unstreaming functions must be able to cope with the hint being too
43+-- small or too large.
44+--
45+-- The size hint tries to track the UTF-16 code points in a stream,
46+-- but often counts the number of characters instead. It can easily
47+-- undercount if, for instance, a transformed stream contains astral
48+-- plane characters (those above 0x10000).
49+
50+data Stream a =
51+ forall s. Stream
52+ (s -> Step s a) -- stepper function
53+ !s -- current state
54+ {-# UNPACK #-}!Int -- length hint
55+
56+-- | The empty stream.
57+empty :: Stream a
58+empty = Stream next () 0
59+ where next _ = Done
60+{-# INLINE [0] empty #-}
61+
62+-- | /O(n)/ Determines if two streams are equal.
63+eq :: Ord a => Stream a -> Stream a -> Bool
64+{-# INLINE eq #-}
65+eq (Stream next1 s1 _) (Stream next2 s2 _) = cmp (next1 s1) (next2 s2)
66+ where
67+ cmp Done Done = True
68+ cmp Done _ = False
69+ cmp _ Done = False
70+ cmp (Skip s1') (Skip s2') = cmp (next1 s1') (next2 s2')
71+ cmp (Skip s1') x2 = cmp (next1 s1') x2
72+ cmp x1 (Skip s2') = cmp x1 (next2 s2')
73+ cmp (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
74+ cmp (next1 s1') (next2 s2')
75+
76+streamList :: [a] -> Stream a
77+{-# INLINE streamList #-}
78+streamList [] = empty
79+streamList s = Stream next s unknownLength
80+ where next [] = Done
81+ next (x:xs) = Yield x xs
82+ unknownLength = 8
83+
84+unstreamList :: Stream a -> [a]
85+{-# INLINE unstreamList #-}
86+unstreamList (Stream next s0 _len) = unfold s0
87+ where unfold !s = case next s of
88+ Done -> []
89+ Skip s' -> unfold s'
90+ Yield x s' -> x : unfold s'