{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Raaz.Core.Types.Aligned
(
Aligned, unAligned, aligned16Bytes, aligned32Bytes, aligned64Bytes
) where
#if MIN_VERSION_base(4,7,0)
import Data.Proxy
#endif
import GHC.TypeLits
import Foreign.Ptr ( castPtr )
import Foreign.Storable ( Storable(..) )
import Prelude hiding ( length )
newtype Aligned (align :: Nat) w
= Aligned { unAligned :: w
}
aligned16Bytes :: w -> Aligned 16 w
{-# INLINE aligned16Bytes #-}
aligned32Bytes :: w -> Aligned 32 w
{-# INLINE aligned32Bytes #-}
aligned64Bytes :: w -> Aligned 64 w
{-# INLINE aligned64Bytes #-}
aligned16Bytes = Aligned
aligned32Bytes = Aligned
aligned64Bytes = Aligned
#if MIN_VERSION_base(4,7,0)
type AlignBoundary (alg :: Nat) = KnownNat alg
alignmentBoundary :: AlignBoundary alg => Aligned alg a -> Int
alignmentBoundary = aB Proxy
where aB :: AlignBoundary algn => Proxy algn -> Aligned algn a -> Int
aB algn _ = fromEnum $ natVal algn
#else
type AlignBoundary (alg :: Nat) = SingI alg
alignmentBoundary :: AlignBoundary algn => Aligned algn a -> Int
alignmentBoundary = withSing aB
where aB :: AlignBoundary algn => Sing algn -> Aligned algn a -> Int
aB algn _ = fromEnum $ fromSing algn
#endif
instance (Storable a, AlignBoundary alg) => Storable (Aligned alg a) where
sizeOf = sizeOf . unAligned
alignment alg = lcm valueAlignment forceAlignment
where valueAlignment = alignment $ unAligned alg
forceAlignment = alignmentBoundary alg
peek = fmap Aligned . peek . castPtr
poke ptr = poke (castPtr ptr) . unAligned