import FastString
import StaticFlags ( opt_SimplExcessPrecision )
-import Data.Bits ( Bits(..) )
-#if __GLASGOW_HASKELL__ >= 500
+import Data.Bits as Bits ( Bits(..), shiftL, shiftR )
+ -- shiftL and shiftR were not always methods of Bits
import Data.Word ( Word )
-#else
-import Data.Word ( Word64 )
-#endif
\end{code}
primop_rule IntQuotOp = two_lits (intOp2Z quot)
primop_rule IntRemOp = two_lits (intOp2Z rem)
primop_rule IntNegOp = one_lit negOp
+ primop_rule ISllOp = two_lits (intShiftOp2 Bits.shiftL)
+ primop_rule ISraOp = two_lits (intShiftOp2 Bits.shiftR)
+ primop_rule ISrlOp = two_lits (intShiftOp2 shiftRightLogical)
-- Word operations
-#if __GLASGOW_HASKELL__ >= 500
primop_rule WordAddOp = two_lits (wordOp2 (+))
primop_rule WordSubOp = two_lits (wordOp2 (-))
primop_rule WordMulOp = two_lits (wordOp2 (*))
-#endif
primop_rule WordQuotOp = two_lits (wordOp2Z quot)
primop_rule WordRemOp = two_lits (wordOp2Z rem)
-#if __GLASGOW_HASKELL__ >= 407
primop_rule AndOp = two_lits (wordBitOp2 (.&.))
primop_rule OrOp = two_lits (wordBitOp2 (.|.))
primop_rule XorOp = two_lits (wordBitOp2 xor)
-#endif
+ primop_rule SllOp = two_lits (wordShiftOp2 Bits.shiftL)
+ primop_rule SrlOp = two_lits (wordShiftOp2 shiftRightLogical)
-- coercions
primop_rule Word2IntOp = one_lit (litCoerce word2IntLit)
--------------------------
-negOp (MachFloat 0.0) = Nothing -- can't represent -0.0 as a Rational
-negOp (MachFloat f) = Just (mkFloatVal (-f))
+negOp :: Literal -> Maybe CoreExpr -- Negate
+negOp (MachFloat 0.0) = Nothing -- can't represent -0.0 as a Rational
+negOp (MachFloat f) = Just (mkFloatVal (-f))
negOp (MachDouble 0.0) = Nothing
negOp (MachDouble d) = Just (mkDoubleVal (-d))
negOp (MachInt i) = intResult (-i)
negOp l = Nothing
--------------------------
+intOp2 :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
intOp2 op (MachInt i1) (MachInt i2) = intResult (i1 `op` i2)
intOp2 op l1 l2 = Nothing -- Could find LitLit
+intOp2Z :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
+-- Like intOp2, but Nothing if i2=0
intOp2Z op (MachInt i1) (MachInt i2)
- | i2 /= 0 = Just (mkIntVal (i1 `op` i2))
+ | i2 /= 0 = intResult (i1 `op` i2)
intOp2Z op l1 l2 = Nothing -- LitLit or zero dividend
+intShiftOp2 :: (Integer->Int->Integer) -> Literal -> Literal -> Maybe CoreExpr
+ -- Shifts take an Int; hence second arg of op is Int
+intShiftOp2 op (MachInt i1) (MachInt i2) = intResult (i1 `op` fromInteger i2)
+intShiftOp2 op l1 l2 = Nothing
+
+shiftRightLogical :: Integer -> Int -> Integer
+-- Shift right, putting zeros in rather than sign-propagating as Bits.shiftR would do
+-- Do this by converting to Word and back. Obviously this won't work for big
+-- values, but its ok as we use it here
+shiftRightLogical x n = fromIntegral (fromInteger x `shiftR` n :: Word)
+
+
--------------------------
-#if __GLASGOW_HASKELL__ >= 500
+wordOp2 :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
wordOp2 op (MachWord w1) (MachWord w2)
= wordResult (w1 `op` w2)
wordOp2 op l1 l2 = Nothing -- Could find LitLit
-#endif
+wordOp2Z :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr
wordOp2Z op (MachWord w1) (MachWord w2)
- | w2 /= 0 = Just (mkWordVal (w1 `op` w2))
+ | w2 /= 0 = wordResult (w1 `op` w2)
wordOp2Z op l1 l2 = Nothing -- LitLit or zero dividend
-#if __GLASGOW_HASKELL__ >= 500
wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2)
- = Just (mkWordVal (w1 `op` w2))
-#else
--- Integer is not an instance of Bits, so we operate on Word64
-wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2)
- = Just (mkWordVal ((fromIntegral::Word64->Integer) (fromIntegral w1 `op` fromIntegral w2)))
-#endif
+ = wordResult (w1 `op` w2)
wordBitOp2 op l1 l2 = Nothing -- Could find LitLit
+wordShiftOp2 :: (Integer->Int->Integer) -> Literal -> Literal -> Maybe CoreExpr
+ -- Shifts take an Int; hence second arg of op is Int
+wordShiftOp2 op (MachWord x) (MachInt n)
+ = wordResult (x `op` fromInteger n)
+ -- Do the shift at type Integer
+wordShiftOp2 op l1 l2 = Nothing
+
--------------------------
floatOp2 op (MachFloat f1) (MachFloat f2)
= Just (mkFloatVal (f1 `op` f2))
intResult result
= Just (mkIntVal (toInteger (fromInteger result :: Int)))
-#if __GLASGOW_HASKELL__ >= 500
wordResult :: Integer -> Maybe CoreExpr
wordResult result
= Just (mkWordVal (toInteger (fromInteger result :: Word)))
-#endif
\end{code}