From 63b8956c3d9c50a619e7a9fa674b533f7ef5f3a7 Mon Sep 17 00:00:00 2001 From: christiaanb Date: Wed, 16 Jun 2010 16:49:34 +0200 Subject: [PATCH] Give the index type an exclusive upper-bound, and fix related types accordingly --- clash/CLasH/HardwareTypes.hs | 13 +++++-------- clash/Data/Param/Index.hs | 32 ++++++++++++++++---------------- clash/Data/Param/Integer.hs | 2 +- clash/Data/Param/Vector.hs | 8 +++----- clash/clash.cabal | 2 +- reducer.hs | 6 +++--- 6 files changed, 29 insertions(+), 34 deletions(-) diff --git a/clash/CLasH/HardwareTypes.hs b/clash/CLasH/HardwareTypes.hs index 2912e50..d66befe 100644 --- a/clash/CLasH/HardwareTypes.hs +++ b/clash/CLasH/HardwareTypes.hs @@ -68,20 +68,17 @@ _ `hwxor` _ = Low hwnot High = Low hwnot Low = High -type RAM s a = Vector (s :+: D1) a - -type MemState s a = State (RAM s a) +type RAM s a = Vector s a +type MemState s a = State (RAM s a) blockRAM :: - (NaturalT s - ,PositiveT (s :+: D1) - ,((s :+: D1) :>: s) ~ True ) => - (MemState s a) -> + PositiveT s => + MemState s a -> a -> Index s -> Index s -> Bool -> - ((MemState s a), a ) + (MemState s a, a ) blockRAM (State mem) data_in rdaddr wraddr wrenable = ((State mem'), data_out) where diff --git a/clash/Data/Param/Index.hs b/clash/Data/Param/Index.hs index f31b1f8..2c4e88e 100644 --- a/clash/Data/Param/Index.hs +++ b/clash/Data/Param/Index.hs @@ -14,42 +14,42 @@ import Types.Data.Num.Decimal.Literals.TH import Data.Param.Integer -instance NaturalT nT => Lift (Index nT) where +instance PositiveT 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 + , PositiveT upper + , (n :<: upper) ~ True ) => n -> Index upper fromNaturalT x = Index (fromIntegerT x) fromUnsigned :: - ( NaturalT nT + ( PositiveT nT , Integral (Unsigned nT) - ) => Unsigned nT -> Index ((Pow2 nT) :-: D1) + ) => Unsigned nT -> Index (Pow2 nT) fromUnsigned unsigned = Index (toInteger unsigned) rangeT :: Index nT -> nT rangeT _ = undefined -instance NaturalT nT => Eq (Index nT) where +instance PositiveT nT => Eq (Index nT) where (Index x) == (Index y) = x == y (Index x) /= (Index y) = x /= y -instance NaturalT nT => Show (Index nT) where +instance PositiveT nT => Show (Index nT) where showsPrec prec n = showsPrec prec $ toInteger n -instance NaturalT nT => Ord (Index nT) where +instance PositiveT nT => Ord (Index nT) where a `compare` b = toInteger a `compare` toInteger b -instance NaturalT nT => Bounded (Index nT) where +instance PositiveT nT => Bounded (Index nT) where minBound = 0 - maxBound = Index (fromIntegerT (undefined :: nT)) + maxBound = Index $ (fromIntegerT (undefined :: nT)) - 1 -instance NaturalT nT => Enum (Index nT) where +instance PositiveT 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 @@ -72,7 +72,7 @@ instance NaturalT nT => Enum (Index nT) where | otherwise = fromInteger $ toInteger x -instance NaturalT nT => Num (Index nT) where +instance PositiveT nT => Num (Index nT) where (Index a) + (Index b) = fromInteger $ a + b (Index a) * (Index b) = @@ -80,8 +80,8 @@ instance NaturalT nT => Num (Index nT) where (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 + | n >= fromIntegerT (undefined :: nT) = + error $ "Num.fromInteger{Index " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to make Index larger than " ++ show (fromIntegerT (undefined :: nT) - 1) ++ ", 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 @@ -94,10 +94,10 @@ instance NaturalT nT => Num (Index nT) where | otherwise = 1 -instance NaturalT nT => Real (Index nT) where +instance PositiveT nT => Real (Index nT) where toRational n = toRational $ toInteger n -instance NaturalT nT => Integral (Index nT) where +instance PositiveT nT => Integral (Index nT) where a `quotRem` b = let (quot, rem) = toInteger a `quotRem` toInteger b in (fromInteger quot, fromInteger rem) diff --git a/clash/Data/Param/Integer.hs b/clash/Data/Param/Integer.hs index b4b1ec8..4e48d14 100644 --- a/clash/Data/Param/Integer.hs +++ b/clash/Data/Param/Integer.hs @@ -10,4 +10,4 @@ newtype (NaturalT nT) => Signed nT = Signed Integer newtype (NaturalT nT) => Unsigned nT = Unsigned Integer -newtype (NaturalT upper) => Index upper = Index Integer \ No newline at end of file +newtype (PositiveT upper) => Index upper = Index Integer \ No newline at end of file diff --git a/clash/Data/Param/Vector.hs b/clash/Data/Param/Vector.hs index 32218be..6f5b722 100644 --- a/clash/Data/Param/Vector.hs +++ b/clash/Data/Param/Vector.hs @@ -109,16 +109,14 @@ fromVector (Vector xs) = xs null :: Vector D0 a -> Bool null _ = True -(!) :: ( PositiveT s - , NaturalT u - , (s :>: u) ~ True) => Vector s a -> Index u -> a +(!) :: PositiveT s => Vector s a -> Index s -> a (Vector xs) ! i = xs !! (fromInteger (toInteger i)) -- ========================== -- = Transforming functions = -- ========================== -replace :: (PositiveT s, NaturalT u, (s :>: u) ~ True) => - Vector s a -> Index u -> a -> Vector s a +replace :: PositiveT s => + Vector s a -> Index s -> a -> Vector s a replace (Vector xs) i y = Vector $ replace' xs (toInteger i) y where replace' [] _ _ = [] replace' (_:xs) 0 y = (y:xs) diff --git a/clash/clash.cabal b/clash/clash.cabal index db16c33..9a62eac 100644 --- a/clash/clash.cabal +++ b/clash/clash.cabal @@ -1,5 +1,5 @@ name: clash -version: 0.1.0.1 +version: 0.1.0.3 build-type: Simple synopsis: CAES Language for Synchronous Hardware (CLaSH) description: CLaSH is a tool-chain/language to translate subsets of diff --git a/reducer.hs b/reducer.hs index ce4025e..39e136f 100644 --- a/reducer.hs +++ b/reducer.hs @@ -15,7 +15,7 @@ type DiscrSize = D7 type AdderDepth = D12 -- Derived configuration variables -type DiscrRange = (Pow2 DiscrSize) :-: D1 +type DiscrRange = Pow2 DiscrSize type AdderDepthPL = AdderDepth :+: D3 -- ================= @@ -65,8 +65,8 @@ type RippleState = data BlockRecord = Block { ptrs :: (Unsigned D4, Unsigned D4, Unsigned D4) - , buf1 :: MemState AdderDepthPL DataInt - , buf2 :: MemState AdderDepthPL DataInt + , buf1 :: MemState (AdderDepthPL :+: D1) DataInt + , buf2 :: MemState (AdderDepthPL :+: D1) DataInt } type BlockState = State BlockRecord -- 2.30.2