module ForSyDe.Bit (Bit(..),
not,
bitToBool,
boolToBit,
toBitVector8,
fromBitVector8,
toBitVector16,
fromBitVector16,
toBitVector32,
fromBitVector32,
toBitVector64,
fromBitVector64) where
import Language.Haskell.TH.Lift
import Data.Int
import Data.Bits
import Data.Generics (Data, Typeable)
import Prelude hiding (not)
import Data.Param.FSVec (FSVec, reallyUnsafeVector)
import qualified Data.Param.FSVec as V
import Data.TypeLevel.Num (D8,D16,D32,D64,Nat)
data Bit = H
| L
deriving (Eq, Show, Data, Typeable)
$(deriveLift1 ''Bit)
not :: Bit -> Bit
not = complement
instance Bits Bit where
H .&. x = x
L .&. _ = L
H .|. _ = H
L .|. x = x
xor H L = H
xor L H = H
xor _ _ = L
complement L = H
complement H = L
shift x 0 = x
shift _ _ = L
rotate x _ = x
bitSize _ = 1
isSigned _ = False
instance Num Bit where
H + L = H
H + H = L
L + x = x
() = (+)
(*) = (.&.)
abs = id
signum _ = L
fromInteger n = if n<=0 then L else H
bitToBool :: Bit -> Bool
bitToBool H = True
bitToBool L = False
boolToBit :: Bool -> Bit
boolToBit True = H
boolToBit False = L
toBitVector8 :: Int8 -> FSVec D8 Bit
toBitVector8 = reallyUnsafeToBitVector
fromBitVector8 :: FSVec D8 Bit -> Int8
fromBitVector8 = fromBitVectorDef 0
toBitVector16 :: Int16 -> FSVec D16 Bit
toBitVector16 = reallyUnsafeToBitVector
fromBitVector16 :: FSVec D16 Bit -> Int16
fromBitVector16 = fromBitVectorDef 0
toBitVector32 :: Int32 -> FSVec D32 Bit
toBitVector32 = reallyUnsafeToBitVector
fromBitVector32 :: FSVec D32 Bit -> Int32
fromBitVector32 = fromBitVectorDef 0
toBitVector64 :: Int64 -> FSVec D64 Bit
toBitVector64 = reallyUnsafeToBitVector
fromBitVector64 :: FSVec D64 Bit -> Int64
fromBitVector64 = fromBitVectorDef 0
reallyUnsafeToBitVector :: Bits a => a -> FSVec s Bit
reallyUnsafeToBitVector x =
reallyUnsafeVector $ map (boolToBit.(testBit x)) [size1,size2..0]
where size = bitSize x
fromBitVectorDef :: (Bits a, Nat s) => a -> FSVec s Bit -> a
fromBitVectorDef def vec = fst $ V.foldr f (def, 0) vec
where f e (ac, pos) = (copyBit e ac pos, pos+1)
copyBit H = setBit
copyBit L = clearBit