module Arm.BinaryNumber
( Binary32
, intToBinary32
, binary32ToInt
, binary32ToWord32
, word32ToBinary32
)
where
import Data.Bits
import Data.Word
import Data.Array
import Data.Ratio
newtype Binary32
= B32 Word32
deriving Num
instance Show Binary32 where
showsPrec n (B32 wrd) = showString (biNumToString wrd "")
where
biNumToString 0 accum = ('0' : accum)
biNumToString 1 accum = ('1' : accum)
biNumToString n accum
= if n `rem` 2 == 0
then biNumToString (n `div` 2) ('0' : accum)
else biNumToString (n `div` 2) ('1' : accum)
instance Read Binary32 where
readsPrec n = (stringToBiNum 0)
where
stringToBiNum :: Word32 -> ReadS Binary32
stringToBiNum acc "0" = [(B32 (acc * 2), "")]
stringToBiNum acc "1" = [(B32 (acc * 2 + 1), "")]
stringToBiNum acc (bit : bits)
| bit == '0' = stringToBiNum (acc * 2) bits
| bit == '1' = stringToBiNum (acc * 2 + 1) bits
instance Eq Binary32 where
(==) = binop (==)
instance Ord Binary32 where
compare = binop compare
instance Bounded Binary32 where
minBound = B32 0
maxBound = B32 (maxBound :: Word32)
instance Real Binary32 where
toRational x = toInteger x % 1
instance Integral Binary32 where
x `div` y = to (binop div x y)
x `quot` y = to (binop quot x y)
x `rem` y = to (binop rem x y)
x `mod` y = to (binop mod x y)
x `quotRem` y = to2 (binop quotRem x y)
divMod = quotRem
instance Ix Binary32 where
range (m,n) = [m..n]
index b@(m,n) i
| inRange b i = fromIntegral (from (i m))
| otherwise = error "index: Index out of range"
inRange (m,n) i = m <= i && i <= n
instance Enum Binary32 where
toEnum = to . fromIntegral
fromEnum = fromIntegral . from
enumFrom = numericEnumFrom
enumFromTo = numericEnumFromTo
enumFromThen = numericEnumFromThen
enumFromThenTo = numericEnumFromThenTo
instance Bits Binary32 where
x .&. y = to (binop (.&.) x y)
x .|. y = to (binop (.|.) x y)
x `xor` y = to (binop xor x y)
complement = to . complement . from
x `shift` i = to (from x `shift` i)
bit = to . bit
setBit x i = to (setBit (from x) i)
clearBit x i = to (clearBit (from x) i)
complementBit x i = to (complementBit (from x) i)
testBit x i = testBit (from x) i
bitSize _ = 32
isSigned _ = False
intToBinary32 :: Int -> Binary32
intToBinary32 = (B32 . fromIntegral)
binary32ToInt :: Binary32 -> Int
binary32ToInt (B32 b) = fromIntegral b
binary32ToWord32 :: Binary32 -> Word32
binary32ToWord32 (B32 b) = b
word32ToBinary32 :: Word32 -> Binary32
word32ToBinary32 = B32
numericEnumFrom :: Real a => a -> [a]
numericEnumFromThen :: Real a => a -> a -> [a]
numericEnumFromTo :: Real a => a -> a -> [a]
numericEnumFromThenTo :: Real a => a -> a -> a -> [a]
numericEnumFrom n = n : (numericEnumFrom $! (n+1))
numericEnumFromThen n m = iterate ((mn)+) n
numericEnumFromTo n m = takeWhile (<= m) (numericEnumFrom n)
numericEnumFromThenTo n n' m = takeWhile (if n' >= n then (<= m) else (>= m))
(numericEnumFromThen n n')
class Coerce a where
to :: Word32 -> a
from :: a -> Word32
instance Coerce Binary32 where
from = binary32ToWord32
to = word32ToBinary32
binop :: Coerce word => (Word32 -> Word32 -> a) -> (word -> word -> a)
binop op x y = from x `op` from y
to2 :: Coerce word => (Word32, Word32) -> (word, word)
to2 (x,y) = (to x, to y)
absReal x
| x >= 0 = x
| otherwise = x
signumReal x
| x == 0 = 0
| x > 0 = 1
| otherwise = 1