{-# language BangPatterns #-}
{-# language DataKinds #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}

-- This provides an interface to bytearrays in which every
-- boolean is represented by a single bit.
module Basics.BitBool
  ( -- Types
    T
  , T#
  , R
    -- Lifting
  , lift
  , unlift
    -- Compare
  , eq#
  , neq#
    -- Array
  , read#
  , write#
  , index#
  , set#
  , uninitialized#
  , initialized#
  , copy#
  , copyMutable#
  , shrink#
    -- Constants
  , def
    -- Encoding
  , shows
  ) where

import Prelude hiding (shows)

import GHC.Exts ((+#),(-#),(*#),(==#),(<#),isTrue#)
import GHC.Exts (Int#,State#,MutableByteArray#,ByteArray#)
import GHC.Exts (RuntimeRep(IntRep))
import GHC.Exts (andI#,orI#,notI#,iShiftL#,iShiftRL#)

import qualified Prelude
import qualified GHC.Exts as Exts

type T = Bool
type T# = Int#
type R = 'IntRep

def :: T
{-# inline def #-}
def :: T
def = T
False

lift :: T# -> T
{-# inline lift #-}
lift :: T# -> T
lift T#
x = forall a. T# -> a
Exts.tagToEnum# T#
x :: Bool

unlift :: T -> T#
{-# inline unlift #-}
unlift :: T -> T#
unlift = \case
  T
True -> T#
1#
  T
False -> T#
0#

eq# :: Int# -> Int# -> Int#
{-# inline eq# #-}
eq# :: T# -> T# -> T#
eq# = T# -> T# -> T#
(==#)

neq# :: Int# -> Int# -> Int#
{-# inline neq# #-}
neq# :: T# -> T# -> T#
neq# = T# -> T# -> T#
(Exts./=#)

splitIndex_ :: Int# -> (# Int#, Int# #)
{-# inline splitIndex_ #-}
splitIndex_ :: T# -> (# T#, T# #)
splitIndex_ T#
bitIx = (# T#
wordIx, T#
intraWordIx #)
  where
  wordIx :: T#
wordIx = T#
bitIx T# -> T# -> T#
`iShiftRL#` T#
6#
  intraWordIx :: T#
intraWordIx = T#
bitIx T# -> T# -> T#
`andI#` T#
0x3F#

index# :: ByteArray# -> Int# -> T#
{-# inline index# #-}
index# :: ByteArray# -> T# -> T#
index# ByteArray#
arr T#
i =
  let !(# T#
wordIx, T#
intraWordIx #) = T# -> (# T#, T# #)
splitIndex_ T#
i
      !bitBundle :: T#
bitBundle = ByteArray# -> T# -> T#
Exts.indexInt64Array# ByteArray#
arr T#
wordIx
      !bit :: T#
bit = T#
bitBundle T# -> T# -> T#
`andI#` (T#
1# T# -> T# -> T#
`iShiftL#` T#
intraWordIx)
   in T#
bit T# -> T# -> T#
`iShiftRL#` T#
intraWordIx

read# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, T# #)
{-# inline read# #-}
read# :: forall s.
MutableByteArray# s -> T# -> State# s -> (# State# s, T# #)
read# MutableByteArray# s
arr T#
i State# s
st =
  let !(# T#
wordIx, T#
intraWordIx #) = T# -> (# T#, T# #)
splitIndex_ T#
i
      !(# State# s
st', T#
bitBundle #) = forall s.
MutableByteArray# s -> T# -> State# s -> (# State# s, T# #)
Exts.readInt64Array# MutableByteArray# s
arr T#
wordIx State# s
st
      !bit :: T#
bit = T#
bitBundle T# -> T# -> T#
`andI#` (T#
1# T# -> T# -> T#
`iShiftL#` T#
intraWordIx)
   in (# State# s
st', T#
bit T# -> T# -> T#
`iShiftRL#` T#
intraWordIx #)

write# :: MutableByteArray# s -> Int# -> T# -> State# s -> State# s
{-# inline write# #-}
write# :: forall s. MutableByteArray# s -> T# -> T# -> State# s -> State# s
write# MutableByteArray# s
arr T#
i T#
v State# s
st =
  let !(# T#
wordIx, T#
intraWordIx #) = T# -> (# T#, T# #)
splitIndex_ T#
i
      !(# State# s
st', T#
bitBundle #) = forall s.
MutableByteArray# s -> T# -> State# s -> (# State# s, T# #)
Exts.readInt64Array# MutableByteArray# s
arr T#
wordIx State# s
st
      !mask :: T#
mask = T# -> T#
notI# (T#
1# T# -> T# -> T#
`iShiftL#` T#
intraWordIx)
      !bitBundle' :: T#
bitBundle' = (T#
bitBundle T# -> T# -> T#
`andI#` T#
mask) T# -> T# -> T#
`orI#` (T#
v T# -> T# -> T#
`iShiftL#` T#
intraWordIx)
   in forall s. MutableByteArray# s -> T# -> T# -> State# s -> State# s
Exts.writeInt64Array# MutableByteArray# s
arr T#
wordIx T#
bitBundle' State# s
st'

set# :: MutableByteArray# s -> Int# -> Int# -> T# -> State# s -> State# s
{-# inline set# #-}
set# :: forall s.
MutableByteArray# s -> T# -> T# -> T# -> State# s -> State# s
set# MutableByteArray# s
arr T#
off0 T#
len0 T#
v State# s
st0 =
    let subOff :: T#
subOff = T#
off0 T# -> T# -> T#
`andI#` T#
7#
      -- set non-byte-aligned, initial bits
        len :: T#
len = T# -> T# -> T#
min# T#
len0 (T#
8# T# -> T# -> T#
-# T#
subOff)
        st' :: State# s
st' = T# -> T# -> State# s -> State# s
bitLoop T#
off0 T#
len State# s
st0
        -- set full bytes
        off' :: T#
off' = T#
off0 T# -> T# -> T#
+# T#
len
        len' :: T#
len' = T#
len0 T# -> T# -> T#
-# T#
len
        st'' :: State# s
st'' = T# -> T# -> State# s -> State# s
writeBytes T#
off' T#
len' State# s
st'
        -- set trailing bits smaller than a byte
        off'' :: T#
off'' = T#
off' T# -> T# -> T#
+# ((T#
len' T# -> T# -> T#
`iShiftRL#` T#
3#) T# -> T# -> T#
`iShiftL#` T#
3#)
        len'' :: T#
len'' = T#
len' T# -> T# -> T#
`andI#` T#
7#
     in T# -> T# -> State# s -> State# s
bitLoop T#
off'' T#
len'' State# s
st''
  where
  -- TODO could split bitLoop into writeBitsUnaligned and writeBitsAligned, which would use masking instead of a loop
  bitLoop :: T# -> T# -> State# s -> State# s
bitLoop T#
_ T#
0# State# s
st = State# s
st
  bitLoop T#
off T#
len State# s
st =
    let st' :: State# s
st' = forall s. MutableByteArray# s -> T# -> T# -> State# s -> State# s
write# MutableByteArray# s
arr T#
off T#
v State# s
st
     in T# -> T# -> State# s -> State# s
bitLoop (T#
off T# -> T# -> T#
+# T#
1#) (T#
len T# -> T# -> T#
-# T#
1#) State# s
st'
  writeBytes :: T# -> T# -> State# s -> State# s
writeBytes T#
off T#
len State# s
st =
    let !offB :: T#
offB = T#
off T# -> T# -> T#
`iShiftRL#` T#
3#
        !lenB :: T#
lenB = T#
len T# -> T# -> T#
`iShiftRL#` T#
3#
     in forall s.
MutableByteArray# s -> T# -> T# -> T# -> State# s -> State# s
Exts.setByteArray# MutableByteArray# s
arr T#
offB T#
lenB T#
vB State# s
st
  vB :: T#
vB = if T# -> T
isTrue# T#
v then T#
0xFF# else T#
0#

shrink# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
{-# inline shrink# #-}
shrink# :: forall s.
MutableByteArray# s
-> T# -> State# s -> (# State# s, MutableByteArray# s #)
shrink# MutableByteArray# s
marr T#
sz State# s
st =
  let !(# T#
wordSz, T#
subWordSz #) = T# -> (# T#, T# #)
splitIndex_ T#
sz
      !paddedSz :: T#
paddedSz = T#
wordSz T# -> T# -> T#
+# if T# -> T
isTrue# (T#
subWordSz T# -> T# -> T#
==# T#
0#) then T#
0# else T#
1#
      !szBytes :: T#
szBytes = T#
paddedSz T# -> T# -> T#
*# T#
8#
      !st' :: State# s
st' = forall d. MutableByteArray# d -> T# -> State# d -> State# d
Exts.shrinkMutableByteArray# MutableByteArray# s
marr T#
szBytes State# s
st
   in (# State# s
st', MutableByteArray# s
marr #)

uninitialized# :: Int# -> State# s -> (# State# s, MutableByteArray# s #)
{-# inline uninitialized# #-}
uninitialized# :: forall s. T# -> State# s -> (# State# s, MutableByteArray# s #)
uninitialized# T#
sz State# s
st =
  let !(# T#
wordSz, T#
subWordSz #) = T# -> (# T#, T# #)
splitIndex_ T#
sz
      !paddedSz :: T#
paddedSz = T#
wordSz T# -> T# -> T#
+# if T# -> T
isTrue# (T#
subWordSz T# -> T# -> T#
==# T#
0#) then T#
0# else T#
1#
      !szBytes :: T#
szBytes = T#
paddedSz T# -> T# -> T#
*# T#
8#
   in forall s. T# -> State# s -> (# State# s, MutableByteArray# s #)
Exts.newByteArray# T#
szBytes State# s
st

initialized# :: Int# -> T# -> State# s -> (# State# s, MutableByteArray# s #)
{-# inline initialized# #-}
initialized# :: forall s.
T# -> T# -> State# s -> (# State# s, MutableByteArray# s #)
initialized# T#
sz T#
v0 State# s
st =
  let !(# T#
wordSz, T#
subWordSz #) = T# -> (# T#, T# #)
splitIndex_ T#
sz
      !paddedSz :: T#
paddedSz = T#
wordSz T# -> T# -> T#
+# if T# -> T
isTrue# (T#
subWordSz T# -> T# -> T#
==# T#
0#) then T#
0# else T#
1#
      !szBytes :: T#
szBytes = T#
paddedSz T# -> T# -> T#
*# T#
8#
      !(# State# s
st', MutableByteArray# s
marr #) = forall s. T# -> State# s -> (# State# s, MutableByteArray# s #)
Exts.newByteArray# T#
szBytes State# s
st
      !v :: T#
v = if T# -> T
isTrue# T#
v0 then T#
0xFF# else T#
0#
   in (# forall s.
MutableByteArray# s -> T# -> T# -> T# -> State# s -> State# s
Exts.setByteArray# MutableByteArray# s
marr T#
0# T#
szBytes T#
v State# s
st', MutableByteArray# s
marr #)

copy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s
{-# inline copy# #-}
copy# :: forall s.
MutableByteArray# s
-> T# -> ByteArray# -> T# -> T# -> State# s -> State# s
copy# MutableByteArray# s
dst T#
0# ByteArray#
src T#
0# T#
len State# s
st =
-- TODO when soff == doff, we can do like set#
-- first align with naiveCopy, then copy by bytes, then copy the traling bits with naiveCopy
-- in fact, this can work even when soff - doff divisible by 8
  let !lenB :: T#
lenB = T#
len T# -> T# -> T#
`iShiftRL#` T#
3#
      !st' :: State# s
st' = forall d.
ByteArray#
-> T# -> MutableByteArray# d -> T# -> T# -> State# d -> State# d
Exts.copyByteArray# ByteArray#
src T#
0# MutableByteArray# s
dst T#
0# T#
lenB State# s
st
      !off' :: T#
off' = T#
lenB T# -> T# -> T#
`iShiftL#` T#
3#
      !len' :: T#
len' = T#
len T# -> T# -> T#
`andI#` T#
7#
   in forall s.
MutableByteArray# s
-> T# -> ByteArray# -> T# -> T# -> State# s -> State# s
naiveCopy# MutableByteArray# s
dst T#
off' ByteArray#
src T#
off' T#
len' State# s
st'
copy# MutableByteArray# s
dst T#
doff ByteArray#
src T#
soff T#
len State# s
st = forall s.
MutableByteArray# s
-> T# -> ByteArray# -> T# -> T# -> State# s -> State# s
naiveCopy# MutableByteArray# s
dst T#
doff ByteArray#
src T#
soff T#
len State# s
st

naiveCopy# :: MutableByteArray# s -> Int# -> ByteArray# -> Int# -> Int# -> State# s -> State# s
-- TODO if I had an index64 :: ByteArray# -> off:Int#  -> len:Int# -> Int#
-- that reads up to `min len 64` unaligned bits starting at off
-- then I could write whole words at a time after aligning the doff, just as in set#
naiveCopy# :: forall s.
MutableByteArray# s
-> T# -> ByteArray# -> T# -> T# -> State# s -> State# s
naiveCopy# MutableByteArray# s
_ T#
_ ByteArray#
_ T#
_ T#
0# State# s
st = State# s
st
naiveCopy# MutableByteArray# s
dst T#
doff ByteArray#
src T#
soff T#
len State# s
st =
  let !v :: T#
v = ByteArray# -> T# -> T#
index# ByteArray#
src T#
soff
      !st' :: State# s
st' = forall s. MutableByteArray# s -> T# -> T# -> State# s -> State# s
write# MutableByteArray# s
dst T#
doff T#
v State# s
st
   in forall s.
MutableByteArray# s
-> T# -> ByteArray# -> T# -> T# -> State# s -> State# s
naiveCopy# MutableByteArray# s
dst (T#
doff T# -> T# -> T#
+# T#
1#) ByteArray#
src (T#
soff T# -> T# -> T#
+# T#
1#) (T#
len T# -> T# -> T#
-# T#
1#) State# s
st'

copyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
{-# inline copyMutable# #-}
copyMutable# :: forall s.
MutableByteArray# s
-> T# -> MutableByteArray# s -> T# -> T# -> State# s -> State# s
copyMutable# MutableByteArray# s
dst T#
0# MutableByteArray# s
src T#
0# T#
len State# s
st =
-- TODO when soff == doff, we can do like set#
-- first align with naiveCopyMutable, then copy by bytes, then copy the traling bits with naiveCopyMutable
-- in fact, this can work even when soff - doff divisible by 8
  let !lenB :: T#
lenB = T#
len T# -> T# -> T#
`iShiftRL#` T#
3#
      !st' :: State# s
st' = forall s.
MutableByteArray# s
-> T# -> MutableByteArray# s -> T# -> T# -> State# s -> State# s
Exts.copyMutableByteArray# MutableByteArray# s
src T#
0# MutableByteArray# s
dst T#
0# T#
lenB State# s
st
      !off' :: T#
off' = T#
lenB T# -> T# -> T#
`iShiftL#` T#
3#
      !len' :: T#
len' = T#
len T# -> T# -> T#
`andI#` T#
7#
   in forall s.
MutableByteArray# s
-> T# -> MutableByteArray# s -> T# -> T# -> State# s -> State# s
naiveCopyMutable# MutableByteArray# s
dst T#
off' MutableByteArray# s
src T#
off' T#
len' State# s
st'
copyMutable# MutableByteArray# s
dst T#
doff MutableByteArray# s
src T#
soff T#
len State# s
st = forall s.
MutableByteArray# s
-> T# -> MutableByteArray# s -> T# -> T# -> State# s -> State# s
naiveCopyMutable# MutableByteArray# s
dst T#
doff MutableByteArray# s
src T#
soff T#
len State# s
st

naiveCopyMutable# :: MutableByteArray# s -> Int# -> MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
-- TODO if I had an index64 :: ByteArray# -> off:Int#  -> len:Int# -> Int#
-- that reads up to `min len 64` unaligned bits starting at off
-- then I could write whole words at a time after aligning the doff, just as in set#
naiveCopyMutable# :: forall s.
MutableByteArray# s
-> T# -> MutableByteArray# s -> T# -> T# -> State# s -> State# s
naiveCopyMutable# MutableByteArray# s
_ T#
_ MutableByteArray# s
_ T#
_ T#
0# State# s
st = State# s
st
naiveCopyMutable# MutableByteArray# s
dst T#
doff MutableByteArray# s
src T#
soff T#
len State# s
st =
  let !(# State# s
st', T#
v #) = forall s.
MutableByteArray# s -> T# -> State# s -> (# State# s, T# #)
read# MutableByteArray# s
src T#
soff State# s
st
      !st'' :: State# s
st'' = forall s. MutableByteArray# s -> T# -> T# -> State# s -> State# s
write# MutableByteArray# s
dst T#
doff T#
v State# s
st'
   in forall s.
MutableByteArray# s
-> T# -> MutableByteArray# s -> T# -> T# -> State# s -> State# s
naiveCopyMutable# MutableByteArray# s
dst (T#
doff T# -> T# -> T#
+# T#
1#) MutableByteArray# s
src (T#
soff T# -> T# -> T#
+# T#
1#) (T#
len T# -> T# -> T#
-# T#
1#) State# s
st''

shows :: T -> String -> String
shows :: T -> String -> String
shows = forall a. Show a => a -> String -> String
Prelude.shows

min# :: Int# -> Int# -> Int#
{-# inline min# #-}
min# :: T# -> T# -> T#
min# T#
a T#
b = if T# -> T
isTrue# (T#
a T# -> T# -> T#
<# T#
b) then T#
a else T#
b