module CLaSH.Sized.Internal.Unsigned
(
Unsigned (..)
, size#
, pack#
, unpack#
, eq#
, neq#
, lt#
, ge#
, gt#
, le#
, enumFrom#
, enumFromThen#
, enumFromTo#
, enumFromThenTo#
, minBound#
, maxBound#
, (+#)
, (-#)
, (*#)
, negate#
, fromInteger#
, plus#
, minus#
, times#
, quot#
, rem#
, mod#
, toInteger#
, and#
, or#
, xor#
, complement#
, shiftL#
, shiftR#
, rotateL#
, rotateR#
, popCount#
, resize#
)
where
import Data.Bits (Bits (..), FiniteBits (..))
import Data.Default (Default (..))
import Data.Typeable (Typeable)
import GHC.TypeLits (KnownNat, Nat, type (+), natVal)
import Language.Haskell.TH (TypeQ, appT, conT, litT, numTyLit, sigE)
import Language.Haskell.TH.Syntax (Lift(..))
import CLaSH.Class.BitPack (BitPack (..))
import CLaSH.Class.Num (ExtendingNum (..), SaturatingNum (..),
SaturationMode (..))
import CLaSH.Class.Resize (Resize (..))
import CLaSH.Prelude.BitIndex ((!), msb, replaceBit, split)
import CLaSH.Prelude.BitReduction (reduceOr)
import CLaSH.Promoted.Ord (Max)
import CLaSH.Sized.Internal.BitVector (BitVector (..), high, low)
import qualified CLaSH.Sized.Internal.BitVector as BV
newtype Unsigned (n :: Nat) =
U { unsafeToBitVector :: Integer }
deriving Typeable
size# :: KnownNat n => Unsigned n -> Int
size# u = fromInteger (natVal u)
instance Show (Unsigned n) where
show (U i) = show i
instance BitPack (Unsigned n) where
type BitSize (Unsigned n) = n
pack = pack#
unpack = unpack#
pack# :: Unsigned n -> BitVector n
pack# (U i) = BV i
unpack# :: BitVector n -> Unsigned n
unpack# (BV i) = U i
instance Eq (Unsigned n) where
(==) = eq#
(/=) = neq#
eq# :: Unsigned n -> Unsigned n -> Bool
eq# (U v1) (U v2) = v1 == v2
neq# :: Unsigned n -> Unsigned n -> Bool
neq# (U v1) (U v2) = v1 /= v2
instance Ord (Unsigned n) where
(<) = lt#
(>=) = ge#
(>) = gt#
(<=) = le#
lt#,ge#,gt#,le# :: Unsigned n -> Unsigned n -> Bool
lt# (U n) (U m) = n < m
ge# (U n) (U m) = n >= m
gt# (U n) (U m) = n > m
le# (U n) (U m) = n <= m
instance KnownNat n => Enum (Unsigned n) where
succ = (+# fromInteger# 1)
pred = (-# fromInteger# 1)
toEnum = fromInteger# . toInteger
fromEnum = fromEnum . toInteger#
enumFrom = enumFrom#
enumFromThen = enumFromThen#
enumFromTo = enumFromTo#
enumFromThenTo = enumFromThenTo#
enumFrom# :: KnownNat n => Unsigned n -> [Unsigned n]
enumFromThen# :: KnownNat n => Unsigned n -> Unsigned n -> [Unsigned n]
enumFromTo# :: KnownNat n => Unsigned n -> Unsigned n -> [Unsigned n]
enumFromThenTo# :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n
-> [Unsigned n]
enumFrom# x = map toEnum [fromEnum x ..]
enumFromThen# x y = map toEnum [fromEnum x, fromEnum y ..]
enumFromTo# x y = map toEnum [fromEnum x .. fromEnum y]
enumFromThenTo# x1 x2 y = map toEnum [fromEnum x1, fromEnum x2 .. fromEnum y]
instance KnownNat n => Bounded (Unsigned n) where
minBound = minBound#
maxBound = maxBound#
minBound# :: KnownNat n => Unsigned n
minBound# = U 0
maxBound# :: KnownNat n => Unsigned n
maxBound# = let res = U ((2 ^ natVal res) 1) in res
instance KnownNat n => Num (Unsigned n) where
(+) = (+#)
() = (-#)
(*) = (*#)
negate = negate#
abs = id
signum bv = resize# (unpack# (reduceOr bv))
fromInteger = fromInteger#
(+#),(-#),(*#) :: KnownNat n => Unsigned n -> Unsigned n -> Unsigned n
(+#) (U i) (U j) = fromInteger_INLINE (i + j)
(-#) (U i) (U j) = fromInteger_INLINE (i j)
(*#) (U i) (U j) = fromInteger_INLINE (i * j)
negate# :: KnownNat n => Unsigned n -> Unsigned n
negate# u@(U i) = U (sz i)
where
sz = 2 ^ natVal u
fromInteger# :: KnownNat n => Integer -> Unsigned n
fromInteger# = fromInteger_INLINE
fromInteger_INLINE :: KnownNat n => Integer -> Unsigned n
fromInteger_INLINE i = let res = U (i `mod` (2 ^ natVal res)) in res
instance (KnownNat (1 + Max m n), KnownNat (m + n)) =>
ExtendingNum (Unsigned m) (Unsigned n) where
type AResult (Unsigned m) (Unsigned n) = Unsigned (1 + Max m n)
plus = plus#
minus = minus#
type MResult (Unsigned m) (Unsigned n) = Unsigned (m + n)
times = times#
plus#, minus# :: KnownNat (1 + Max m n) => Unsigned m -> Unsigned n
-> Unsigned (1 + Max m n)
plus# (U a) (U b) = fromInteger_INLINE (a + b)
minus# (U a) (U b) = fromInteger_INLINE (a b)
times# :: KnownNat (m + n) => Unsigned m -> Unsigned n -> Unsigned (m + n)
times# (U a) (U b) = fromInteger_INLINE (a * b)
instance KnownNat n => Real (Unsigned n) where
toRational = toRational . toInteger#
instance KnownNat n => Integral (Unsigned n) where
quot = quot#
rem = rem#
div = quot#
mod = mod#
quotRem n d = (n `quot#` d,n `rem#` d)
divMod n d = (n `quot#` d,n `mod#` d)
toInteger = toInteger#
quot#,rem#,mod# :: Unsigned n -> Unsigned n -> Unsigned n
quot# (U i) (U j) = U (i `quot` j)
rem# (U i) (U j) = U (i `rem` j)
mod# (U i) (U j) = U (i `mod` j)
toInteger# :: Unsigned n -> Integer
toInteger# (U i) = i
instance KnownNat n => Bits (Unsigned n) where
(.&.) = and#
(.|.) = or#
xor = xor#
complement = complement#
zeroBits = 0
bit i = replaceBit 0 i high
setBit v i = replaceBit v i high
clearBit v i = replaceBit v i low
complementBit v i = replaceBit v i (BV.complement# (v ! i))
testBit v i = v ! i == high
bitSizeMaybe v = Just (size# v)
bitSize = size#
isSigned _ = False
shiftL v i = shiftL# v i
shiftR v i = shiftR# v i
rotateL v i = rotateL# v i
rotateR v i = rotateR# v i
popCount = popCount#
and# :: Unsigned n -> Unsigned n -> Unsigned n
and# (U v1) (U v2) = U (v1 .&. v2)
or# :: Unsigned n -> Unsigned n -> Unsigned n
or# (U v1) (U v2) = U (v1 .|. v2)
xor# :: Unsigned n -> Unsigned n -> Unsigned n
xor# (U v1) (U v2) = U (v1 `xor` v2)
complement# :: KnownNat n => Unsigned n -> Unsigned n
complement# (U i) = fromInteger_INLINE (complement i)
shiftL#, shiftR#, rotateL#, rotateR# :: KnownNat n => Unsigned n -> Int
-> Unsigned n
shiftL# (U v) i
| i < 0 = error
$ "'shiftL undefined for negative number: " ++ show i
| otherwise = fromInteger_INLINE (shiftL v i)
shiftR# (U v) i
| i < 0 = error
$ "'shiftR undefined for negative number: " ++ show i
| otherwise = fromInteger_INLINE (shiftR v i)
rotateL# _ b | b < 0 = error "'shiftL undefined for negative numbers"
rotateL# bv@(U n) b = fromInteger_INLINE (l .|. r)
where
l = shiftL n b'
r = shiftR n b''
b' = b `mod` sz
b'' = sz b'
sz = fromInteger (natVal bv)
rotateR# _ b | b < 0 = error "'shiftR undefined for negative numbers"
rotateR# bv@(U n) b = fromInteger_INLINE (l .|. r)
where
l = shiftR n b'
r = shiftL n b''
b' = b `mod` sz
b'' = sz b'
sz = fromInteger (natVal bv)
popCount# :: Unsigned n -> Int
popCount# (U i) = popCount i
instance KnownNat n => FiniteBits (Unsigned n) where
finiteBitSize = size#
instance Resize Unsigned where
resize = resize#
zeroExtend = resize#
signExtend = resize#
truncateB = resize#
resize# :: KnownNat m => Unsigned n -> Unsigned m
resize# (U i) = fromInteger_INLINE i
instance KnownNat n => Default (Unsigned n) where
def = minBound#
instance KnownNat n => Lift (Unsigned n) where
lift u@(U i) = sigE [| fromInteger# i |] (decUnsigned (natVal u))
decUnsigned :: Integer -> TypeQ
decUnsigned n = appT (conT ''Unsigned) (litT $ numTyLit n)
instance (KnownNat n, KnownNat (1 + n), KnownNat (n + n)) =>
SaturatingNum (Unsigned n) where
satPlus SatWrap a b = a +# b
satPlus w a b = case msb r of
0 -> resize# r
_ -> case w of
SatZero -> minBound#
_ -> maxBound#
where
r = plus# a b
satMin SatWrap a b = a -# b
satMin _ a b = case msb r of
0 -> resize# r
_ -> minBound#
where
r = minus# a b
satMult SatWrap a b = a *# b
satMult w a b = case rL of
0 -> unpack# rR
_ -> case w of
SatZero -> minBound#
_ -> maxBound#
where
r = times# a b
(rL,rR) = split r