@@ -75,6 +75,7 @@ import Prelude hiding (even, odd)
7575
7676import Control.DeepSeq (NFData (.. ))
7777import Data.Bits (Bits (.. ), FiniteBits (.. ))
78+ import Data.Constraint (Dict (.. ))
7879import Data.Data (Data )
7980import Data.Default.Class (Default (.. ))
8081import Text.Read (Read (.. ), ReadPrec )
@@ -96,7 +97,7 @@ import GHC.Natural (naturalToInteger)
9697import GHC.Stack (HasCallStack )
9798import GHC.TypeLits (KnownNat , Nat , type (+ ), type (- ),
9899 type (* ), type (<= ), natVal )
99- import GHC.TypeLits.Extra (CLog )
100+ import GHC.TypeLits.Extra (CLog , CLogWZ )
100101import Test.QuickCheck.Arbitrary (Arbitrary (.. ), CoArbitrary (.. ),
101102 arbitraryBoundedIntegral ,
102103 coarbitraryIntegral , shrinkIntegral )
@@ -111,9 +112,10 @@ import Clash.Class.BitPack.BitIndex (replaceBit)
111112import Clash.Sized.Internal (formatRange )
112113import {- # SOURCE #-} Clash.Sized.Internal.BitVector (BitVector (BV ), high , low , undefError )
113114import qualified Clash.Sized.Internal.BitVector as BV
114- import Clash.Promoted.Nat (SNat (.. ), snatToNum , natToInteger , leToPlusKN )
115+ import Clash.Promoted.Nat (SNat (.. ), SNatLE ( .. ), snatToNum , natToInteger , leToPlusKN , compareSNat )
115116import Clash.XException
116117 (ShowX (.. ), NFDataX (.. ), errorX , showsPrecXWith , rwhnfX , seqX )
118+ import Unsafe.Coerce (unsafeCoerce )
117119
118120{- $setup
119121>>> import Clash.Sized.Internal.Index
@@ -184,10 +186,18 @@ instance NFData (Index n) where
184186 -- NOINLINE is needed so that Clash doesn't trip on the "Index ~# Integer"
185187 -- coercion
186188
187- instance (KnownNat n , 1 <= n ) => BitPack (Index n ) where
188- type BitSize (Index n ) = CLog 2 n
189- pack = packXWith pack#
190- unpack = unpack#
189+ instance KnownNat n => BitPack (Index n ) where
190+ type BitSize (Index n ) = CLogWZ 2 n 0
191+ pack = case compareSNat (SNat @ 1 ) (SNat @ n ) of
192+ SNatGT -> const 0
193+ SNatLE | Dict <- fact @ n @ 0 -> packXWith pack#
194+ unpack = case compareSNat (SNat @ 1 ) (SNat @ n ) of
195+ SNatGT -> const $ errorX
196+ " any value of type 'Index 0' is undefined"
197+ SNatLE | Dict <- fact @ n @ 0 -> unpack#
198+
199+ fact :: forall n x . 1 <= n => Dict (CLogWZ 2 n x ~ CLog 2 n )
200+ fact = unsafeCoerce (Dict :: Dict (0 ~ 0 ))
191201
192202-- | Safely convert an `SNat` value to an `Index`
193203fromSNat :: (KnownNat m , n + 1 <= m ) => SNat n -> Index m
0 commit comments