{-# LANGUAGE CPP, MagicHash, TypeSynonymInstances, FlexibleInstances #-}

{- |
  Module      :  Codec.Binary.UTF8.Light
  Copyright   :  (c) Matt Morrow 2008
  License     :  BSD3
  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
  Stability   :  provisional
  Portability :  portable

  Lightweight UTF8 handling.
-}

module Codec.Binary.UTF8.Light (
    UTF8(..)
  , lenUTF8
  , lenUTF16
  , countUTF8
  , decodeUTF8
  , encodeUTF8
  , encodeUTF8'
  , withUTF8
  , putUTF8
  , putUTF8Ln
  , hPutUTF8
  , hPutUTF8Ln
  , readUTF8File
  , writeUTF8File
  , appendUTF8File
  , hGetUTF8Line
  , hGetUTF8Contents
  , hGetUTF8
  , hGetUTF8NonBlocking
  , c2w
  , w2c
  , i2w
  , w2i
  , flipUTF8
  , unflipUTF8
  , flipTab
  , unflipTab
  , showHex
  , toBits
  , fromBits
  , Int8,Int16,Int32
  , Word,Word8,Word16,Word32
) where

import Data.Bits
import Data.List(foldl')
import Data.Char(chr,ord)
import Data.Monoid(Monoid(..))
import Data.ByteString(ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Internal as B
import Data.ByteString.Unsafe
import System.IO(Handle)

#if defined(__GLASGOW_HASKELL__)
import GHC.Exts
  (Int(I#),Word(W#),Char(C#)
  ,Ptr(Ptr),FunPtr(FunPtr))
import GHC.Int
  (Int8(I8#),Int16(I16#),Int32(I32#))
import GHC.Word
  (Word8(W8#),Word16(W16#),Word32(W32#))
import GHC.Prim
  (Char#,Int#,Word#,Addr#
  ,ord#,chr#,int2Word#,word2Int#
  ,and#,or#,xor#,not#
  ,gtWord#,geWord#,eqWord#
  ,neWord#,ltWord#,leWord#
  ,uncheckedShiftL#,uncheckedShiftRL#
  ,narrow8Int#,narrow16Int#,narrow32Int#
  ,narrow8Word#,narrow16Word#,narrow32Word#)
#else
import Data.Word
  (Word,Word8,Word16,Word32)
import Data.Int(Int32)
#endif

-- | For convenience
fi :: (Num b, Integral a) => a -> b
fi :: a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Instances:
--    @ByteString@, @String@
--    , @[Word32]@, @[Word]@
--    , @[Int32]@, @[Int]@
class UTF8 a where
  encode :: a -> ByteString
  decode :: ByteString -> a

instance UTF8 ByteString where
  encode :: ByteString -> ByteString
encode = ByteString -> ByteString
forall a. a -> a
id
  decode :: ByteString -> ByteString
decode = ByteString -> ByteString
forall a. a -> a
id

instance UTF8 [Word32] where
  encode :: [Word32] -> ByteString
encode = [Word32] -> ByteString
encodeUTF8
  decode :: ByteString -> [Word32]
decode = ByteString -> [Word32]
decodeUTF8

instance UTF8 [Word] where
  encode :: [Word] -> ByteString
encode = [Word32] -> ByteString
encodeUTF8 ([Word32] -> ByteString)
-> ([Word] -> [Word32]) -> [Word] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Word32) -> [Word] -> [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Word32
forall b a. (Num b, Integral a) => a -> b
fi
  decode :: ByteString -> [Word]
decode = (Word32 -> Word) -> [Word32] -> [Word]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Word
forall b a. (Num b, Integral a) => a -> b
fi ([Word32] -> [Word])
-> (ByteString -> [Word32]) -> ByteString -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word32]
decodeUTF8

instance UTF8 [Int32] where
  encode :: [Int32] -> ByteString
encode = [Word32] -> ByteString
encodeUTF8 ([Word32] -> ByteString)
-> ([Int32] -> [Word32]) -> [Int32] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Word32) -> [Int32] -> [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi
  decode :: ByteString -> [Int32]
decode = (Word32 -> Int32) -> [Word32] -> [Int32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int32
forall b a. (Num b, Integral a) => a -> b
fi ([Word32] -> [Int32])
-> (ByteString -> [Word32]) -> ByteString -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word32]
decodeUTF8

instance UTF8 [Int] where
  encode :: [Int] -> ByteString
encode = [Word32] -> ByteString
encodeUTF8 ([Word32] -> ByteString)
-> ([Int] -> [Word32]) -> [Int] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word32) -> [Int] -> [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Word32
forall b a. (Num b, Integral a) => a -> b
fi
  decode :: ByteString -> [Int]
decode = (Word32 -> Int) -> [Word32] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int
forall b a. (Num b, Integral a) => a -> b
fi ([Word32] -> [Int])
-> (ByteString -> [Word32]) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word32]
decodeUTF8

instance UTF8 String where
  encode :: String -> ByteString
encode = [Int] -> ByteString
forall a. UTF8 a => a -> ByteString
encode ([Int] -> ByteString) -> (String -> [Int]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Int
ord
  decode :: ByteString -> String
decode = (Int -> Char) -> [Int] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
chr ([Int] -> String) -> (ByteString -> [Int]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Int]
forall a. UTF8 a => ByteString -> a
decode

withUTF8 :: (UTF8 a) => a -> (ByteString -> b) -> b
withUTF8 :: a -> (ByteString -> b) -> b
withUTF8 a :: a
a k :: ByteString -> b
k = ByteString -> b
k (a -> ByteString
forall a. UTF8 a => a -> ByteString
encode a
a)

putUTF8 :: (UTF8 a) => a -> IO ()
putUTF8 :: a -> IO ()
putUTF8 = (a -> (ByteString -> IO ()) -> IO ())
-> (ByteString -> IO ()) -> a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> (ByteString -> IO ()) -> IO ()
forall a b. UTF8 a => a -> (ByteString -> b) -> b
withUTF8 ByteString -> IO ()
B.putStr

putUTF8Ln :: (UTF8 a) => a -> IO ()
putUTF8Ln :: a -> IO ()
putUTF8Ln = (a -> (ByteString -> IO ()) -> IO ())
-> (ByteString -> IO ()) -> a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> (ByteString -> IO ()) -> IO ()
forall a b. UTF8 a => a -> (ByteString -> b) -> b
withUTF8 ByteString -> IO ()
B8.putStrLn

hPutUTF8 :: (UTF8 a) => Handle -> a -> IO ()
hPutUTF8 :: Handle -> a -> IO ()
hPutUTF8 h :: Handle
h = (a -> (ByteString -> IO ()) -> IO ())
-> (ByteString -> IO ()) -> a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> (ByteString -> IO ()) -> IO ()
forall a b. UTF8 a => a -> (ByteString -> b) -> b
withUTF8 (Handle -> ByteString -> IO ()
B.hPut Handle
h)

hPutUTF8Ln :: (UTF8 a) => Handle -> a -> IO ()
hPutUTF8Ln :: Handle -> a -> IO ()
hPutUTF8Ln h :: Handle
h = (a -> (ByteString -> IO ()) -> IO ())
-> (ByteString -> IO ()) -> a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> (ByteString -> IO ()) -> IO ()
forall a b. UTF8 a => a -> (ByteString -> b) -> b
withUTF8 (Handle -> ByteString -> IO ()
B8.hPutStrLn Handle
h)

readUTF8File :: (UTF8 a) => FilePath -> IO a
readUTF8File :: String -> IO a
readUTF8File = (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (ByteString -> a) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a
forall a. UTF8 a => ByteString -> a
decode (ByteString -> IO a) -> IO ByteString -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO ByteString -> IO a)
-> (String -> IO ByteString) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
B.readFile

writeUTF8File :: (UTF8 a) => FilePath -> a -> IO ()
writeUTF8File :: String -> a -> IO ()
writeUTF8File p :: String
p = String -> ByteString -> IO ()
B.writeFile String
p (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. UTF8 a => a -> ByteString
encode

appendUTF8File :: (UTF8 a) => FilePath -> a -> IO ()
appendUTF8File :: String -> a -> IO ()
appendUTF8File p :: String
p = String -> ByteString -> IO ()
B.appendFile String
p (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. UTF8 a => a -> ByteString
encode

hGetUTF8Line :: (UTF8 a) => Handle -> IO a
hGetUTF8Line :: Handle -> IO a
hGetUTF8Line = (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (ByteString -> a) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a
forall a. UTF8 a => ByteString -> a
decode (ByteString -> IO a) -> IO ByteString -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO ByteString -> IO a)
-> (Handle -> IO ByteString) -> Handle -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ByteString
B.hGetLine

hGetUTF8Contents :: (UTF8 a) => Handle -> IO a
hGetUTF8Contents :: Handle -> IO a
hGetUTF8Contents = (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (ByteString -> a) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a
forall a. UTF8 a => ByteString -> a
decode (ByteString -> IO a) -> IO ByteString -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO ByteString -> IO a)
-> (Handle -> IO ByteString) -> Handle -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ByteString
B.hGetContents

-- | Be careful that you're sure you're not
--  chopping a UTF8 char in two!
hGetUTF8 :: (UTF8 a) => Handle -> Int -> IO a
hGetUTF8 :: Handle -> Int -> IO a
hGetUTF8 h :: Handle
h = (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (ByteString -> a) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a
forall a. UTF8 a => ByteString -> a
decode (ByteString -> IO a) -> IO ByteString -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO ByteString -> IO a) -> (Int -> IO ByteString) -> Int -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Int -> IO ByteString
B.hGet Handle
h

-- | Same warning as for @hGetUTF8@
hGetUTF8NonBlocking :: (UTF8 a) => Handle -> Int -> IO a
hGetUTF8NonBlocking :: Handle -> Int -> IO a
hGetUTF8NonBlocking h :: Handle
h = (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> (ByteString -> a) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a
forall a. UTF8 a => ByteString -> a
decode (ByteString -> IO a) -> IO ByteString -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO ByteString -> IO a) -> (Int -> IO ByteString) -> Int -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Int -> IO ByteString
B.hGetNonBlocking Handle
h

-- | Length in Word8s
lenUTF8 :: Word8 -> Int
{-# INLINE lenUTF8 #-}
lenUTF8 :: Word8 -> Int
lenUTF8 w8 :: Word8
w8
  | Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< 0x80 = 1
  | Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< 0xe0 = 2
  | Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< 0xf0 = 3
  | Word8
w8 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< 0xf8 = 4
  | Bool
otherwise = 0

-- | Length in Word16s
lenUTF16 :: Word16 -> Int
lenUTF16 :: Word16 -> Int
lenUTF16 w16 :: Word16
w16
-- I'm sure this could be
-- made more efficient
  | Word16
w16Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR`10Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
==0x36 = 2
  | Word16
w16Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR`10Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
==0x37 = 0
  | Bool
otherwise           = 1

-- | Lengths in Word8s
countUTF8 :: ByteString -> [Int]
countUTF8 :: ByteString -> [Int]
countUTF8 s :: ByteString
s = Int -> Int -> ByteString -> [Int]
go 0 (ByteString -> Int
B.length ByteString
s) ByteString
s
  where go :: Int -> Int -> ByteString -> [Int]
        go :: Int -> Int -> ByteString -> [Int]
go i :: Int
i len :: Int
len s :: ByteString
s | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = []
          | Bool
otherwise = case Word8 -> Int
lenUTF8 (ByteString -> Int -> Word8
unsafeIndex ByteString
s Int
i)
                          of  0 -> []
                              n :: Int
n -> Int
n Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> Int -> ByteString -> [Int]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Int
len ByteString
s

encodeUTF8 :: [Word32] -> ByteString
encodeUTF8 :: [Word32] -> ByteString
encodeUTF8 = [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> ([Word32] -> [Word8]) -> [Word32] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Word8]] -> [Word8]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Word8]] -> [Word8])
-> ([Word32] -> [[Word8]]) -> [Word32] -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word32] -> [[Word8]]
encodeUTF8'

#if !defined(__GLASGOW_HASKELL__)

-- | Word32s not representing
--  valid UTF8 chars are /dropped/.
encodeUTF8' :: [Word32] -> [[Word8]]
encodeUTF8' [] = []
encodeUTF8' (x:xs)
  | x < 0x80 =
      [fi x] : encodeUTF8' xs
  | x < 0x800 =
      [ fi(x`shiftR`6.|.0xc0)
      , fi(x.&.0x3f.|.0x80)
      ] : encodeUTF8' xs
  | x < 0xf0000 =
      [ fi(x`shiftR`12.|.0xe0)
      , fi(x`shiftR`6.&.0x3f.|.0x80)
      , fi(x.&.0x3f.|.0x80)
      ] : encodeUTF8' xs
  | x < 0xe00000 =
      [ fi(x`shiftR`18.|.0xf0)
      , fi(x`shiftR`12.&.0x3f.|.0x80)
      , fi(x`shiftR`6.&.0x3f.|.0x80)
      , fi(x.&.0x3f.|.0x80)
      ] : encodeUTF8' xs
  | otherwise = [] : encodeUTF8' xs

decodeUTF8 :: ByteString -> [Word32]
decodeUTF8 s = go 0 (B.length s) s
  where go :: Int -> Int -> ByteString -> [Word32]
        go i len s | len <= i  = []
          | otherwise = let c1 = unsafeIndex s i
                        in case lenUTF8 c1 of
                            0 -> []
                            1 -> fi c1 : go (i+1) len s
                            2 -> if len <= i+1 then [] else
                                  let c2 = unsafeIndex s (i+1)
                                  in fi(c1.&.0x1f)`shiftL`6
                                        `xor`fi(c2.&.0x3f)
                                          : go (i+2) len s
                            3 -> if len <= i+2 then [] else
                                  let c2 = unsafeIndex s (i+1)
                                      c3 = unsafeIndex s (i+2)
                                  in fi(c1.&.0x1f)`shiftL`12
                                      `xor`fi(c2.&.0x3f)`shiftL`6
                                        `xor`fi(c3.&.0x3f)
                                          : go (i+3) len s
                            4 -> if len <= i+3 then [] else
                                  let c2 = unsafeIndex s (i+1)
                                      c3 = unsafeIndex s (i+2)
                                      c4 = unsafeIndex s (i+3)
                                  in fi(c1.&.0x1f)`shiftL`18
                                      `xor`fi(c2.&.0x3f)`shiftL`12
                                        `xor`fi(c3.&.0x3f)`shiftL`6
                                          `xor`fi(c4.&.0x3f)
                                            : go (i+4) len s

#else

-- | Word32s not representing
--  valid UTF8 chars are /dropped/.
encodeUTF8' :: [Word32] -> [[Word8]]
encodeUTF8' :: [Word32] -> [[Word8]]
encodeUTF8' [] = []
-- with ghc-6.10, we
-- can use Word# literalls
-- ==> 0xff00ff00##
encodeUTF8' ((W32# w :: Word#
w):xs :: [Word32]
xs)
#if MIN_VERSION_base(4,7,0)
  | Int# -> Int
I# (Word#
wWord# -> Word# -> Int#
`ltWord#`(Int# -> Word#
int2Word# 0x80#)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 =
#else
  | w`ltWord#`(int2Word# 0x80#) =
#endif
      [Word# -> Word8
W8# Word#
w] [Word8] -> [[Word8]] -> [[Word8]]
forall a. a -> [a] -> [a]
: [Word32] -> [[Word8]]
encodeUTF8' [Word32]
xs
#if MIN_VERSION_base(4,7,0)
  | Int# -> Int
I# (Word#
wWord# -> Word# -> Int#
`ltWord#`(Int# -> Word#
int2Word# 0x800#)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 =
#else
  | w`ltWord#`(int2Word# 0x800#) =
#endif
      [ Word# -> Word8
W8#(Word#
wWord# -> Int# -> Word#
`uncheckedShiftRL#`6#
              Word# -> Word# -> Word#
`or#`(Int# -> Word#
int2Word# 0xc0#))
      , Word# -> Word8
W8#(Word#
wWord# -> Word# -> Word#
`and#`(Int# -> Word#
int2Word# 0x3f#)
              Word# -> Word# -> Word#
`or#`(Int# -> Word#
int2Word# 0x80#))
      ] [Word8] -> [[Word8]] -> [[Word8]]
forall a. a -> [a] -> [a]
: [Word32] -> [[Word8]]
encodeUTF8' [Word32]
xs
#if MIN_VERSION_base(4,7,0)
  | Int# -> Int
I# (Word#
wWord# -> Word# -> Int#
`ltWord#`(Int# -> Word#
int2Word# 0xf0000#)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 =
#else
  | w`ltWord#`(int2Word# 0xf0000#) =
#endif
      [ Word# -> Word8
W8#(Word#
wWord# -> Int# -> Word#
`uncheckedShiftRL#`12#
              Word# -> Word# -> Word#
`or#`(Int# -> Word#
int2Word# 0xe0#))
      , Word# -> Word8
W8#(Word#
wWord# -> Int# -> Word#
`uncheckedShiftRL#`6#
              Word# -> Word# -> Word#
`and#`(Int# -> Word#
int2Word# 0x3f#)
                Word# -> Word# -> Word#
`or#`(Int# -> Word#
int2Word# 0x80#))
      , Word# -> Word8
W8#(Word#
wWord# -> Word# -> Word#
`and#`(Int# -> Word#
int2Word# 0x3f#)
              Word# -> Word# -> Word#
`or#`(Int# -> Word#
int2Word# 0x80#))
      ] [Word8] -> [[Word8]] -> [[Word8]]
forall a. a -> [a] -> [a]
: [Word32] -> [[Word8]]
encodeUTF8' [Word32]
xs
#if MIN_VERSION_base(4,7,0)
  | Int# -> Int
I# (Word#
wWord# -> Word# -> Int#
`ltWord#`(Int# -> Word#
int2Word# 0xe00000#)) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 =
#else
  | w`ltWord#`(int2Word# 0xe00000#) =
#endif
      [ Word# -> Word8
W8#(Word#
wWord# -> Int# -> Word#
`uncheckedShiftRL#`18#
              Word# -> Word# -> Word#
`or#`(Int# -> Word#
int2Word# 0xf0#))
      , Word# -> Word8
W8#(Word#
wWord# -> Int# -> Word#
`uncheckedShiftRL#`12#
              Word# -> Word# -> Word#
`and#`(Int# -> Word#
int2Word# 0x3f#)
                Word# -> Word# -> Word#
`or#`(Int# -> Word#
int2Word# 0x80#))
      , Word# -> Word8
W8#(Word#
wWord# -> Int# -> Word#
`uncheckedShiftRL#`6#
              Word# -> Word# -> Word#
`and#`(Int# -> Word#
int2Word# 0x3f#)
                Word# -> Word# -> Word#
`or#`(Int# -> Word#
int2Word# 0x80#))
      , Word# -> Word8
W8#(Word#
wWord# -> Word# -> Word#
`and#`(Int# -> Word#
int2Word# 0x3f#)
              Word# -> Word# -> Word#
`or#`(Int# -> Word#
int2Word# 0x80#))
      ] [Word8] -> [[Word8]] -> [[Word8]]
forall a. a -> [a] -> [a]
: [Word32] -> [[Word8]]
encodeUTF8' [Word32]
xs
  | Bool
otherwise = [] [Word8] -> [[Word8]] -> [[Word8]]
forall a. a -> [a] -> [a]
: [Word32] -> [[Word8]]
encodeUTF8' [Word32]
xs

-- TODO: ghc-ify decodeUTF8
decodeUTF8 :: ByteString -> [Word32]
decodeUTF8 :: ByteString -> [Word32]
decodeUTF8 s :: ByteString
s = Int -> Int -> ByteString -> [Word32]
go 0 (ByteString -> Int
B.length ByteString
s) ByteString
s
  where go :: Int -> Int -> ByteString -> [Word32]
        go :: Int -> Int -> ByteString -> [Word32]
go i :: Int
i len :: Int
len s :: ByteString
s | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i  = []
          | Bool
otherwise = let c1 :: Word8
c1 = ByteString -> Int -> Word8
unsafeIndex ByteString
s Int
i
                        in case Word8 -> Int
lenUTF8 Word8
c1 of
                            0 -> []
                            1 -> Word8 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi Word8
c1 Word32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
: Int -> Int -> ByteString -> [Word32]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Int
len ByteString
s
                            2 -> if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1 then [] else
                                  let c2 :: Word8
c2 = ByteString -> Int -> Word8
unsafeIndex ByteString
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
                                  in Word8 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi(Word8
c1Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.0x1f)Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`6
                                        Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor`Word8 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi(Word8
c2Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.0x3f)
                                          Word32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
: Int -> Int -> ByteString -> [Word32]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+2) Int
len ByteString
s
                            3 -> if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+2 then [] else
                                  let c2 :: Word8
c2 = ByteString -> Int -> Word8
unsafeIndex ByteString
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
                                      c3 :: Word8
c3 = ByteString -> Int -> Word8
unsafeIndex ByteString
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+2)
                                  in Word8 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi(Word8
c1Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.0x1f)Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`12
                                      Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor`Word8 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi(Word8
c2Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.0x3f)Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`6
                                        Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor`Word8 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi(Word8
c3Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.0x3f)
                                          Word32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
: Int -> Int -> ByteString -> [Word32]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+3) Int
len ByteString
s
                            4 -> if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+3 then [] else
                                  let c2 :: Word8
c2 = ByteString -> Int -> Word8
unsafeIndex ByteString
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
                                      c3 :: Word8
c3 = ByteString -> Int -> Word8
unsafeIndex ByteString
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+2)
                                      c4 :: Word8
c4 = ByteString -> Int -> Word8
unsafeIndex ByteString
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+3)
                                  in Word8 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi(Word8
c1Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.0x1f)Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`18
                                      Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor`Word8 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi(Word8
c2Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.0x3f)Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`12
                                        Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor`Word8 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi(Word8
c3Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.0x3f)Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL`6
                                          Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor`Word8 -> Word32
forall b a. (Num b, Integral a) => a -> b
fi(Word8
c4Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.0x3f)
                                            Word32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
: Int -> Int -> ByteString -> [Word32]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+4) Int
len ByteString
s

#endif

-----------------------------------------------------------------------------

w2c :: Word32 -> Char
{-# INLINE w2c #-}
#if defined(__GLASGOW_HASKELL__)
w2c :: Word32 -> Char
w2c (W32# w :: Word#
w) = Char# -> Char
C#(Int# -> Char#
chr#(Word# -> Int#
word2Int# Word#
w))
#else
w2c = unsafeChr . fromIntegral
#endif

c2w :: Char -> Word32
{-# INLINE c2w #-}
#if defined(__GLASGOW_HASKELL__)
c2w :: Char -> Word32
c2w (C# c :: Char#
c) = Word# -> Word32
W32#(Int# -> Word#
int2Word#(Char# -> Int#
ord# Char#
c))
#else
c2w = fromIntegral . ord
#endif

i2w :: Int -> Word32
{-# INLINE i2w #-}
#if defined(__GLASGOW_HASKELL__)
i2w :: Int -> Word32
i2w (I# i :: Int#
i) = Word# -> Word32
W32#(Int# -> Word#
int2Word# Int#
i)
#else
i2w = fi
#endif

w2i :: Word32 -> Int
{-# INLINE w2i #-}
#if defined(__GLASGOW_HASKELL__)
w2i :: Word32 -> Int
w2i (W32# w :: Word#
w) = Int# -> Int
I#(Word# -> Int#
word2Int# Word#
w)
#else
w2i = fi
#endif

-----------------------------------------------------------------------------

-- misc debug stuff

toBits :: Word8 -> [Word8]
toBits :: Word8 -> [Word8]
toBits w8 :: Word8
w8 = (Int -> Word8) -> [Int] -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.0x01) (Word8 -> Word8) -> (Int -> Word8) -> Int -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8
w8Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR`)) [7,6,5,4,3,2,1,0]

fromBits :: [Word8] -> Word8
fromBits :: [Word8] -> Word8
fromBits = (Word8 -> (Int, Word8) -> Word8)
-> Word8 -> [(Int, Word8)] -> Word8
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a :: Word8
a (n :: Int
n,b :: Word8
b) -> Word8
aWord8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|.Word8
bWord8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL`Int
n) 0
            ([(Int, Word8)] -> Word8)
-> ([Word8] -> [(Int, Word8)]) -> [Word8] -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Word8)] -> [(Int, Word8)]
forall a. [a] -> [a]
reverse ([(Int, Word8)] -> [(Int, Word8)])
-> ([Word8] -> [(Int, Word8)]) -> [Word8] -> [(Int, Word8)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Word8] -> [(Int, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..7] ([Word8] -> [(Int, Word8)])
-> ([Word8] -> [Word8]) -> [Word8] -> [(Int, Word8)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> [Word8]
forall a. [a] -> [a]
reverse

hexTab :: ByteString
hexTab :: ByteString
hexTab = [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (String -> [Word8]) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Word8
B.c2w (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
  "0123456789abcdef"

showHex :: Int -> String
showHex :: Int -> String
showHex i :: Int
i = ("0x"String -> String -> String
forall a. [a] -> [a] -> [a]
++)
  (String -> String)
-> ((Int -> Char) -> String) -> (Int -> Char) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> Char) -> [Int] -> String)
-> [Int] -> (Int -> Char) -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Char) -> [Int] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [28,24,20,16,12,8,4,0] ((Int -> Char) -> String) -> (Int -> Char) -> String
forall a b. (a -> b) -> a -> b
$ \n :: Int
n ->
    Word8 -> Char
B.w2c (ByteString -> Int -> Word8
unsafeIndex ByteString
hexTab (Int
iInt -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR`Int
nInt -> Int -> Int
forall a. Bits a => a -> a -> a
.&.0xf))

-----------------------------------------------------------------------------

-- now, for fun...

{- |
> ghci> putUTF8Ln $ flipUTF8 "[?np_bs!]"
> [¡sq‾bu¿]
-}
flipUTF8 :: (UTF8 a) => a -> a
flipUTF8 :: a -> a
flipUTF8 = ByteString -> a
forall a. UTF8 a => ByteString -> a
decode (ByteString -> a) -> (a -> ByteString) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> ByteString -> ByteString
flipString [(Int, Int)]
flipTab (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. UTF8 a => a -> ByteString
encode

{- |
> ghci> putUTF8Ln $ (unflipUTF8 . flipUTF8) "[?np_bs!]"
> [?np_bs!]
-}
unflipUTF8 :: (UTF8 a) => a -> a
unflipUTF8 :: a -> a
unflipUTF8 = ByteString -> a
forall a. UTF8 a => ByteString -> a
decode (ByteString -> a) -> (a -> ByteString) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> ByteString -> ByteString
flipString [(Int, Int)]
unflipTab (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. UTF8 a => a -> ByteString
encode

-- | Omits chars it doesn't know how to flip. Possibly
--  it's more desirable to just be id on such chars?
flipString :: [(Int,Int)] -> ByteString -> ByteString
flipString :: [(Int, Int)] -> ByteString -> ByteString
flipString tab :: [(Int, Int)]
tab = String -> ByteString
forall a. UTF8 a => a -> ByteString
encode
                  (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
                    (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char) -> [Int] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> (Int -> Char) -> Maybe Int -> Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ' ' Int -> Char
chr
                              (Maybe Int -> Char) -> (Int -> Maybe Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [(Int, Int)] -> Maybe Int)
-> [(Int, Int)] -> Int -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Int, Int)]
tab)
                      ([Int] -> String) -> (ByteString -> [Int]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Int]
forall a. UTF8 a => ByteString -> a
decode

unflipTab :: [(Int,Int)]
unflipTab :: [(Int, Int)]
unflipTab = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int -> (Int, Int)) -> (Int, Int) -> (Int, Int)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry((Int -> Int -> (Int, Int)) -> Int -> Int -> (Int, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip(,))) [(Int, Int)]
flipTab

flipTab :: [(Int,Int)]
flipTab :: [(Int, Int)]
flipTab = ((Char, Int) -> (Int, Int)) -> [(Char, Int)] -> [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a :: Char
a,b :: Int
b)->(Char -> Int
ord Char
a,Int
b))
  [('a', 0x250)
  ,('b', Char -> Int
ord 'q')
  ,('c', 0x254)
  ,('d', Char -> Int
ord 'p')
  ,('e', 0x1dd)
  ,('f', 0x25f)
  ,('g', 0x183)
  ,('h', 0x265)
  ,('i', 0x131)
  ,('j', 0x27e)
  ,('k', 0x29e)
  ,('l', Char -> Int
ord 'l')
  ,('m', 0x26f)
  ,('n', Char -> Int
ord 'u')
  ,('o', Char -> Int
ord 'o')
  ,('p', Char -> Int
ord 'b')
  ,('q', Char -> Int
ord 'd')
  ,('r', 0x279)
  ,('s', Char -> Int
ord 's')
  ,('t', 0x287)
  ,('u', Char -> Int
ord 'n')
  ,('v', 0x28c)
  ,('w', 0x28d)
  ,('x', Char -> Int
ord 'x')
  ,('y', 0x28e)
  ,('z', Char -> Int
ord 'z')
  ,('.', 0x2d9)
  ,('[', Char -> Int
ord ']')
  ,(']', Char -> Int
ord '[')
  ,('{', Char -> Int
ord '}')
  ,('}', Char -> Int
ord '{')
  ,('<', Char -> Int
ord '>')
  ,('>', Char -> Int
ord '<')
  ,('?', 0xbf)
  ,('!', 0xa1)
  ,('\'', Char -> Int
ord ',')
  ,('_', 0x203e)
  ,(';', 0x061b)
  ]

{-
ghci> mapM_ print . zip (fmap show [0..9] ++ fmap (:[]) ['a'..'f']) . fmap (drop 4 . toBits) $ [0..15]
("0",[0,0,0,0])
("1",[0,0,0,1])
("2",[0,0,1,0])
("3",[0,0,1,1])
("4",[0,1,0,0])
("5",[0,1,0,1])
("6",[0,1,1,0])
("7",[0,1,1,1])
("8",[1,0,0,0])
("9",[1,0,0,1])
("a",[1,0,1,0])
("b",[1,0,1,1])
("c",[1,1,0,0])
("d",[1,1,0,1])
("e",[1,1,1,0])
("f",[1,1,1,1])

class (Num a) => Bits a where
  (.&.) :: a -> a -> a
  (.|.) :: a -> a -> a
  xor :: a -> a -> a
  complement :: a -> a
  shift :: a -> Int -> a
  rotate :: a -> Int -> a
  bit :: Int -> a
  setBit :: a -> Int -> a
  clearBit :: a -> Int -> a
  complementBit :: a -> Int -> a
  testBit :: a -> Int -> Bool
  bitSize :: a -> Int
  isSigned :: a -> Bool
  shiftL :: a -> Int -> a
  shiftR :: a -> Int -> a
  rotateL :: a -> Int -> a
  rotateR :: a -> Int -> a

uncheckedIShiftL#   :: Int# -> Int# -> Int#
uncheckedIShiftRA#  :: Int# -> Int# -> Int#
uncheckedIShiftRL#  :: Int# -> Int# -> Int#
uncheckedShiftL#    :: Word# -> Int# -> Word#
uncheckedShiftRL#   :: Word# -> Int# -> Word#
-}



{-
data Char#
gtChar# :: Char# -> Char# -> Bool
geChar# :: Char# -> Char# -> Bool
eqChar# :: Char# -> Char# -> Bool
neChar# :: Char# -> Char# -> Bool
ltChar# :: Char# -> Char# -> Bool
leChar# :: Char# -> Char# -> Bool
ord# :: Char# -> Int#

data Int#
(+#) :: Int# -> Int# -> Int#
(-#) :: Int# -> Int# -> Int#
(*#) :: Int# -> Int# -> Int#
(>#) :: Int# -> Int# -> Bool
(>=#) :: Int# -> Int# -> Bool
(==#) :: Int# -> Int# -> Bool
(/=#) :: Int# -> Int# -> Bool
(<#) :: Int# -> Int# -> Bool
(<=#) :: Int# -> Int# -> Bool
chr# :: Int# -> Char#
int2Word# :: Int# -> Word#
uncheckedIShiftL# :: Int# -> Int# -> Int#
uncheckedIShiftRA# :: Int# -> Int# -> Int#
uncheckedIShiftRL# :: Int# -> Int# -> Int#

data Word#
plusWord# :: Word# -> Word# -> Word#
minusWord# :: Word# -> Word# -> Word#
timesWord# :: Word# -> Word# -> Word#
and# :: Word# -> Word# -> Word#
or# :: Word# -> Word# -> Word#
xor# :: Word# -> Word# -> Word#
not# :: Word# -> Word#
uncheckedShiftL# :: Word# -> Int# -> Word#
uncheckedShiftRL# :: Word# -> Int# -> Word#
word2Int# :: Word# -> Int#
gtWord# :: Word# -> Word# -> Bool
geWord# :: Word# -> Word# -> Bool
eqWord# :: Word# -> Word# -> Bool
neWord# :: Word# -> Word# -> Bool
ltWord# :: Word# -> Word# -> Bool
leWord# :: Word# -> Word# -> Bool
narrow8Int# :: Int# -> Int#
narrow16Int# :: Int# -> Int#
narrow32Int# :: Int# -> Int#
narrow8Word# :: Word# -> Word#
narrow16Word# :: Word# -> Word#
narrow32Word# :: Word# -> Word#

data MutByteArr# s
newByteArray# :: Int# -> State# s -> (#State# s, MutByteArr# s#)
newPinnedByteArray# :: Int# -> State# s -> (#State# s, MutByteArr# s#)
byteArrayContents# :: ByteArr# -> Addr#
sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool
unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (#State# s, ByteArr##)
sizeofByteArray# :: ByteArr# -> Int#
sizeofMutableByteArray# :: MutByteArr# s -> Int#
indexCharArray# :: ByteArr# -> Int# -> Char#
indexWideCharArray# :: ByteArr# -> Int# -> Char#
indexIntArray# :: ByteArr# -> Int# -> Int#
indexWordArray# :: ByteArr# -> Int# -> Word#
indexAddrArray# :: ByteArr# -> Int# -> Addr#
indexInt8Array# :: ByteArr# -> Int# -> Int#
indexInt16Array# :: ByteArr# -> Int# -> Int#
indexInt32Array# :: ByteArr# -> Int# -> Int#
indexInt64Array# :: ByteArr# -> Int# -> Int#
indexWord8Array# :: ByteArr# -> Int# -> Word#
indexWord16Array# :: ByteArr# -> Int# -> Word#
indexWord32Array# :: ByteArr# -> Int# -> Word#
indexWord64Array# :: ByteArr# -> Int# -> Word#
readCharArray# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Char##)
readWideCharArray# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Char##)
readIntArray# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Int##)
readWordArray# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Word##)
readAddrArray# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Addr##)
readInt8Array# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Int##)
readInt16Array# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Int##)
readInt32Array# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Int##)
readInt64Array# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Int##)
readWord8Array# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Word##)
readWord16Array# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Word##)
readWord32Array# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Word##)
readWord64Array# :: MutByteArr# s -> Int# -> State# s -> (#State# s, Word##)
writeCharArray# :: MutByteArr# s -> Int# -> Char# -> State# s -> State# s
writeWideCharArray# :: MutByteArr# s -> Int# -> Char# -> State# s -> State# s
writeIntArray# :: MutByteArr# s -> Int# -> Int# -> State# s -> State# s
writeWordArray# :: MutByteArr# s -> Int# -> Word# -> State# s -> State# s
writeAddrArray# :: MutByteArr# s -> Int# -> Addr# -> State# s -> State# s
writeInt8Array# :: MutByteArr# s -> Int# -> Int# -> State# s -> State# s
writeInt16Array# :: MutByteArr# s -> Int# -> Int# -> State# s -> State# s
writeInt32Array# :: MutByteArr# s -> Int# -> Int# -> State# s -> State# s
writeInt64Array# :: MutByteArr# s -> Int# -> Int# -> State# s -> State# s
writeWord8Array# :: MutByteArr# s -> Int# -> Word# -> State# s -> State# s
writeWord16Array# :: MutByteArr# s -> Int# -> Word# -> State# s -> State# s
writeWord32Array# :: MutByteArr# s -> Int# -> Word# -> State# s -> State# s
writeWord64Array# :: MutByteArr# s -> Int# -> Word# -> State# s -> State# s

data Addr#
nullAddr# :: Addr#
plusAddr# :: Addr# -> Int# -> Addr#
minusAddr# :: Addr# -> Addr# -> Int#
remAddr# :: Addr# -> Int# -> Int#
addr2Int# :: Addr# -> Int#
int2Addr# :: Int# -> Addr#
gtAddr# :: Addr# -> Addr# -> Bool
geAddr# :: Addr# -> Addr# -> Bool
eqAddr# :: Addr# -> Addr# -> Bool
neAddr# :: Addr# -> Addr# -> Bool
ltAddr# :: Addr# -> Addr# -> Bool
leAddr# :: Addr# -> Addr# -> Bool
indexCharOffAddr# :: Addr# -> Int# -> Char#
indexWideCharOffAddr# :: Addr# -> Int# -> Char#
indexIntOffAddr# :: Addr# -> Int# -> Int#
indexWordOffAddr# :: Addr# -> Int# -> Word#
indexAddrOffAddr# :: Addr# -> Int# -> Addr#
indexInt8OffAddr# :: Addr# -> Int# -> Int#
indexInt16OffAddr# :: Addr# -> Int# -> Int#
indexInt32OffAddr# :: Addr# -> Int# -> Int#
indexInt64OffAddr# :: Addr# -> Int# -> Int#
indexWord8OffAddr# :: Addr# -> Int# -> Word#
indexWord16OffAddr# :: Addr# -> Int# -> Word#
indexWord32OffAddr# :: Addr# -> Int# -> Word#
indexWord64OffAddr# :: Addr# -> Int# -> Word#
readCharOffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Char##)
readWideCharOffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Char##)
readIntOffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Int##)
readWordOffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Word##)
readAddrOffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Addr##)
readInt8OffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Int##)
readInt16OffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Int##)
readInt32OffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Int##)
readInt64OffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Int##)
readWord8OffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Word##)
readWord16OffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Word##)
readWord32OffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Word##)
readWord64OffAddr# :: Addr# -> Int# -> State# s -> (#State# s, Word##)
writeCharOffAddr# :: Addr# -> Int# -> Char# -> State# s -> State# s
writeWideCharOffAddr# :: Addr# -> Int# -> Char# -> State# s -> State# s
writeIntOffAddr# :: Addr# -> Int# -> Int# -> State# s -> State# s
writeWordOffAddr# :: Addr# -> Int# -> Word# -> State# s -> State# s
writeAddrOffAddr# :: Addr# -> Int# -> Addr# -> State# s -> State# s
writeInt8OffAddr# :: Addr# -> Int# -> Int# -> State# s -> State# s
writeInt16OffAddr# :: Addr# -> Int# -> Int# -> State# s -> State# s
writeInt32OffAddr# :: Addr# -> Int# -> Int# -> State# s -> State# s
writeInt64OffAddr# :: Addr# -> Int# -> Int# -> State# s -> State# s
writeWord8OffAddr# :: Addr# -> Int# -> Word# -> State# s -> State# s
writeWord16OffAddr# :: Addr# -> Int# -> Word# -> State# s -> State# s
writeWord32OffAddr# :: Addr# -> Int# -> Word# -> State# s -> State# s
writeWord64OffAddr# :: Addr# -> Int# -> Word# -> State# s -> State# s

data State# s
data RealWorld

dataToTag# :: a -> Int#
tagToEnum# :: Int# -> a

reallyUnsafePtrEquality# :: a -> a -> Int#

data BCO#
addrToHValue# :: Addr# -> (#a#)
mkApUpd0# :: BCO# -> (#a#)
newBCO# :: ByteArr# -> ByteArr# -> Array# a -> Int# -> ByteArr# -> State# s -> (#State# s, BCO##)
unpackClosure# :: a -> (#Addr#, Array# b, ByteArr##)
getApStackVal# :: a -> Int# -> (#Int#, b#)
seq :: a -> b -> b
inline :: a -> a
lazy :: a -> a

data Any a
unsafeCoerce# :: a -> b



--------GHC.Exts

data Int = I# Int#
data Word = W# Word#

data Char = C# Char#
data Ptr a = Ptr Addr#
data FunPtr a = FunPtr Addr#

shiftL# :: Word# -> Int# -> Word#
shiftRL# :: Word# -> Int# -> Word#
iShiftL# :: Int# -> Int# -> Int#
iShiftRA# :: Int# -> Int# -> Int#
iShiftRL# :: Int# -> Int# -> Int#
-}