X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprelude%2FPrelRules.lhs;h=747817b248b6649767bcb9a7675bbbe8fec5c226;hb=de777ba42eb12b6a20e548a959b23b60179d9b57;hp=8604647a70e27dd95946124d685828beb6c0e514;hpb=7a327c1297615a9498e7117a0017b09ff2458d53;p=ghc-hetmet.git

diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 8604647..747817b 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -45,12 +45,9 @@ import Outputable
 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}
 
 
@@ -98,20 +95,21 @@ primOpRules op op_name = primop_rule op
     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)
@@ -223,42 +221,59 @@ cmpOp cmp l1 l2
 
 --------------------------
 
-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))
@@ -329,11 +344,9 @@ intResult :: Integer -> Maybe CoreExpr
 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}