{-# language BangPatterns #-}
{-# language MagicHash #-}
{-# language RankNTypes #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language TypeInType #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneKindSignatures #-}
{-# language UnboxedTuples #-}

module Lifted
  ( R
  , A#
  , ArrayRep
  , M#
  , empty#
  , index#
  , write#
  , read#
  , unsafeFreeze#
  , uninitialized#
  , initialized#
  , set#
  , unsafeShrinkFreeze#
  , thaw#
  , freeze#
  , copy#
  ) where

import GHC.Exts
import Data.Kind (Type)
import Data.Primitive (SmallArray(..),SmallMutableArray(..))

import qualified GHC.Exts as Exts

type ArrayRep = 'BoxedRep 'Unlifted
type R = 'BoxedRep 'Lifted

type A# :: TYPE ('BoxedRep 'Lifted) -> TYPE ('BoxedRep 'Unlifted)
type A# = SmallArray#

type M# :: Type -> TYPE ('BoxedRep 'Lifted) -> TYPE ('BoxedRep 'Unlifted)
type M# = SmallMutableArray#

index# :: forall (a :: TYPE R). A# a -> Int# -> a
index# :: forall (a :: TYPE R). A# a -> Int# -> a
index# A# a
a Int#
i = case A# a -> Int# -> (# a #)
forall a. SmallArray# a -> Int# -> (# a #)
indexSmallArray# A# a
a Int#
i of
  (# a
r #) -> a
r

write# :: forall (s :: Type) (a :: TYPE R).
  M# s a -> Int# -> a -> State# s -> State# s
write# :: forall (s :: TYPE R) (a :: TYPE R).
M# s a -> Int# -> a -> State# s -> State# s
write# = SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
forall (d :: TYPE R) a.
SmallMutableArray# d a -> Int# -> a -> State# d -> State# d
writeSmallArray#

read# :: forall (s :: Type) (a :: TYPE R).
  M# s a -> Int# -> State# s -> (# State# s, a #)
read# :: forall (s :: TYPE R) (a :: TYPE R).
M# s a -> Int# -> State# s -> (# State# s, a #)
read# = SmallMutableArray# s a -> Int# -> State# s -> (# State# s, a #)
forall (d :: TYPE R) a.
SmallMutableArray# d a -> Int# -> State# d -> (# State# d, a #)
readSmallArray#


unsafeFreeze# :: forall (s :: Type) (a :: TYPE R).
     M# s a
  -> State# s
  -> (# State# s, A# a #)
unsafeFreeze# :: forall (s :: TYPE R) (a :: TYPE R).
M# s a -> State# s -> (# State# s, A# a #)
unsafeFreeze# = SmallMutableArray# s a -> State# s -> (# State# s, SmallArray# a #)
forall (d :: TYPE R) a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
unsafeFreezeSmallArray#

uninitialized# :: forall (s :: Type) (a :: TYPE R).
     Int#
  -> State# s
  -> (# State# s, M# s a #)
uninitialized# :: forall (s :: TYPE R) (a :: TYPE R).
Int# -> State# s -> (# State# s, M# s a #)
uninitialized# Int#
i State# s
s = Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
forall a (d :: TYPE R).
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
i a
forall (a :: TYPE R). a
errorThunk State# s
s

initialized# :: forall (s :: Type) (a :: TYPE R).
     Int#
  -> a
  -> State# s
  -> (# State# s, M# s a #)
initialized# :: forall (s :: TYPE R) (a :: TYPE R).
Int# -> a -> State# s -> (# State# s, M# s a #)
initialized# Int#
i a
a State# s
s = Int# -> a -> State# s -> (# State# s, SmallMutableArray# s a #)
forall a (d :: TYPE R).
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
newSmallArray# Int#
i a
a State# s
s

empty# :: forall (a :: TYPE R). (# #) -> A# a
empty# :: forall (a :: TYPE R). (# #) -> A# a
empty# (# #)
_ = 
  let !(# State# RealWorld
_, SmallArray# a
z :: SmallArray# a #) = (State# RealWorld -> (# State# RealWorld, SmallArray# a #))
-> (# State# RealWorld, SmallArray# a #)
forall o. (State# RealWorld -> o) -> o
Exts.runRW#
        (\State# RealWorld
s0 -> case Int#
-> a
-> State# RealWorld
-> (# State# RealWorld, SmallMutableArray# RealWorld a #)
forall a (d :: TYPE R).
Int# -> a -> State# d -> (# State# d, SmallMutableArray# d a #)
Exts.newSmallArray# Int#
0# (a
forall (a :: TYPE R). a
errorThunk :: a) State# RealWorld
s0 of
          (# State# RealWorld
s1, SmallMutableArray# RealWorld a
x #) -> SmallMutableArray# RealWorld a
-> State# RealWorld -> (# State# RealWorld, SmallArray# a #)
forall (d :: TYPE R) a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
Exts.unsafeFreezeSmallArray# SmallMutableArray# RealWorld a
x State# RealWorld
s1
        )
   in SmallArray# a
z

set# :: forall (s :: Type) (a :: TYPE R).
     M# s a
  -> Int#
  -> Int#
  -> a
  -> State# s
  -> State# s
set# :: forall (s :: TYPE R) (a :: TYPE R).
M# s a -> Int# -> Int# -> a -> State# s -> State# s
set# M# s a
m Int#
off0 Int#
len0 a
a State# s
s0 =
  let go :: Int# -> Int# -> State# s -> State# s
go Int#
off Int#
len State# s
s = case Int#
len of
        Int#
0# -> State# s
s
        Int#
_ -> Int# -> Int# -> State# s -> State# s
go (Int#
off Int# -> Int# -> Int#
+# Int#
1#) (Int#
len Int# -> Int# -> Int#
-# Int#
1#) (M# s a -> Int# -> a -> State# s -> State# s
forall (s :: TYPE R) (a :: TYPE R).
M# s a -> Int# -> a -> State# s -> State# s
write# M# s a
m Int#
off a
a State# s
s)
   in Int# -> Int# -> State# s -> State# s
go Int#
off0 Int#
len0 State# s
s0

-- shrink and freeze, all at once
unsafeShrinkFreeze# ::
     M# s a
  -> Int#
  -> State# s
  -> (# State# s, A# a #)
unsafeShrinkFreeze# :: forall (s :: TYPE R) (a :: TYPE R).
M# s a -> Int# -> State# s -> (# State# s, A# a #)
unsafeShrinkFreeze# M# s a
m Int#
i State# s
s0 = case M# s a -> State# s -> (# State# s, Int# #)
forall (d :: TYPE R) a.
SmallMutableArray# d a -> State# d -> (# State# d, Int# #)
getSizeofSmallMutableArray# M# s a
m State# s
s0 of
  (# State# s
s1, Int#
n #) -> case Int#
n Int# -> Int# -> Int#
==# Int#
i of
    Int#
1# -> M# s a -> State# s -> (# State# s, A# a #)
forall (d :: TYPE R) a.
SmallMutableArray# d a -> State# d -> (# State# d, SmallArray# a #)
Exts.unsafeFreezeSmallArray# M# s a
m State# s
s1
    Int#
_ -> M# s a -> Int# -> Int# -> State# s -> (# State# s, A# a #)
forall (d :: TYPE R) a.
SmallMutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, SmallArray# a #)
Exts.freezeSmallArray# M# s a
m Int#
0# Int#
i State# s
s1

-- makes a copy, does not alias the argument
thaw# :: forall (s :: Type) (a :: TYPE R).
     A# a
  -> Int#
  -> Int#
  -> State# s
  -> (# State# s, M# s a #)
thaw# :: forall (s :: TYPE R) (a :: TYPE R).
A# a -> Int# -> Int# -> State# s -> (# State# s, M# s a #)
thaw# = SmallArray# a
-> Int#
-> Int#
-> State# s
-> (# State# s, SmallMutableArray# s a #)
forall a (d :: TYPE R).
SmallArray# a
-> Int#
-> Int#
-> State# d
-> (# State# d, SmallMutableArray# d a #)
Exts.thawSmallArray#

errorThunk :: a
{-# noinline errorThunk #-}
errorThunk :: forall (a :: TYPE R). a
errorThunk = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"SmallArray: uninitialized element"

freeze# :: forall (s :: Type) (a :: TYPE R).
     M# s a
  -> Int#
  -> Int#
  -> State# s
  -> (# State# s, A# a #)
freeze# :: forall (s :: TYPE R) (a :: TYPE R).
M# s a -> Int# -> Int# -> State# s -> (# State# s, A# a #)
freeze# = SmallMutableArray# s a
-> Int# -> Int# -> State# s -> (# State# s, SmallArray# a #)
forall (d :: TYPE R) a.
SmallMutableArray# d a
-> Int# -> Int# -> State# d -> (# State# d, SmallArray# a #)
Exts.freezeSmallArray#

copy# :: forall (s :: Type) (a :: TYPE R).
     M# s a
  -> Int#
  -> A# a
  -> Int#
  -> Int#
  -> State# s
  -> State# s
copy# :: forall (s :: TYPE R) (a :: TYPE R).
M# s a -> Int# -> A# a -> Int# -> Int# -> State# s -> State# s
copy# M# s a
m Int#
doff A# a
v Int#
soff Int#
len State# s
s0 =
  A# a -> Int# -> M# s a -> Int# -> Int# -> State# s -> State# s
forall a (d :: TYPE R).
SmallArray# a
-> Int#
-> SmallMutableArray# d a
-> Int#
-> Int#
-> State# d
-> State# d
Exts.copySmallArray# A# a
v Int#
soff M# s a
m Int#
doff Int#
len State# s
s0