{-# LANGUAGE DerivingVia #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-orphans #-} module Data.Function.FastMemo.Word () where import Data.Bits import Data.Foldable (foldl') import Data.Function.FastMemo.Class (Memoizable (..)) import Data.Function.FastMemo.Util (memoizeFixedLen) import qualified Data.Vector as V import Data.Word instance Memoizable Word8 where memoize :: forall b. (Word8 -> b) -> Word8 -> b memoize Word8 -> b f = let values :: Vector b values = Word8 -> b f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. [a] -> Vector a V.fromList [Word8 0x00 .. Word8 0xff] in \Word8 i -> Vector b values forall a. Vector a -> Int -> a V.! forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 i deriving via MemoWord Word instance Memoizable Word deriving via MemoWord Word16 instance Memoizable Word16 deriving via MemoWord Word32 instance Memoizable Word32 deriving via MemoWord Word64 instance Memoizable Word64 newtype MemoWord a = MemoWord {forall a. MemoWord a -> a getMemoWord :: a} instance (FiniteBits a, Integral a) => Memoizable (MemoWord a) where memoize :: forall b. (MemoWord a -> b) -> MemoWord a -> b memoize MemoWord a -> b f = forall a b. (HasCallStack, Memoizable a) => Int -> ([a] -> b) -> [a] -> b memoizeFixedLen (forall a. FiniteBits a => a -> Int byteLen (a 0 :: a)) (MemoWord a -> b f forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. a -> MemoWord a MemoWord forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. (Bits a, Num a) => [Word8] -> a fromBytes) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. (FiniteBits a, Integral a) => a -> [Word8] toBytes forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. MemoWord a -> a getMemoWord byteLen :: FiniteBits a => a -> Int byteLen :: forall a. FiniteBits a => a -> Int byteLen a x = (forall a. FiniteBits a => a -> Int finiteBitSize a x forall a. Num a => a -> a -> a + Int 7) forall a. Integral a => a -> a -> a `quot` Int 8 toBytes :: (FiniteBits a, Integral a) => a -> [Word8] toBytes :: forall a. (FiniteBits a, Integral a) => a -> [Word8] toBytes a x = [forall a b. (Integral a, Num b) => a -> b fromIntegral (a x forall a. Bits a => a -> Int -> a `shiftR` Int i) | Int i <- [Int s0, Int s0 forall a. Num a => a -> a -> a - Int 8 .. Int 0]] where s0 :: Int s0 = (forall a. FiniteBits a => a -> Int byteLen a x forall a. Num a => a -> a -> a - Int 1) forall a. Num a => a -> a -> a * Int 8 fromBytes :: (Bits a, Num a) => [Word8] -> a fromBytes :: forall a. (Bits a, Num a) => [Word8] -> a fromBytes = forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' (\a acc Word8 x -> a acc forall a. Bits a => a -> Int -> a `shiftL` Int 8 forall a. Bits a => a -> a -> a .|. forall a b. (Integral a, Num b) => a -> b fromIntegral Word8 x) a 0