Update Trac ticket URLs to point to GitLab
[ghc.git] / testsuite / tests / eyeball / T3116.hs
1 {-# OPTIONS -O2 -XBangPatterns #-}
2
3 -- The thing to look for here is that the implementation
4 -- of 'length' does not allocate in the inner loop
5 --
6 -- See #3116
7
8 module T3116 where
9
10 import Foreign
11
12 data SByteString
13 = BS {-# UNPACK #-} !(ForeignPtr Word8) -- payload
14 {-# UNPACK #-} !Int -- offset
15 {-# UNPACK #-} !Int -- length
16
17 data ByteString
18 = Empty
19 | Chunk {-# UNPACK #-} !SByteString ByteString
20
21 bnull :: ByteString -> Bool
22 bnull Empty = True
23 bnull _ = False
24
25 btail :: ByteString -> ByteString
26 btail Empty = error "empty tail"
27 btail (Chunk (BS fp s 1) cs) = cs
28 btail (Chunk (BS fp s l) cs) = Chunk (BS fp (s+1) (l-1)) cs
29
30 length :: ByteString -> Int
31 length = go 0
32 where
33 go !n bs | bnull bs = n
34 | otherwise = go (n+1) (btail bs)