Add shiftL and shiftR operators for signed and unsigned. Update name of shiftl and...

diff --git a/HigherOrderCPU.hs b/HigherOrderCPU.hs
index 8e3f0da182f6d6db4a7d9d4372a25a4efa145e23..9b151d14c08b3dbf1ed516ba65dc7f5e98a18d84 100644 (file)
--- a/HigherOrderCPU.hs
+++ b/HigherOrderCPU.hs
@@ -18,9 +18,9 @@ fu1 = fu (+)
 fu2 = fu (-)
 fu3 = 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
 
 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
 
               (fu3     inputs (addrs!3)) +> empty)))
     out     = last s
 

-
-
-
-
-
-
--- Some minor details

 cpuState :: Vector D4 (Signed D16)
 cpuState = copy 0
 cpuState :: Vector D4 (Signed D16)
 cpuState = copy 0

-
-const a b = a
-xor = const
-shift = const

diff --git a/clash/CLasH/HardwareTypes.hs b/clash/CLasH/HardwareTypes.hs
index dbb0ecac94cc93a0dcd446686fb01714a4d9d894..572a64e7f66154842d1fcb6887a71ba0f6a83a8d 100644 (file)
--- a/clash/CLasH/HardwareTypes.hs
+++ b/clash/CLasH/HardwareTypes.hs
@@ -2,11 +2,13 @@
 
 module CLasH.HardwareTypes
   ( module Types
 
 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.Param.Vector
   , module Data.Param.Index
   , module Data.Param.Signed
   , module Data.Param.Unsigned
   , module Prelude

+  , module Data.Bits

   , Bit(..)
   , State(..)
   , hwand
   , 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 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.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
 
 import Language.Haskell.TH.Lift
 import Data.Typeable

diff --git a/clash/CLasH/VHDL/Constants.hs b/clash/CLasH/VHDL/Constants.hs
index 23ac95d5e12c725e65e4502ac50763479489a5cf..4267e2eef46d92edb45e3638735d0514af798101 100644 (file)
--- a/clash/CLasH/VHDL/Constants.hs
+++ b/clash/CLasH/VHDL/Constants.hs
@@ -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
 -- 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
              , 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
              ]
 --------------
 -- Identifiers


@@ -154,12 +154,12 @@ dropId :: String
 dropId = "drop"
 
 -- | shiftl function identifier
 dropId = "drop"
 
 -- | shiftl function identifier

-shiftlId :: String
-shiftlId = "shiftIntoL"
+shiftIntoLId :: String
+shiftIntoLId = "shiftIntoL"

 
 -- | shiftr function identifier
 
 -- | shiftr function identifier

-shiftrId :: String
-shiftrId = "shiftIntoR"
+shiftIntoRId :: String
+shiftIntoRId = "shiftIntoR"

 
 -- | rotl function identifier
 rotlId :: String
 
 -- | rotl function identifier
 rotlId :: String


@@ -241,6 +241,15 @@ hwnotId = "hwnot"
 hwandId :: String
 hwandId = "hwand"
 
 hwandId :: String
 hwandId = "hwand"
 

+xorId :: String
+xorId = "xor"
+
+shiftLId :: String
+shiftLId = "shiftL"
+
+shiftRId :: String
+shiftRId = "shiftR"
+

 lengthTId :: String
 lengthTId = "lengthT"
 
 lengthTId :: String
 lengthTId = "lengthT"
 

diff --git a/clash/CLasH/VHDL/Generate.hs b/clash/CLasH/VHDL/Generate.hs
index 543e91870c91e2b75f81c70ee4b3f6def1af768f..8c59334085fe6e53bcd153eb514320e96b2a67d0 100644 (file)
--- a/clash/CLasH/VHDL/Generate.hs
+++ b/clash/CLasH/VHDL/Generate.hs
@@ -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))
   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
 -----------------------------------------------------------------------------
 -----------------------------------------------------------------------------
 -- 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],[]))
   , (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]))
   , (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))
     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 = 
                                    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)       
                      (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 = 
                                        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                ) )
   , (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               ) )
   , (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                ) )
   , (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"))
   ]
   --, (tfvecId          , (1, genTFVec                ) )
   , (minimumId        , (2, error "\nFunction name: \"minimum\" is used internally, use another name"))
   ]

diff --git a/clash/Data/Param/Index.hs b/clash/Data/Param/Index.hs
index 2c4e88e0bac7607e47907a31317d8d799c9d5bd6..79d551d38e7c7661fcc1d6745a6a04e402f88292 100644 (file)
--- a/clash/Data/Param/Index.hs
+++ b/clash/Data/Param/Index.hs
@@ -8,7 +8,7 @@ module Data.Param.Index
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (Lift(..))    
 
 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
 
 import Types
 import Types.Data.Num.Decimal.Literals.TH
 

diff --git a/clash/Data/Param/Integer.hs b/clash/Data/Param/Integer.hs
index 4e48d14dc01d29b8a482d7d051106d098d235370..a57c0aa0f853b5e8f9a2bbf39747ef7ccf872b12 100644 (file)
--- a/clash/Data/Param/Integer.hs
+++ b/clash/Data/Param/Integer.hs
@@ -2,12 +2,18 @@ module Data.Param.Integer
   ( Signed(..)
   , Unsigned(..)
   , Index (..)
   ( Signed(..)
   , Unsigned(..)
   , Index (..)

+  , HWBits(..)

   ) where
 
 import Types
   ) where
 
 import Types

+import qualified Data.Bits as B

 
 newtype (NaturalT nT) => Signed nT = Signed Integer
 
 newtype (NaturalT nT) => Unsigned nT = Unsigned Integer
 
 
 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

diff --git a/clash/Data/Param/Signed.hs b/clash/Data/Param/Signed.hs
index e85fe607757da2fd0293d444e901197d1954daf6..dc9ee21e6acbacde685c4a9e0fe3b5e08ccd1342 100644 (file)
--- a/clash/Data/Param/Signed.hs
+++ b/clash/Data/Param/Signed.hs
@@ -6,7 +6,7 @@ module Data.Param.Signed
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (Lift(..))
 
 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
 
 import Types
 import Types.Data.Num.Decimal.Literals.TH
 


@@ -28,7 +28,7 @@ sizeT _ = undefined
 mask :: forall nT . NaturalT nT
      => nT
      -> Integer
 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
 
 signBit :: forall nT . NaturalT nT
         => nT


@@ -39,7 +39,7 @@ isNegative :: forall nT . NaturalT nT
            => Signed nT
            -> Bool
 isNegative (Signed x) =
            => 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
 
 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
     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
 
 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) =
     (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 =
     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
     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
 
            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 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 =
     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 =
       | 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 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 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
     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))

diff --git a/clash/Data/Param/Unsigned.hs b/clash/Data/Param/Unsigned.hs
index 6f06dbd699a452204e21bdd685fc1390f24a30a2..92dc24dfa5ddcaed9e13041c442cbf287e4ec611 100644 (file)
--- a/clash/Data/Param/Unsigned.hs
+++ b/clash/Data/Param/Unsigned.hs
@@ -7,7 +7,7 @@ module Data.Param.Unsigned
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (Lift(..))
 
 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
 
 import Types
 import Types.Data.Num.Decimal.Literals.TH
 


@@ -37,7 +37,7 @@ sizeT _ = undefined
 mask :: forall nT . NaturalT nT
      => nT
      -> Integer
 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
 
 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
 
 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
 
 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) =
     (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 =
     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
     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
 
         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
     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 =
       | otherwise =

-        Unsigned $ mask (undefined :: nT) .&. (x `shiftL` b)
+        Unsigned $ mask (undefined :: nT) B..&. (x `B.shiftL` b)

     s@(Unsigned x) `shiftR` 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 =
       | otherwise =

-        Unsigned $ (x `shiftR` b)
+        Unsigned $ (x `B.shiftR` b)

     s@(Unsigned x) `rotateL` b
       | b < 0 =
     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 =
       | 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 =
     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 =
       | 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
     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))