blob: d132943c2f44f852b50a071cf068e053d95e8e4d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash, UnboxedTuples #-}
module Main (enumFromCallbackCatch, consume, next, main) where
import Control.Monad
import Foreign
import GHC.ForeignPtr
import GHC.Base (realWorld#)
import Data.Word (Word8)
import Foreign.Storable (peek)
import GHC.IO
data ByteString = PS {-# UNPACK #-} !(ForeignPtr Word8) {-# UNPACK #-} !Int
instance Show ByteString where
showsPrec p ps r = showsPrec p (unpackAppendCharsStrict ps []) r
unpackAppendCharsStrict :: ByteString -> [Char] -> [Char]
unpackAppendCharsStrict (PS fp len) xs =
unsafeDupablePerformIO $ withForeignPtr fp $ \base ->
loop (base `plusPtr` (-1)) (base `plusPtr` 960) xs
where
loop !sentinal !p acc
| p == sentinal = return acc
| otherwise = do x <- peek p
loop sentinal (p `plusPtr` (-1)) (w2c x:acc)
w2c :: Word8 -> Char
w2c = toEnum . fromEnum
packCStringLen :: Int -> IO ByteString
packCStringLen l = do
p <- callocBytes bufsize
fp <- newForeignPtr finalizerFree p
return $! PS fp l
{-# NOINLINE packCStringLen #-}
bufsize :: Int
bufsize = 8192
{-# NOINLINE readFromPtr #-}
readFromPtr :: IO ByteString
readFromPtr = do
bs <- packCStringLen bufsize
length (show bs) `seq` return bs
newtype Iteratee s = Iteratee { runIter :: forall r.
((s -> Iteratee s) -> IO r) ->
IO r}
enumFromCallbackCatch :: IO ()
enumFromCallbackCatch = produce 500 consume
where
produce 0 (Iteratee f) = return ()
produce n (Iteratee f) = f onCont
where onCont k = do bs <- readFromPtr; produce (n-1) (k bs)
consume = Iteratee $ \onCont -> onCont next
next x = Iteratee $ \onCont -> print x >> onCont (\_ -> consume)
main :: IO ()
main = do
_ <- enumFromCallbackCatch
pure ()
|
