{-# language BangPatterns #-}
{-# language DuplicateRecordFields #-}
{-# language RankNTypes #-}
{-# language TypeFamilies #-}

module Data.Primitive.Slice
  ( -- * Types
    UnliftedVector(..)
  , MutableUnliftedVector(..)
  , SmallVector(..)
  , SmallMutableVector(..)
    -- * Conversion
  , unslicedUnliftedVector
  , unslicedSmallVector
  ) where

import Prelude hiding (length)

import Data.Primitive (SmallArray,SmallMutableArray)
import Data.Primitive.Unlifted.Array (UnliftedArray,MutableUnliftedArray)
import Data.Primitive.Unlifted.Class (PrimUnlifted)
import GHC.Exts (IsList)

import qualified GHC.Exts as Exts
import qualified Data.Primitive as PM
import qualified Data.Primitive.Unlifted.Array as PM

data UnliftedVector a = UnliftedVector
  { forall a. UnliftedVector a -> UnliftedArray a
array :: !(UnliftedArray a)
  , forall a. UnliftedVector a -> Int
offset :: !Int
  , forall a. UnliftedVector a -> Int
length :: !Int
  }

instance PrimUnlifted a => IsList (UnliftedVector a) where
  type Item (UnliftedVector a) = a
  fromList :: [Item (UnliftedVector a)] -> UnliftedVector a
fromList = forall a. UnliftedArray a -> UnliftedVector a
unslicedUnliftedVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => [Item l] -> l
Exts.fromList
  fromListN :: Int -> [Item (UnliftedVector a)] -> UnliftedVector a
fromListN Int
n = forall a. UnliftedArray a -> UnliftedVector a
unslicedUnliftedVector forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => Int -> [Item l] -> l
Exts.fromListN Int
n
  toList :: UnliftedVector a -> [Item (UnliftedVector a)]
toList = forall a b.
PrimUnlifted a =>
(a -> b -> b) -> b -> UnliftedVector a -> b
foldrUnliftedVector (:) []

data MutableUnliftedVector s a = MutableUnliftedVector
  { forall s a. MutableUnliftedVector s a -> MutableUnliftedArray s a
array :: !(MutableUnliftedArray s a)
  , forall s a. MutableUnliftedVector s a -> Int
offset :: !Int
  , forall s a. MutableUnliftedVector s a -> Int
length :: !Int
  }

data SmallVector a = SmallVector
  { forall a. SmallVector a -> SmallArray a
array :: !(SmallArray a)
  , forall a. SmallVector a -> Int
offset :: !Int
  , forall a. SmallVector a -> Int
length :: !Int
  }

data SmallMutableVector s a = SmallMutableVector
  { forall s a. SmallMutableVector s a -> SmallMutableArray s a
array :: !(SmallMutableArray s a)
  , forall s a. SmallMutableVector s a -> Int
offset :: !Int
  , forall s a. SmallMutableVector s a -> Int
length :: !Int
  }

unslicedUnliftedVector :: UnliftedArray a -> UnliftedVector a
unslicedUnliftedVector :: forall a. UnliftedArray a -> UnliftedVector a
unslicedUnliftedVector UnliftedArray a
x = UnliftedVector
  { $sel:array:UnliftedVector :: UnliftedArray a
array = UnliftedArray a
x
  , $sel:offset:UnliftedVector :: Int
offset = Int
0
  , $sel:length:UnliftedVector :: Int
length = forall e. UnliftedArray e -> Int
PM.sizeofUnliftedArray UnliftedArray a
x
  }

unslicedSmallVector :: SmallArray a -> SmallVector a
unslicedSmallVector :: forall a. SmallArray a -> SmallVector a
unslicedSmallVector SmallArray a
x = SmallVector
  { $sel:array:SmallVector :: SmallArray a
array = SmallArray a
x
  , $sel:offset:SmallVector :: Int
offset = Int
0
  , $sel:length:SmallVector :: Int
length = forall a. SmallArray a -> Int
PM.sizeofSmallArray SmallArray a
x
  }

foldrUnliftedVector :: forall a b. PrimUnlifted a => (a -> b -> b) -> b -> UnliftedVector a -> b
{-# INLINE foldrUnliftedVector #-}
foldrUnliftedVector :: forall a b.
PrimUnlifted a =>
(a -> b -> b) -> b -> UnliftedVector a -> b
foldrUnliftedVector a -> b -> b
f b
z (UnliftedVector UnliftedArray a
arr Int
off0 Int
len) = Int -> b
go Int
off0
  where
    !end :: Int
end = Int
len forall a. Num a => a -> a -> a
+ Int
off0
    go :: Int -> b
go !Int
i
      | Int
end forall a. Ord a => a -> a -> Bool
> Int
i = a -> b -> b
f (forall a. PrimUnlifted a => UnliftedArray a -> Int -> a
PM.indexUnliftedArray UnliftedArray a
arr Int
i) (Int -> b
go (Int
iforall a. Num a => a -> a -> a
+Int
1))
      | Bool
otherwise = b
z