X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmExpr.hs;h=8e40654352737a98ceb4b95f27ed4f31b5e40de1;hb=a12e845684c10955bc594cdb20d1f13fae14873d;hp=6e09a6f128739b09e553a71cdf79fb55fa14ba65;hpb=e6243a818496aad82b6f47511d3bd9bc800f747d;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 6e09a6f..8e40654 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -10,6 +10,7 @@ module CmmExpr
     , Width(..)
     , widthInBits, widthInBytes, widthInLog, widthFromBytes
     , wordWidth, halfWordWidth, cIntWidth, cLongWidth
+    , narrowU, narrowS
  
     , CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
     , CmmReg(..), cmmRegType
@@ -55,6 +56,9 @@ import Panic
 import Unique
 import UniqSet
 
+import Data.Word
+import Data.Int
+
 -----------------------------------------------------------------------------
 --		CmmExpr
 -- An expression.  Expressions have no side effects.
@@ -387,6 +391,7 @@ instance Ord GlobalReg where
    compare CurrentTSO CurrentTSO = EQ
    compare CurrentNursery CurrentNursery = EQ
    compare HpAlloc HpAlloc = EQ
+   compare EagerBlackholeInfo EagerBlackholeInfo = EQ
    compare GCEnter1 GCEnter1 = EQ
    compare GCFun GCFun = EQ
    compare BaseReg BaseReg = EQ
@@ -419,6 +424,8 @@ instance Ord GlobalReg where
    compare _ GCFun = GT
    compare BaseReg _ = LT
    compare _ BaseReg = GT
+   compare EagerBlackholeInfo _ = LT
+   compare _ EagerBlackholeInfo = GT
 
 -- convenient aliases
 spReg, hpReg, spLimReg, nodeReg :: CmmReg
@@ -633,6 +640,21 @@ widthInLog W64  = 3
 widthInLog W128 = 4
 widthInLog W80  = panic "widthInLog: F80"
 
+-- widening / narrowing
+
+narrowU :: Width -> Integer -> Integer
+narrowU W8  x = fromIntegral (fromIntegral x :: Word8)
+narrowU W16 x = fromIntegral (fromIntegral x :: Word16)
+narrowU W32 x = fromIntegral (fromIntegral x :: Word32)
+narrowU W64 x = fromIntegral (fromIntegral x :: Word64)
+narrowU _ _ = panic "narrowTo"
+
+narrowS :: Width -> Integer -> Integer
+narrowS W8  x = fromIntegral (fromIntegral x :: Int8)
+narrowS W16 x = fromIntegral (fromIntegral x :: Int16)
+narrowS W32 x = fromIntegral (fromIntegral x :: Int32)
+narrowS W64 x = fromIntegral (fromIntegral x :: Int64)
+narrowS _ _ = panic "narrowTo"
 
 -----------------------------------------------------------------------------
 --    		MachOp