Add shiftL and shiftR operators for signed and unsigned. Update name of shiftl and...
authorchristiaanb <christiaan.baaij@gmail.com>
Thu, 17 Jun 2010 21:14:07 +0000 (23:14 +0200)
committerchristiaanb <christiaan.baaij@gmail.com>
Thu, 17 Jun 2010 21:14:07 +0000 (23:14 +0200)
HigherOrderCPU.hs
clash/CLasH/HardwareTypes.hs
clash/CLasH/VHDL/Constants.hs
clash/CLasH/VHDL/Generate.hs
clash/Data/Param/Index.hs
clash/Data/Param/Integer.hs
clash/Data/Param/Signed.hs
clash/Data/Param/Unsigned.hs

index 8e3f0da182f6d6db4a7d9d4372a25a4efa145e23..9b151d14c08b3dbf1ed516ba65dc7f5e98a18d84 100644 (file)
@@ -18,9 +18,9 @@ fu1 = fu (+)
 fu2 = fu (-)
 fu3 = fu (*)
 
-data Opcode = Shift | Xor | Equal
+data Opcode = ShiftL | Xor | Equal
 
-multiop Shift   = shift
+multiop ShiftL  = shiftL
 multiop Xor     = xor
 multiop Equal   = \a b -> if a == b then 1 else 0
 
@@ -40,16 +40,5 @@ cpu (State s) (x,opc,addrs) = (State s', out)
               (fu3     inputs (addrs!3)) +> empty)))
     out     = last s
 
-
-
-
-
-
-
--- Some minor details
 cpuState :: Vector D4 (Signed D16)
 cpuState = copy 0
-
-const a b = a
-xor = const
-shift = const
index dbb0ecac94cc93a0dcd446686fb01714a4d9d894..572a64e7f66154842d1fcb6887a71ba0f6a83a8d 100644 (file)
@@ -2,11 +2,13 @@
 
 module CLasH.HardwareTypes
   ( module Types
+  , module Data.Param.Integer
   , module Data.Param.Vector
   , module Data.Param.Index
   , module Data.Param.Signed
   , module Data.Param.Unsigned
   , module Prelude
+  , module Data.Bits
   , Bit(..)
   , State(..)
   , hwand
@@ -21,10 +23,12 @@ module CLasH.HardwareTypes
 import qualified Prelude as P
 import Prelude (Bool(..),Num(..),Eq(..),Ord(..),snd,fst,otherwise,(&&),(||),not)
 import Types
+import Data.Param.Integer (HWBits(..))
 import Data.Param.Vector
 import Data.Param.Index
 import Data.Param.Signed
 import Data.Param.Unsigned 
+import Data.Bits hiding (shiftL,shiftR)
 
 import Language.Haskell.TH.Lift
 import Data.Typeable
index 23ac95d5e12c725e65e4502ac50763479489a5cf..4267e2eef46d92edb45e3638735d0514af798101 100644 (file)
@@ -8,14 +8,14 @@ import qualified Language.VHDL.AST as AST
 -- circular dependencie.
 builtinIds = [ exId, replaceId, headId, lastId, tailId, initId, takeId, dropId
              , selId, plusgtId, ltplusId, plusplusId, mapId, zipWithId, foldlId
-             , foldrId, zipId, unzipId, shiftlId, shiftrId, rotlId, rotrId
+             , foldrId, zipId, unzipId, shiftIntoLId, shiftIntoRId, rotlId, rotrId
              , concatId, reverseId, iteratenId, iterateId, generatenId, generateId
              , emptyId, singletonId, copynId, copyId, lengthTId, nullId
              , hwxorId, hwandId, hworId, hwnotId, equalityId, inEqualityId, ltId
              , lteqId, gtId, gteqId, boolOrId, boolAndId, plusId, timesId
              , negateId, minusId, fromSizedWordId, fromIntegerId, resizeWordId
              , resizeIntId, sizedIntId, smallIntegerId, fstId, sndId, blockRAMId
-             , splitId, minimumId, fromRangedWordId 
+             , splitId, minimumId, fromRangedWordId, xorId, shiftLId , shiftRId
              ]
 --------------
 -- Identifiers
@@ -154,12 +154,12 @@ dropId :: String
 dropId = "drop"
 
 -- | shiftl function identifier
-shiftlId :: String
-shiftlId = "shiftIntoL"
+shiftIntoLId :: String
+shiftIntoLId = "shiftIntoL"
 
 -- | shiftr function identifier
-shiftrId :: String
-shiftrId = "shiftIntoR"
+shiftIntoRId :: String
+shiftIntoRId = "shiftIntoR"
 
 -- | rotl function identifier
 rotlId :: String
@@ -241,6 +241,15 @@ hwnotId = "hwnot"
 hwandId :: String
 hwandId = "hwand"
 
+xorId :: String
+xorId = "xor"
+
+shiftLId :: String
+shiftLId = "shiftL"
+
+shiftRId :: String
+shiftRId = "shiftR"
+
 lengthTId :: String
 lengthTId = "lengthT"
 
index 543e91870c91e2b75f81c70ee4b3f6def1af768f..8c59334085fe6e53bcd153eb514320e96b2a67d0 100644 (file)
@@ -1064,6 +1064,21 @@ genSplit' (Left res) f args@[(vecIn,vecInType)] = do {
   where
     vecSlice init last =  AST.NSlice (AST.SliceName (varToVHDLName res) 
                             (AST.ToRange init last))
+                            
+genSll :: BuiltinBuilder
+genSll = genNoInsts $ genExprArgs $ genExprRes genSll'
+genSll' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [(AST.Expr, Type.Type)] -> TranslatorSession AST.Expr
+genSll' res f [(arg1,_),(arg2,_)] = do {
+  ; return $ (AST.Sll arg1 (genExprFCall (mkVHDLBasicId toIntegerId) arg2))
+  }
+
+genSra :: BuiltinBuilder
+genSra = genNoInsts $ genExprArgs $ genExprRes genSra'
+genSra' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [(AST.Expr, Type.Type)] -> TranslatorSession AST.Expr
+genSra' res f [(arg1,_),(arg2,_)] = do {
+  ; return $ (AST.Sra arg1 (genExprFCall (mkVHDLBasicId toIntegerId) arg2))
+  }
+
 -----------------------------------------------------------------------------
 -- Function to generate VHDL for applications
 -----------------------------------------------------------------------------
@@ -1275,8 +1290,8 @@ genUnconsVectorFuns elemTM vectorTM  =
   , (ltplusId, (AST.SubProgBody ltplusSpec [AST.SPVD ltplusVar] [ltplusExpr, ltplusRet],[]))  
   , (plusplusId, (AST.SubProgBody plusplusSpec [AST.SPVD plusplusVar] [plusplusExpr, plusplusRet],[]))
   , (lengthTId, (AST.SubProgBody lengthTSpec [] [lengthTExpr],[]))
-  , (shiftlId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId]))
-  , (shiftrId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId]))
+  , (shiftIntoLId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId]))
+  , (shiftIntoRId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId]))
   , (nullId, (AST.SubProgBody nullSpec [] [nullExpr], []))
   , (rotlId, (AST.SubProgBody rotlSpec [AST.SPVD rotlVar] [rotlExpr, rotlRet], [nullId, lastId, initId]))
   , (rotrId, (AST.SubProgBody rotrSpec [AST.SPVD rotrVar] [rotrExpr, rotrRet], [nullId, tailId, headId]))
@@ -1504,7 +1519,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     lengthTSpec = AST.Function (mkVHDLExtId lengthTId) [AST.IfaceVarDec vecPar vectorTM] naturalTM
     lengthTExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $ 
                                 AST.AttribName (AST.NSimple vecPar) (AST.NSimple $ mkVHDLBasicId lengthId) Nothing))
-    shiftlSpec = AST.Function (mkVHDLExtId shiftlId) [AST.IfaceVarDec vecPar vectorTM,
+    shiftlSpec = AST.Function (mkVHDLExtId shiftIntoLId) [AST.IfaceVarDec vecPar vectorTM,
                                    AST.IfaceVarDec aPar   elemTM  ] vectorTM 
     -- variable res : fsvec_x (0 to vec'length-1);
     shiftlVar = 
@@ -1522,7 +1537,7 @@ genUnconsVectorFuns elemTM vectorTM  =
                      (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))  
                        [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
     shiftlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)       
-    shiftrSpec = AST.Function (mkVHDLExtId shiftrId) [AST.IfaceVarDec vecPar vectorTM,
+    shiftrSpec = AST.Function (mkVHDLExtId shiftIntoRId) [AST.IfaceVarDec vecPar vectorTM,
                                        AST.IfaceVarDec aPar   elemTM  ] vectorTM 
     -- variable res : fsvec_x (0 to vec'length-1);
     shiftrVar = 
@@ -1662,8 +1677,8 @@ globalNameTable = Map.fromList
   , (foldrId          , (3, genFoldr                ) )
   , (zipId            , (2, genZip                  ) )
   , (unzipId          , (1, genUnzip                ) )
-  , (shiftlId         , (2, genFCall False          ) )
-  , (shiftrId         , (2, genFCall False          ) )
+  , (shiftIntoLId     , (2, genFCall False          ) )
+  , (shiftIntoRId     , (2, genFCall False          ) )
   , (rotlId           , (1, genFCall False          ) )
   , (rotrId           , (1, genFCall False          ) )
   , (concatId         , (1, genConcat               ) )
@@ -1706,6 +1721,9 @@ globalNameTable = Map.fromList
   , (sndId            , (1, genSnd                  ) )
   , (blockRAMId       , (5, genBlockRAM             ) )
   , (splitId          , (1, genSplit                ) )
+  , (xorId            , (2, genOperator2 AST.Xor    ) )
+  , (shiftLId         , (2, genSll                  ) )
+  , (shiftRId         , (2, genSra                  ) )
   --, (tfvecId          , (1, genTFVec                ) )
   , (minimumId        , (2, error "\nFunction name: \"minimum\" is used internally, use another name"))
   ]
index 2c4e88e0bac7607e47907a31317d8d799c9d5bd6..79d551d38e7c7661fcc1d6745a6a04e402f88292 100644 (file)
@@ -8,7 +8,7 @@ module Data.Param.Index
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (Lift(..))    
-import Data.Bits
+import qualified Data.Bits as B
 import Types
 import Types.Data.Num.Decimal.Literals.TH
 
index 4e48d14dc01d29b8a482d7d051106d098d235370..a57c0aa0f853b5e8f9a2bbf39747ef7ccf872b12 100644 (file)
@@ -2,12 +2,18 @@ module Data.Param.Integer
   ( Signed(..)
   , Unsigned(..)
   , Index (..)
+  , HWBits(..)
   ) where
 
 import Types
+import qualified Data.Bits as B
 
 newtype (NaturalT nT) => Signed nT = Signed Integer
 
 newtype (NaturalT nT) => Unsigned nT = Unsigned Integer
 
-newtype (PositiveT upper) => Index upper = Index Integer
\ No newline at end of file
+newtype (PositiveT upper) => Index upper = Index Integer
+
+class (B.Bits a) => HWBits a where
+  shiftL :: a -> a -> a
+  shiftR :: a -> a -> a
index e85fe607757da2fd0293d444e901197d1954daf6..dc9ee21e6acbacde685c4a9e0fe3b5e08ccd1342 100644 (file)
@@ -6,7 +6,7 @@ module Data.Param.Signed
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (Lift(..))
-import Data.Bits
+import qualified Data.Bits as B
 import Types
 import Types.Data.Num.Decimal.Literals.TH
 
@@ -28,7 +28,7 @@ sizeT _ = undefined
 mask :: forall nT . NaturalT nT
      => nT
      -> Integer
-mask _ = bit (fromIntegerT (undefined :: nT)) - 1
+mask _ = B.bit (fromIntegerT (undefined :: nT)) - 1
 
 signBit :: forall nT . NaturalT nT
         => nT
@@ -39,7 +39,7 @@ isNegative :: forall nT . NaturalT nT
            => Signed nT
            -> Bool
 isNegative (Signed x) =
-    testBit x $ signBit (undefined :: nT)
+    B.testBit x $ signBit (undefined :: nT)
 
 instance NaturalT nT => Eq (Signed nT) where
     (Signed x) == (Signed y) = x == y
@@ -58,8 +58,8 @@ instance NaturalT nT => Ord (Signed nT) where
     a `compare` b = toInteger a `compare` toInteger b
 
 instance NaturalT nT => Bounded (Signed nT) where
-    minBound = Signed $ negate $ 1 `shiftL` (fromIntegerT (undefined :: nT) - 1)
-    maxBound = Signed $ (1 `shiftL` (fromIntegerT (undefined :: nT) - 1)) - 1
+    minBound = Signed $ negate $ 1 `B.shiftL` (fromIntegerT (undefined :: nT) - 1)
+    maxBound = Signed $ (1 `B.shiftL` (fromIntegerT (undefined :: nT) - 1)) - 1
 
 instance NaturalT nT => Enum (Signed nT) where
     succ x
@@ -91,13 +91,13 @@ instance NaturalT nT => Num (Signed nT) where
     (Signed a) * (Signed b) =
         fromInteger $ a * b
     negate (Signed n) =
-        fromInteger $ (n `xor` mask (undefined :: nT)) + 1
+        fromInteger $ (n `B.xor` mask (undefined :: nT)) + 1
     a - b =
         a + (negate b)
     
     fromInteger n
       | n > 0 =
-        Signed $ n .&. mask (undefined :: nT)
+        Signed $ n B..&. mask (undefined :: nT)
     fromInteger n
       | n < 0 =
         negate $ fromInteger $ negate n
@@ -140,33 +140,37 @@ instance NaturalT nT => Integral (Signed nT) where
            then let Signed x' = negate s in negate x'
            else x
 
-instance NaturalT nT => Bits (Signed nT) where
-    (Signed a) .&. (Signed b) = Signed $ a .&. b
-    (Signed a) .|. (Signed b) = Signed $ a .|. b
-    (Signed a) `xor` Signed b = Signed $ a `xor` b
-    complement (Signed x) = Signed $ x `xor` mask (undefined :: nT)
+instance NaturalT nT => B.Bits (Signed nT) where
+    (Signed a) .&. (Signed b) = Signed $ a B..&. b
+    (Signed a) .|. (Signed b) = Signed $ a B..|. b
+    (Signed a) `xor` Signed b = Signed $ a `B.xor` b
+    complement (Signed x) = Signed $ x `B.xor` mask (undefined :: nT)
     (Signed x) `shiftL` b
       | b < 0 = error $ "Bits.shiftL{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to shift by negative amount"
       | otherwise =
-        Signed $ mask (undefined :: nT) .&. (x `shiftL` b)
+        Signed $ mask (undefined :: nT) B..&. (x `B.shiftL` b)
     s@(Signed x) `shiftR` b
       | b < 0 = error $ "Bits.shiftR{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to shift by negative amount"
       | isNegative s =
-        Signed $ mask (undefined :: nT) .&.
-            ((x `shiftR` b) .|. (mask (undefined :: nT) `shiftL` (fromIntegerT (undefined :: nT) - b)))
+        Signed $ mask (undefined :: nT) B..&.
+            ((x `B.shiftR` b) B..|. (mask (undefined :: nT) `B.shiftL` (fromIntegerT (undefined :: nT) - b)))
       | otherwise =
-        Signed $ (mask (undefined :: nT)) .&. (x `shiftR` b)
+        Signed $ (mask (undefined :: nT)) B..&. (x `B.shiftR` b)
     (Signed a) `rotateL` b
       | b < 0 =
         error $ "Bits.rotateL{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to rotate by negative amount"
       | otherwise =
-        Signed $ mask (undefined :: nT) .&.
-            ((a `shiftL` b) .|. (a `shiftR` (fromIntegerT (undefined :: nT) - b)))
+        Signed $ mask (undefined :: nT) B..&.
+            ((a `B.shiftL` b) B..|. (a `B.shiftR` (fromIntegerT (undefined :: nT) - b)))
     (Signed a) `rotateR` b
       | b < 0 =
         error $ "Bits.rotateR{Signed " ++ show (fromIntegerT (undefined :: nT)) ++ "}: tried to rotate by negative amount"
       | otherwise =
-        Signed $ mask (undefined :: nT) .&.
-            ((a `shiftR` b) .|. (a `shiftL` (fromIntegerT (undefined :: nT) - b)))
+        Signed $ mask (undefined :: nT) B..&.
+            ((a `B.shiftR` b) B..|. (a `B.shiftL` (fromIntegerT (undefined :: nT) - b)))
     bitSize _ = fromIntegerT (undefined :: nT)
     isSigned _ = True
+
+instance NaturalT nT => HWBits (Signed nT) where
+  a `shiftL` b = a `B.shiftL` (fromInteger (toInteger b))
+  a `shiftR` b = a `B.shiftR` (fromInteger (toInteger b))
index 6f06dbd699a452204e21bdd685fc1390f24a30a2..92dc24dfa5ddcaed9e13041c442cbf287e4ec611 100644 (file)
@@ -7,7 +7,7 @@ module Data.Param.Unsigned
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (Lift(..))
-import Data.Bits
+import qualified Data.Bits as B
 import Types
 import Types.Data.Num.Decimal.Literals.TH
 
@@ -37,7 +37,7 @@ sizeT _ = undefined
 mask :: forall nT . NaturalT nT
      => nT
      -> Integer
-mask _ = bit (fromIntegerT (undefined :: nT)) - 1
+mask _ = B.bit (fromIntegerT (undefined :: nT)) - 1
 
 instance NaturalT nT => Eq (Unsigned nT) where
     (Unsigned x) == (Unsigned y) = x == y
@@ -57,7 +57,7 @@ instance NaturalT nT => Ord (Unsigned nT) where
 
 instance NaturalT nT => Bounded (Unsigned nT) where
     minBound = 0
-    maxBound = Unsigned $ (1 `shiftL` (fromIntegerT (undefined :: nT))) - 1
+    maxBound = Unsigned $ (1 `B.shiftL` (fromIntegerT (undefined :: nT))) - 1
 
 instance NaturalT nT => Enum (Unsigned nT) where
     succ x
@@ -88,13 +88,13 @@ instance NaturalT nT => Num (Unsigned nT) where
     (Unsigned a) * (Unsigned b) =
         fromInteger $ a * b
     negate s@(Unsigned n) =
-        fromInteger $ (n `xor` mask (sizeT s)) + 1
+        fromInteger $ (n `B.xor` mask (sizeT s)) + 1
     a - b =
         a + (negate b)
 
     fromInteger n
       | n > 0 =
-        Unsigned $ n .&. mask (undefined :: nT)
+        Unsigned $ n B..&. mask (undefined :: nT)
     fromInteger n
       | n < 0 =
         negate $ fromInteger $ negate n
@@ -128,30 +128,34 @@ instance NaturalT nT => Integral (Unsigned nT) where
         in (fromInteger div, fromInteger mod)
     toInteger s@(Unsigned x) = x
 
-instance NaturalT nT => Bits (Unsigned nT) where
-    (Unsigned a) .&. (Unsigned b) = Unsigned $ a .&. b
-    (Unsigned a) .|. (Unsigned b) = Unsigned $ a .|. b
-    (Unsigned a) `xor` Unsigned b = Unsigned $ a `xor` b
-    complement (Unsigned x) = Unsigned $ x `xor` mask (undefined :: nT)
+instance NaturalT nT => B.Bits (Unsigned nT) where
+    (Unsigned a) .&. (Unsigned b) = Unsigned $ a B..&. b
+    (Unsigned a) .|. (Unsigned b) = Unsigned $ a B..|. b
+    (Unsigned a) `xor` Unsigned b = Unsigned $ a `B.xor` b
+    complement (Unsigned x) = Unsigned $ x `B.xor` mask (undefined :: nT)
     s@(Unsigned x) `shiftL` b
-      | b < 0 = error $ "Bits.shiftL{Unsigned " ++ show (bitSize s) ++ "}: tried to shift by negative amount"
+      | b < 0 = error $ "Bits.shiftL{Unsigned " ++ show (B.bitSize s) ++ "}: tried to shift by negative amount"
       | otherwise =
-        Unsigned $ mask (undefined :: nT) .&. (x `shiftL` b)
+        Unsigned $ mask (undefined :: nT) B..&. (x `B.shiftL` b)
     s@(Unsigned x) `shiftR` b
-      | b < 0 = error $ "Bits.shiftR{Unsigned " ++ show (bitSize s) ++ "}: tried to shift by negative amount"
+      | b < 0 = error $ "Bits.shiftR{Unsigned " ++ show (B.bitSize s) ++ "}: tried to shift by negative amount"
       | otherwise =
-        Unsigned $ (x `shiftR` b)
+        Unsigned $ (x `B.shiftR` b)
     s@(Unsigned x) `rotateL` b
       | b < 0 =
-        error $ "Bits.rotateL{Unsigned " ++ show (bitSize s) ++ "}: tried to rotate by negative amount"
+        error $ "Bits.rotateL{Unsigned " ++ show (B.bitSize s) ++ "}: tried to rotate by negative amount"
       | otherwise =
-        Unsigned $ mask (undefined :: nT) .&.
-            ((x `shiftL` b) .|. (x `shiftR` (bitSize s - b)))
+        Unsigned $ mask (undefined :: nT) B..&.
+            ((x `B.shiftL` b) B..|. (x `B.shiftR` (B.bitSize s - b)))
     s@(Unsigned x) `rotateR` b
       | b < 0 =
-        error $ "Bits.rotateR{Unsigned " ++ show (bitSize s) ++ "}: tried to rotate by negative amount"
+        error $ "Bits.rotateR{Unsigned " ++ show (B.bitSize s) ++ "}: tried to rotate by negative amount"
       | otherwise =
-        Unsigned $ mask (undefined :: nT) .&.
-            ((x `shiftR` b) .|. (x `shiftL` (bitSize s - b)))
+        Unsigned $ mask (undefined :: nT) B..&.
+            ((x `B.shiftR` b) B..|. (x `B.shiftL` (B.bitSize s - b)))
     bitSize _ = fromIntegerT (undefined :: nT)
     isSigned _ = False
+
+instance NaturalT nT => HWBits (Unsigned nT) where
+  a `shiftL` b = a `B.shiftL` (fromInteger (toInteger b))
+  a `shiftR` b = a `B.shiftR` (fromInteger (toInteger b))