Rename cλash dir to clash so it behaves well within the ghc build tree

[matthijs/master-project/cλash.git] / clash / Data / Param / Index.hs

diff --git a/clash/Data/Param/Index.hs b/clash/Data/Param/Index.hs
new file mode 100644 (file)
index 0000000..f31b1f8
--- /dev/null
+++ b/clash/Data/Param/Index.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE  TypeFamilies, TypeOperators, ScopedTypeVariables, FlexibleInstances, TemplateHaskell, Rank2Types, FlexibleContexts #-}
+module Data.Param.Index
+  ( Index
+  , fromNaturalT
+  , fromUnsigned
+  , rangeT
+  ) where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (Lift(..))    
+import Data.Bits
+import Types
+import Types.Data.Num.Decimal.Literals.TH
+
+import Data.Param.Integer
+
+instance NaturalT nT => Lift (Index nT) where
+  lift (Index i) = sigE [| (Index i) |] (decIndexT (fromIntegerT (undefined :: nT)))
+
+decIndexT :: Integer -> Q Type
+decIndexT n = appT (conT (''Index)) (decLiteralT n)
+
+fromNaturalT :: ( NaturalT n
+                , NaturalT upper
+                , (n :<=: upper) ~ True ) => n -> Index upper
+fromNaturalT x = Index (fromIntegerT x)
+
+fromUnsigned ::
+  ( NaturalT nT
+  , Integral (Unsigned nT)
+  ) => Unsigned nT -> Index ((Pow2 nT) :-: D1)
+fromUnsigned unsigned = Index (toInteger unsigned)
+
+rangeT :: Index nT -> nT
+rangeT _ = undefined
+
+instance NaturalT nT => Eq (Index nT) where
+    (Index x) == (Index y) = x == y
+    (Index x) /= (Index y) = x /= y
+    
+instance NaturalT nT => Show (Index nT) where
+    showsPrec prec n =
+        showsPrec prec $ toInteger n
+ 
+instance NaturalT nT => Ord (Index nT) where
+    a `compare` b = toInteger a `compare` toInteger b 
+        
+instance NaturalT nT => Bounded (Index nT) where
+    minBound = 0
+    maxBound = Index (fromIntegerT (undefined :: nT))
+        
+instance NaturalT nT => Enum (Index nT) where
+    succ x
+       | x == maxBound  = error $ "Enum.succ{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `succ' of maxBound"
+       | otherwise      = x + 1
+    pred x
+       | x == minBound  = error $ "Enum.succ{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `pred' of minBound"
+       | otherwise      = x - 1
+    
+    fromEnum (Index x)
+        | x > toInteger (maxBound :: Int) =
+            error $ "Enum.fromEnum{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Index greater than maxBound :: Int"
+        | x < toInteger (minBound :: Int) =
+            error $ "Enum.fromEnum{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Index smaller than minBound :: Int"
+        | otherwise =
+            fromInteger x
+    toEnum x
+        | x > fromIntegral (maxBound :: Index nT) =
+            error $ "Enum.fromEnum{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Index greater than maxBound :: Index " ++ show (fromIntegerT (undefined :: nT))
+        | x < fromIntegral (minBound :: Index nT) =
+            error $ "Enum.fromEnum{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to take `fromEnum' on Index smaller than minBound :: Index " ++ show (fromIntegerT (undefined :: nT))
+        | otherwise =
+            fromInteger $ toInteger x
+    
+instance NaturalT nT => Num (Index nT) where
+    (Index a) + (Index b) =
+        fromInteger $ a + b
+    (Index a) * (Index b) =
+        fromInteger $ a * b 
+    (Index a) - (Index b) =
+        fromInteger $ a - b
+    fromInteger n
+      | n > fromIntegerT (undefined :: nT) =
+        error $ "Num.fromInteger{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to make Index larger than " ++ show (fromIntegerT (undefined :: nT)) ++ ", n: " ++ show n
+    fromInteger n
+      | n < 0 =
+        error $ "Num.fromInteger{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to make Index smaller than 0, n: " ++ show n
+    fromInteger n =
+        Index n
+    abs s = s
+    signum s
+      | s == 0 =
+          0
+      | otherwise =
+          1
+
+instance NaturalT nT => Real (Index nT) where
+    toRational n = toRational $ toInteger n
+
+instance NaturalT nT => Integral (Index nT) where
+    a `quotRem` b =
+        let (quot, rem) = toInteger a `quotRem` toInteger b
+        in (fromInteger quot, fromInteger rem)
+    toInteger s@(Index x) = x