clash/Data/Param/Index.hs

   1 {-# LANGUAGE  TypeFamilies, TypeOperators, ScopedTypeVariables, FlexibleInstances, TemplateHaskell, Rank2Types, FlexibleContexts #-}
   2 module Data.Param.Index
   3   ( Index
   4   , fromNaturalT
   5   , fromUnsigned
   6   , rangeT
   7   ) where
   8
   9 import Language.Haskell.TH
  10 import Language.Haskell.TH.Syntax (Lift(..))
  11 import Data.Bits
  12 import Types
  13 import Types.Data.Num.Decimal.Literals.TH
  14
  15 import Data.Param.Integer
  16
  17 instance PositiveT nT => Lift (Index nT) where
  18   lift (Index i) = sigE [| (Index i) |] (decIndexT (fromIntegerT (undefined :: nT)))
  19
  20 decIndexT :: Integer -> Q Type
  21 decIndexT n = appT (conT (''Index)) (decLiteralT n)
  22
  23 fromNaturalT :: ( NaturalT n
  24                 , PositiveT upper
  25                 , (n :<: upper) ~ True ) => n -> Index upper
  26 fromNaturalT x = Index (fromIntegerT x)
  27
  28 fromUnsigned ::
  29   ( PositiveT nT
  30   , Integral (Unsigned nT)
  31   ) => Unsigned nT -> Index (Pow2 nT)
  32 fromUnsigned unsigned = Index (toInteger unsigned)
  33
  34 rangeT :: Index nT -> nT
  35 rangeT _ = undefined
  36
  37 instance PositiveT nT => Eq (Index nT) where
  38     (Index x) == (Index y) = x == y
  39     (Index x) /= (Index y) = x /= y
  40
  41 instance PositiveT nT => Show (Index nT) where
  42     showsPrec prec n =
  43         showsPrec prec $ toInteger n
  44
  45 instance PositiveT nT => Ord (Index nT) where
  46     a `compare` b = toInteger a `compare` toInteger b
  47
  48 instance PositiveT nT => Bounded (Index nT) where
  49     minBound = 0
  50     maxBound = Index $ (fromIntegerT (undefined :: nT)) - 1
  51
  52 instance PositiveT nT => Enum (Index nT) where
  53     succ x
  54        | x == maxBound  = error $ "Enum.succ{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `succ' of maxBound"
  55        | otherwise      = x + 1
  56     pred x
  57        | x == minBound  = error $ "Enum.succ{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `pred' of minBound"
  58        | otherwise      = x - 1
  59
  60     fromEnum (Index x)
  61         | x > toInteger (maxBound :: Int) =
  62             error $ "Enum.fromEnum{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Index greater than maxBound :: Int"
  63         | x < toInteger (minBound :: Int) =
  64             error $ "Enum.fromEnum{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Index smaller than minBound :: Int"
  65         | otherwise =
  66             fromInteger x
  67     toEnum x
  68         | x > fromIntegral (maxBound :: Index nT) =
  69             error $ "Enum.fromEnum{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Index greater than maxBound :: Index " ++ show (fromIntegerT (undefined :: nT))
  70         | x < fromIntegral (minBound :: Index nT) =
  71             error $ "Enum.fromEnum{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Index smaller than minBound :: Index " ++ show (fromIntegerT (undefined :: nT))
  72         | otherwise =
  73             fromInteger $ toInteger x
  74
  75 instance PositiveT nT => Num (Index nT) where
  76     (Index a) + (Index b) =
  77         fromInteger $ a + b
  78     (Index a) * (Index b) =
  79         fromInteger $ a * b
  80     (Index a) - (Index b) =
  81         fromInteger $ a - b
  82     fromInteger n
  83       | n >= fromIntegerT (undefined :: nT) =
  84         error $ "Num.fromInteger{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to make Index larger than " ++ show (fromIntegerT (undefined :: nT) - 1) ++ ", n: " ++ show n
  85     fromInteger n
  86       | n < 0 =
  87         error $ "Num.fromInteger{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to make Index smaller than 0, n: " ++ show n
  88     fromInteger n =
  89         Index n
  90     abs s = s
  91     signum s
  92       | s == 0 =
  93           0
  94       | otherwise =
  95           1
  96
  97 instance PositiveT nT => Real (Index nT) where
  98     toRational n = toRational $ toInteger n
  99
 100 instance PositiveT nT => Integral (Index nT) where
 101     a `quotRem` b =
 102         let (quot, rem) = toInteger a `quotRem` toInteger b
 103         in (fromInteger quot, fromInteger rem)
 104     toInteger s@(Index x) = x