{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedNewtypes #-}
{-# LANGUAGE BlockArguments #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Internal.Unicode.Bits
-- Copyright   : (c) 2020 Andrew Lelechenko
--               (c) 2020 Composewell Technologies
-- License     : BSD-3-Clause
--
-- Maintainer  :  streamly@composewell.com
-- Stability   :  internal
-- Portability :  non-portable (GHC extensions)
--
-- Fast, static bitmap lookup utilities
--
-----------------------------------------------------------------------------

module GHC.Internal.Unicode.Bits
    ( lookupIntN
    , lookupBit64
    , newByteArrayFromWord8List
    , byteArrayLookupIntN
    , copyAddrToWord8List
    , UnicodeByteArray
    )
    where

import GHC.Internal.Bits (finiteBitSize, popCount)
import {-# SOURCE #-} GHC.Internal.ByteOrder
import GHC.Prim
import GHC.Internal.ST
import GHC.Internal.Base
import GHC.Internal.Num
import GHC.Internal.List
import GHC.Internal.Word

-- | @lookup64 addr index@ looks up the bit stored at bit index @index@ using a
-- bitmap starting at the address @addr@. Looks up the 64-bit word containing
-- the bit and then the bit in that word. The caller must make sure that the
-- 64-bit word at the byte address (addr + index / 64) * 8 is legally
-- accessible memory.
--
lookupBit64 :: Addr# -> Int -> Bool
lookupBit64 :: Addr# -> Int -> Bool
lookupBit64 Addr#
addr# (I# Int#
index#) = Word# -> Word
W# (Word#
word## Word# -> Word# -> Word#
`and#` Word#
bitMask##) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0
  where
    !fbs :: Int
fbs@(I# Int#
fbs#) = Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    !(I# Int#
logFbs#) = case Int
fbs of
      Int
31 -> Int
5
      Int
63 -> Int
6
      Int
_  -> Int -> Int
forall a. Bits a => a -> Int
popCount Int
fbs -- this is a really weird architecture

    wordIndex# :: Int#
wordIndex# = Int#
index# Int# -> Int# -> Int#
`uncheckedIShiftRL#` Int#
logFbs#
    word## :: Word#
word## = case ByteOrder
targetByteOrder of
      ByteOrder
BigEndian    -> Word# -> Word#
byteSwap# (Addr# -> Int# -> Word#
indexWordOffAddr# Addr#
addr# Int#
wordIndex#)
      ByteOrder
LittleEndian -> Addr# -> Int# -> Word#
indexWordOffAddr# Addr#
addr# Int#
wordIndex#
    bitIndex# :: Int#
bitIndex# = Int#
index# Int# -> Int# -> Int#
`andI#` Int#
fbs#
    bitMask## :: Word#
bitMask## = Word#
1## Word# -> Int# -> Word#
`uncheckedShiftL#` Int#
bitIndex#

{-| @lookupIntN addr index@ looks up for the @index@-th @8@-bits word in
the bitmap starting at @addr@, then convert it to an Int.

The caller must make sure that:

* @ceiling (addr + (n * 8))@ is legally accessible @Word8@.

@since base-0.3.0
-}
lookupIntN
  :: Addr# -- ^ Bitmap address
  -> Int   -- ^ Word index
  -> Int   -- ^ Resulting word as 'Int'
lookupIntN :: Addr# -> Int -> Int
lookupIntN Addr#
addr# (I# Int#
index#) =
  let word## :: Word#
word## = Word8# -> Word#
word8ToWord# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
addr# Int#
index#)
  in Int# -> Int
I# (Word# -> Int#
word2Int# Word#
word##)

data UnicodeByteArray = UnicodeByteArray !ByteArray#

byteArrayLookupIntN :: UnicodeByteArray -> Int -> Int
byteArrayLookupIntN :: UnicodeByteArray -> Int -> Int
byteArrayLookupIntN UnicodeByteArray
ba Int
idx
  = let !(UnicodeByteArray ByteArray#
addr) = UnicodeByteArray
ba
  in Addr# -> Int -> Int
lookupIntN (ByteArray# -> Addr#
byteArrayContents# ByteArray#
addr) Int
idx

newByteArrayFromWord8List :: [Word8] -> UnicodeByteArray
newByteArrayFromWord8List :: [Word8] -> UnicodeByteArray
newByteArrayFromWord8List [Word8]
xs = (forall s. ST s UnicodeByteArray) -> UnicodeByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s UnicodeByteArray) -> UnicodeByteArray)
-> (forall s. ST s UnicodeByteArray) -> UnicodeByteArray
forall a b. (a -> b) -> a -> b
$ STRep s UnicodeByteArray -> ST s UnicodeByteArray
forall s a. STRep s a -> ST s a
ST \State# s
s0 ->
  case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# Int#
len State# s
s0 of
    !(# State# s
s1, MutableByteArray# s
mba #) ->
      let s2 :: State# s
s2 = MutableByteArray# s -> Int# -> [Word8] -> State# s -> State# s
forall {d}.
MutableByteArray# d -> Int# -> [Word8] -> State# d -> State# d
fillByteArray MutableByteArray# s
mba Int#
0# [Word8]
xs State# s
s1
      in case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s2 of
        !(# State# s
s3, ByteArray#
fba #) -> (# State# s
s3, ByteArray# -> UnicodeByteArray
UnicodeByteArray ByteArray#
fba #)
  where
    !(I# Int#
len) = [Word8] -> Int
forall a. [a] -> Int
length [Word8]
xs

    fillByteArray :: MutableByteArray# d -> Int# -> [Word8] -> State# d -> State# d
fillByteArray MutableByteArray# d
_ Int#
_ [] State# d
s = State# d
s
    fillByteArray MutableByteArray# d
mba Int#
i (Word8
y:[Word8]
ys) State# d
s =
      let !(W8# Word8#
y#) = Word8
y
          s' :: State# d
s' = MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
forall d.
MutableByteArray# d -> Int# -> Word8# -> State# d -> State# d
writeWord8Array# MutableByteArray# d
mba Int#
i Word8#
y# State# d
s
      in MutableByteArray# d -> Int# -> [Word8] -> State# d -> State# d
fillByteArray MutableByteArray# d
mba (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [Word8]
ys State# d
s'

copyAddrToWord8List :: Addr# -> Int -> [Word8]
copyAddrToWord8List :: Addr# -> Int -> [Word8]
copyAddrToWord8List Addr#
addr !len :: Int
len@(I# Int#
len') = (forall s. ST s [Word8]) -> [Word8]
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s [Word8]) -> [Word8])
-> (forall s. ST s [Word8]) -> [Word8]
forall a b. (a -> b) -> a -> b
$ STRep s [Word8] -> ST s [Word8]
forall s a. STRep s a -> ST s a
ST \State# s
s0 ->
  case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
len' State# s
s0 of
    !(# State# s
s1, MutableByteArray# s
mba #) ->
      let s2 :: State# s
s2 = Addr#
-> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
addr MutableByteArray# s
mba Int#
0# Int#
len' State# s
s1
      in case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s2 of
        !(# State# s
s3, ByteArray#
fba #) -> (# State# s
s3, ByteArray# -> Int -> Int -> [Word8]
readByteFromArray ByteArray#
fba Int
0 Int
len #)
  where
    readByteFromArray :: ByteArray# -> Int -> Int -> [Word8]
    readByteFromArray :: ByteArray# -> Int -> Int -> [Word8]
readByteFromArray ByteArray#
ba !from :: Int
from@(I# Int#
from') Int
to =
      Word8# -> Word8
W8# (ByteArray# -> Int# -> Word8#
indexWord8Array# ByteArray#
ba Int#
from') Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:
        if Int
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
to Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          then []
          else ByteArray# -> Int -> Int -> [Word8]
readByteFromArray ByteArray#
ba (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
to