Skip to content
Browse files

Merge pull request #3 from seni/master

commented out/enabled some bit-wise operators
  • Loading branch information...
2 parents 70e64bb + 1dfe072 commit dba2f2cd9c2740997668e2f01be69a42110e9beb @leepike leepike committed
Showing with 22 additions and 3 deletions.
  1. +1 −0 Language/Atom/Code.hs
  2. +16 −3 Language/Atom/Expressions.hs
  3. +5 −0 Language/Atom/UeMap.hs
View
1 Language/Atom/Code.hs
@@ -145,6 +145,7 @@ codeUE mp config ues d (ue, n) =
MUBWNot _ -> ["~ ", a]
MUBWAnd _ _ -> [a, " & ", b]
MUBWOr _ _ -> [a, " | ", b]
+ MUBWXor _ _ -> [a, " ^ ", b]
MUShift _ n -> (if n >= 0 then [a, " << ", show n] else [a, " >> ", show (negate n)])
MUEq _ _ -> [a, " == ", b]
MULt _ _ -> [a, " < " , b]
View
19 Language/Atom/Expressions.hs
@@ -42,6 +42,15 @@ module Language.Atom.Expressions
, any_
, all_
, imply
+ -- * Bit-wise Operations
+ , (.&.)
+ , complement
+ , (.|.)
+ , xor
+ , shift
+ , rotate
+ , bitSize
+ , isSigned
-- * Equality and Comparison
, (==.)
, (/=.)
@@ -196,6 +205,7 @@ data E a where
BWNot :: IntegralE a => E a -> E a
BWAnd :: IntegralE a => E a -> E a -> E a
BWOr :: IntegralE a => E a -> E a -> E a
+ BWXor :: IntegralE a => E a -> E a -> E a
Shift :: IntegralE a => E a -> Int -> E a
Eq :: EqE a => E a -> E a -> E Bool
Lt :: OrdE a => E a -> E a -> E Bool
@@ -243,6 +253,7 @@ data UE
| UBWNot UE
| UBWAnd UE UE
| UBWOr UE UE
+ | UBWXor UE UE
| UShift UE Int
| UEq UE UE
| ULt UE UE
@@ -343,6 +354,7 @@ instance TypeOf UE where
UBWNot a -> typeOf a
UBWAnd a _ -> typeOf a
UBWOr a _ -> typeOf a
+ UBWXor a _ -> typeOf a
UShift a _ -> typeOf a
UEq _ _ -> Bool
ULt _ _ -> Bool
@@ -557,8 +569,8 @@ instance (Expr a, OrdE a, EqE a, IntegralE a, Bits a) => Bits (E a) where
complement (Const a) = Const $ complement a
complement a = BWNot a
(Const a) .|. (Const b) = Const $ a .|. b
- a .|. b = BWOr a b
- xor a b = (a .&. complement b) .|. (complement a .&. b)
+ a .|. b = BWOr a b
+ xor = BWXor a b
shift (Const a) n = Const $ shift a n
shift a n = Shift a n
rotate a n | n >= width a = error "E rotates too far."
@@ -609,7 +621,7 @@ any_ :: (a -> E Bool) -> [a] -> E Bool
any_ f a = or_ $ map f a
-- Logical implication (if a then b).
-imply :: E Bool -> E Bool -> E Bool
+imply :: E Bool -> E Bool -> E Bool
imply a b = not_ a ||. b
-- | Equal.
@@ -726,6 +738,7 @@ ue t = case t of
BWNot a -> UBWNot (ue a)
BWAnd a b -> UBWAnd (ue a) (ue b)
BWOr a b -> UBWOr (ue a) (ue b)
+ BWXor a b -> UBWXor (ue a) (ue b)
Shift a b -> UShift (ue a) b
Eq a b -> ueq (ue a) (ue b)
Lt a b -> ult (ue a) (ue b)
View
5 Language/Atom/UeMap.hs
@@ -61,6 +61,7 @@ data UeElem
| MUBWNot !Hash
| MUBWAnd !Hash !Hash
| MUBWOr !Hash !Hash
+ | MUBWXor !Hash !Hash
| MUShift !Hash !Int
| MUEq !Hash !Hash
| MULt !Hash !Hash
@@ -104,6 +105,7 @@ typeOf h mp = case getUE h mp of
MUBWNot a -> typeOf' a
MUBWAnd a _ -> typeOf' a
MUBWOr a _ -> typeOf' a
+ MUBWXor a _ -> typeOf' a
MUShift a _ -> typeOf' a
MUEq _ _ -> Bool
MULt _ _ -> Bool
@@ -171,6 +173,7 @@ share e = case e of
UBWNot a -> unOp a MUBWNot
UBWAnd a b -> binOp (a,b) MUBWAnd
UBWOr a b -> binOp (a,b) MUBWOr
+ UBWXor a b -> binOp (a,b) MUBWXor
UShift a b -> unOp a (\x -> MUShift x b)
UEq a b -> binOp (a,b) MUEq
ULt a b -> binOp (a,b) MULt
@@ -264,6 +267,7 @@ recoverUE st h = case getUE h st of
MUBWNot a -> UBWNot (recover' a)
MUBWAnd a b -> UBWAnd (recover' a) (recover' b)
MUBWOr a b -> UBWOr (recover' a) (recover' b)
+ MUBWXor a b -> UBWXor (recover' a) (recover' b)
MUShift a b -> UShift (recover' a) b
MUEq a b -> UEq (recover' a) (recover' b)
MULt a b -> ULt (recover' a) (recover' b)
@@ -308,6 +312,7 @@ ueUpstream h t = case getUE h t of
MUBWNot a -> [a]
MUBWAnd a b -> [a, b]
MUBWOr a b -> [a, b]
+ MUBWXor a b -> [a, b]
MUShift a _ -> [a]
MUEq a b -> [a, b]
MULt a b -> [a, b]

0 comments on commit dba2f2c

Please sign in to comment.
Something went wrong with that request. Please try again.