clash/Data/Param/Unsigned.hs

   1 {-# LANGUAGE  TypeFamilies, TypeOperators, ScopedTypeVariables, FlexibleInstances, TemplateHaskell, Rank2Types, FlexibleContexts #-}
   2 module Data.Param.Unsigned
   3     ( Unsigned
   4     , resizeUnsigned
   5     , fromIndex
   6     ) where
   7
   8 import Language.Haskell.TH
   9 import Language.Haskell.TH.Syntax (Lift(..))
  10 import Data.Bits
  11 import Types
  12 import Types.Data.Num.Decimal.Literals.TH
  13
  14 import Data.Param.Integer
  15
  16 instance NaturalT nT => Lift (Unsigned nT) where
  17   lift (Unsigned i) = sigE [| (Unsigned i) |] (decUnsignedT (fromIntegerT (undefined :: nT)))
  18
  19 decUnsignedT :: Integer -> Q Type
  20 decUnsignedT n = appT (conT (''Unsigned)) (decLiteralT n)
  21
  22 fromIndex ::
  23   ( NaturalT nT
  24   , NaturalT nT'
  25   , ((Pow2 nT') :>: nT) ~ True
  26   , Integral (Index nT)
  27   ) => Index nT -> Unsigned nT'
  28 fromIndex index = Unsigned (toInteger index)
  29
  30 resizeUnsigned :: (NaturalT nT, NaturalT nT') => Unsigned nT -> Unsigned nT'
  31 resizeUnsigned a = fromInteger (toInteger a)
  32
  33 sizeT :: Unsigned nT
  34       -> nT
  35 sizeT _ = undefined
  36
  37 mask :: forall nT . NaturalT nT
  38      => nT
  39      -> Integer
  40 mask _ = bit (fromIntegerT (undefined :: nT)) - 1
  41
  42 instance NaturalT nT => Eq (Unsigned nT) where
  43     (Unsigned x) == (Unsigned y) = x == y
  44     (Unsigned x) /= (Unsigned y) = x /= y
  45
  46 instance NaturalT nT => Show (Unsigned nT) where
  47     showsPrec prec n =
  48         showsPrec prec $ toInteger n
  49
  50 instance NaturalT nT => Read (Unsigned nT) where
  51     readsPrec prec str =
  52         [ (fromInteger n, str)
  53         | (n, str) <- readsPrec prec str ]
  54
  55 instance NaturalT nT => Ord (Unsigned nT) where
  56     a `compare` b = toInteger a `compare` toInteger b
  57
  58 instance NaturalT nT => Bounded (Unsigned nT) where
  59     minBound = 0
  60     maxBound = Unsigned $ (1 `shiftL` (fromIntegerT (undefined :: nT))) - 1
  61
  62 instance NaturalT nT => Enum (Unsigned nT) where
  63     succ x
  64        | x == maxBound  = error $ "Enum.succ{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `succ' of maxBound"
  65        | otherwise      = x + 1
  66     pred x
  67        | x == minBound  = error $ "Enum.succ{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `pred' of minBound"
  68        | otherwise      = x - 1
  69
  70     fromEnum (Unsigned x)
  71         | x > toInteger (maxBound :: Int) =
  72             error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned greater than maxBound :: Int"
  73         | x < toInteger (minBound :: Int) =
  74             error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned smaller than minBound :: Int"
  75         | otherwise =
  76             fromInteger x
  77     toEnum x
  78         | x > fromIntegral (maxBound :: Unsigned nT) =
  79             error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned greater than maxBound :: Unsigned " ++ show (fromIntegerT (undefined :: nT))
  80         | x < fromIntegral (minBound :: Unsigned nT) =
  81             error $ "Enum.fromEnum{Unsigned " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Unsigned smaller than minBound :: Unsigned " ++ show (fromIntegerT (undefined :: nT))
  82         | otherwise =
  83             fromInteger $ toInteger x
  84
  85 instance NaturalT nT => Num (Unsigned nT) where
  86     (Unsigned a) + (Unsigned b) =
  87         fromInteger $ a + b
  88     (Unsigned a) * (Unsigned b) =
  89         fromInteger $ a * b
  90     negate s@(Unsigned n) =
  91         fromInteger $ (n `xor` mask (sizeT s)) + 1
  92     a - b =
  93         a + (negate b)
  94
  95     fromInteger n
  96       | n > 0 =
  97         Unsigned $ n .&. mask (undefined :: nT)
  98     fromInteger n
  99       | n < 0 =
 100         negate $ fromInteger $ negate n
 101     fromInteger _ =
 102         Unsigned 0
 103
 104     abs s = s
 105     signum s
 106       | s == 0 =
 107           0
 108       | otherwise =
 109           1
 110
 111 instance NaturalT nT => Real (Unsigned nT) where
 112     toRational n = toRational $ toInteger n
 113
 114 instance NaturalT nT => Integral (Unsigned nT) where
 115     a `quot` b =
 116         fromInteger $ toInteger a `quot` toInteger b
 117     a `rem` b =
 118         fromInteger $ toInteger a `rem` toInteger b
 119     a `div` b =
 120         fromInteger $ toInteger a `div` toInteger b
 121     a `mod` b =
 122         fromInteger $ toInteger a `mod` toInteger b
 123     a `quotRem` b =
 124         let (quot, rem) = toInteger a `quotRem` toInteger b
 125         in (fromInteger quot, fromInteger rem)
 126     a `divMod` b =
 127         let (div, mod) = toInteger a `divMod` toInteger b
 128         in (fromInteger div, fromInteger mod)
 129     toInteger s@(Unsigned x) = x
 130
 131 instance NaturalT nT => Bits (Unsigned nT) where
 132     (Unsigned a) .&. (Unsigned b) = Unsigned $ a .&. b
 133     (Unsigned a) .|. (Unsigned b) = Unsigned $ a .|. b
 134     (Unsigned a) `xor` Unsigned b = Unsigned $ a `xor` b
 135     complement (Unsigned x) = Unsigned $ x `xor` mask (undefined :: nT)
 136     s@(Unsigned x) `shiftL` b
 137       | b < 0 = error $ "Bits.shiftL{Unsigned " ++ show (bitSize s) ++ "}: tried to shift by negative amount"
 138       | otherwise =
 139         Unsigned $ mask (undefined :: nT) .&. (x `shiftL` b)
 140     s@(Unsigned x) `shiftR` b
 141       | b < 0 = error $ "Bits.shiftR{Unsigned " ++ show (bitSize s) ++ "}: tried to shift by negative amount"
 142       | otherwise =
 143         Unsigned $ (x `shiftR` b)
 144     s@(Unsigned x) `rotateL` b
 145       | b < 0 =
 146         error $ "Bits.rotateL{Unsigned " ++ show (bitSize s) ++ "}: tried to rotate by negative amount"
 147       | otherwise =
 148         Unsigned $ mask (undefined :: nT) .&.
 149             ((x `shiftL` b) .|. (x `shiftR` (bitSize s - b)))
 150     s@(Unsigned x) `rotateR` b
 151       | b < 0 =
 152         error $ "Bits.rotateR{Unsigned " ++ show (bitSize s) ++ "}: tried to rotate by negative amount"
 153       | otherwise =
 154         Unsigned $ mask (undefined :: nT) .&.
 155             ((x `shiftR` b) .|. (x `shiftL` (bitSize s - b)))
 156     bitSize _ = fromIntegerT (undefined :: nT)
 157     isSigned _ = False