module Numeric.Taint.Word32
( N(..), Op(..)
, pprint, lshift
) where
import Data.Bits
import Data.Word
import Data.Data
import Data.Generics.Uniplate.Data
import Data.Generics.Uniplate.Operations
data N = N Word32
| U
| X Op N N
deriving (Eq,Ord,Show,Data,Typeable)
data Op = LShift | Xor | Or | And | Add | Sub | Rot
deriving (Eq,Ord,Show,Data,Typeable)
pprint :: N -> String
pprint (N x) = show x
pprint U = "?"
pprint (X op a b) = concat ["(", pprint a, sh op, pprint b, ")"] where
sh Rot = "<>"
sh Add = "+"
sh Sub = "-"
sh Xor = "^"
sh Or = "|"
sh And = "&"
sh LShift = "<<"
lshift :: N -> N -> N
lshift = lift LShift
instance Num N where
(+) = lift Add
() = lift Sub
fromInteger = N . fromInteger
(*) = undefined
abs x = x
signum _ = (N 1)
instance Bits N where
(.&.) = lift And
(.|.) = lift Or
xor = lift Xor
complement (N a) = N (complement a)
complement n = X Xor (N 0xFFFFFFFF) n
shift = undefined
rotate (N a) i = N $ rotate a i
rotate a i = X Rot a (N . fromIntegral $ i)
bitSize _ = 32
isSigned _ = False
lift :: Op -> N -> N -> N
lift op a b = optimize $ X op a b
optimize :: N -> N
optimize = rewrite f where
f (X LShift a (N i)) | i>31 = Just $ X LShift a (N (i `mod` 32))
f (X op (N a) (N b)) = Just $ N $ eval op a b
f (X op (N a) (X op' (N b) c)) | op==op' = Just $ X op (N $ eval op a b) c
f (X op (X op' (N b) c) (N a)) | op==op' = Just $ X op (N $ eval op a b) c
f (X op (N a) (X op' c (N b))) | op==op' = Just $ X op (N $ eval op a b) c
f (X op (X op' c (N b)) (N a)) | op==op' = Just $ X op (N $ eval op a b) c
f (X Xor (N 0) a) = Just a
f (X Xor a (N 0)) = Just a
f (X LShift (N 1) (X And 31 n)) =
if filter (>31) (childrenBi n::[Word32]) == []
then Nothing
else Just (X LShift (N 1) (X And 31 n')) where
n' = transformBi ((.&. 31)::Word32->Word32) n
f x = Nothing
eval Add = (+)
eval Sub = ()
eval And = (.&.)
eval Or = (.|.)
eval Xor = xor
eval LShift = \a b->if b>31 then 0 else a `shiftL` (fromIntegral b)
eval Rot = \a b->rotate a (fromIntegral b)